Pascal/Turbo Pascal - Fichero secuencial Modificar + Baja Ayuda

   
Vista:

Fichero secuencial Modificar + Baja Ayuda

Publicado por Manel (5 intervenciones) el 01/05/2015 11:47:53
Tengo este enunciado donde me pide Modificar y dar Bajas. En el que me pide que en la entrada añada un campo info y le asigne una (a), en modificar la puedo cambiar por (b) y luego dar de baja los que tengan (b), es decir del fichero general los que tienen (a) pasarlos a otro fichero. Luego borrar el general y al Nuevo renombrarlo con el nombre del fichero de inicio. Aver si alguien puede ayudarme. Gracias!

Nota: Las variables las tengo que pasar en local!

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
uses crt;
 
type
	registro=record
				 nom:string[20];
				 dni:string[8];
			 end;
 
	var
 
	fichero:file of registro;
			op,op1:char;
			ok:boolean;
			a:registro;
 
	procedure conum(var nom1:string;h:integer);
		var
			p:char;
			i1,cc:integer;
	begin
			for i1:=1 to h do begin
                     gotoxy(10+i1,1);
                     write(chr(176));
            end;
			i1:=0;
			cc:=1;
				repeat
					gotoxy(11+i1,1);p:=upcase(readkey);
                   case p of
                       #8:begin
								  i1:=i1-1;
								  if i1<0 then i1:=0;
								  gotoxy(11+i1,1);
								  write(chr(176));
								  cc:=cc-1;
								  if cc<1 then cc:=1;
								  delete(nom1,cc,1);
                          end;
                     #48..#57:begin
									if cc<=h then begin
									  write(p);
									  insert(p,nom1,cc);
									  i1:=i1+1;
									  cc:=cc+1;
									 end;
                              end;
 
                   end;
                until(p=#13) and (cc>h);
    end;
 
	PROCEDURE mirarepe(nn:string;VAR vis:INTEGER);
		var pu:integer;
			kk:boolean;
	BEGIN
			reset(fichero);
			pu:=0;
			kk:=true;
		while(pu<filesize(fichero)) and kk do begin
		              read(fichero,a);
                      IF(a.dni=nn) THEN BEGIN
                                        vis:=pu;
										kk:=false;
					  END;
					inc(pu);
        END;
		close(fichero);
	END;
	procedure entrada;
		var
			nn:string;
			con:char;
			vis:integer;
			a1:registro;
	begin
				CON:='S';
					WHILE(CON='S') DO BEGIN
							clrscr;
							write(' Dar Nom : ');
							nn:='';
							readln(nn);
							a1.nom:=nn;
							clrscr;
							writeln(' Dar Dni : ');
							nn:='';
							conum(nn,8);
							a1.dni:=nn;
							vis:=-22;
							mirarepe(nn,vis);
								if (vis=-22) then begin
								        reset(fichero);
								        writeln('Pos Logica :',filesize(fichero),' Fisica :',sizeof(registro)*filesize(fichero));
								        delay(800);
										seek(fichero,filesize(fichero));
										write(fichero,a1);
										close(fichero);
										clrscr;
								end
								else writeln('No Valido ');
						    writeln;
							write('Mas entradas S - N : ');
							REPEAT
							con:=upcase(readkey);
							UNTIL UPCASE(CON) IN['N','S'];
					END;
 
	end;
 
	procedure listado;
		var zz:integer;
	begin
				reset(fichero);
				zz:=filesize(fichero);
				clrscr;
				writeln(' LISTADO DE NOMBRE   Y  DNI     ');
				WRITELN(' ############################## ');
				writeln;
		if zz>0 then begin
					while(not(eof(fichero)))do begin
							read(fichero,a);
							writeln(a.nom:21,a.dni:10);
					end;
		end;
		    writeln;
			write('Dar tecla : ');repeat until keypressed;
			close(fichero);
	end;
 
	procedure menu;
	begin
		clrscr;
		writeln('1.-Entrada :');
		writeln('2.-Listado :');
		writeln('3.-Fin     :');
		write('Dar opcion : ');
	end;
 
begin
clrscr;
assign(fichero,'FIREG1.DAT');
{$I-}
reset(fichero);
{$I+}
ok:=(ioresult=0);
if ok then begin
               clrscr;
               writeln(' Fichero Creado ');
               delay(1000);
               reset(fichero);
               end
               else begin
                    writeln(' Creo Fichero ');
                    delay(1000);
                    rewrite(fichero);
                    end;
	repeat
		menu;
		op:=readkey;
		 case op of
			  '1':entrada;
			  '2':listado;
			  '3':begin
					clrscr;
					write('Borrar Fichero da S :');op1:=upcase(readkey);
					if op1='S' then erase(fichero);
				  end;
		 end;
	until op='3';
end.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

Fichero secuencial Modificar + Baja Ayuda

Publicado por ramon (2072 intervenciones) el 01/05/2015 23:04:05
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
{Mira esto}
 
uses
    crt;
   type
      registro = record
            nom : string[20];
            dni : string[8];
            est : char;
          end;
 
   var
     a : registro;
     fichero : file of registro;
 
  { procedure entrada;
var
nn:string;
con:char;
vis:integer;
a1:registro;
begin
CON:='S';
WHILE(CON='S') DO BEGIN
clrscr;
write(' Dar Nom : ');
nn:='';
readln(nn);
a1.nom:=nn;
clrscr;
writeln(' Dar Dni : ');
nn:='';
conum(nn,8);
a1.dni:=nn;
vis:=-22;
a1.est := 'a'; {<------------------------------------------------Esto Tienes  Que Modificar}
mirarepe(nn,vis);
if (vis=-22) then begin
reset(fichero);
writeln('Pos Logica :',filesize(fichero),' Fisica :',sizeof(registro)*filesize(fichero));
delay(800);
seek(fichero,filesize(fichero));
write(fichero,a1);
close(fichero);
clrscr;
end
else writeln('No Valido ');
writeln;
write('Mas entradas S - N : ');
REPEAT
con:=upcase(readkey);
UNTIL UPCASE(CON) IN['N','S'];
END;
 
end;}
 
   procedure modifica_registro;
   var
     n : string[8];
     b : longint;
     encont : boolean;
     pp : char;
    begin
       clrscr;
       write('   Entre N. DNI : ');
       readln(n);
       assign(fichero,'FIREG1.DAT');
   {$I-} reset(fichero); {$I+}
      if ioresult <> 0 then
      begin
         writeln('  Error De Archivo O No Existe Pulse Una Tecla');
         readkey;
      end
   else
       begin
          encont := false;
          for b := 0 to filesize(fichero) - 1 do
          begin
             seek(fichero,b);
             read(fichero,a);
             if a.dni = n then
             begin
                encont := true;
                break;
             end;
          end;
            if encont = true then
            begin
              clrscr;
              writeln('   Menu Modificacion ');
              writeln;
              writeln('  1 = Anular Registro');
              writeln('  2 = Modificar Datos');
              writeln('  3 = Nada Salir');
              writeln;
              writeln('  Elija Opcion');
              repeat
                 pp := readkey;
              until pp in['1','2','3'];
         case pp of
      '1' : begin
              a.est := 'b';
              seek(fichero,b);
              write(fichero,a);
              writeln;
              writeln('   Archivo Anulado Pulse Una Tecla');
              readkey;
            end;
      '2' : begin
               clrscr;
               writeln('   Modificacion De Datos');
               writeln;
               writeln('  N = Nombre ');
               writeln('  D = DNI    ');
               writeln('  T = Todo ');
               writeln('  S = Nada Y Sal ');
               writeln;
               writeln('   Elija Opcion');
               repeat
                  pp := upcase(readkey);
               until pp in['N','D','T','S'];
       case pp of
   'N' : begin
           write('   Entre Nombre : ');
           readln(a.nom);
           seek(fichero,b);
           write(fichero,a);
        end;
   'D' : begin
            write('  Entre DNI : ');
            readln(a.dni);
            seek(fichero,b);
            write(fichero,a);
        end;
   'T' : begin
            write('   Entre Nombre : ');
            readln(a.nom);
            write('  Entre DNI : ');
            readln(a.dni);
            seek(fichero,b);
            write(fichero,a);
        end;
     end;
       end;
      end;
      end
   else
       begin
          writeln('   Dato No Encontrado Pulse Una Tecla');
          readkey;
       end;
       close(fichero);
       end;
    end;
 
 
    procedure actualiza_archivo;
    var
      tem : registro;
      rr, pun : longint;
      tt : file of registro;
    begin
       assign(fichero,'FIREG1.DAT');
   {$I-} reset(fichero); {$I+}
      if ioresult <> 0 then
      begin
         writeln('  Error De Archivo O No Existe Pulse Una Tecla');
         readkey;
      end
   else
       begin
          assign(tt,'tempor.tem');
          rewrite(tt);
          pun := 0;
          for rr := 0 to filesize(fichero) - 1 do
          begin
             seek(fichero,rr);
             read(fichero,a);
             if a.est <> 'b' then
             begin
                seek(tt,pun);
                write(tt,a);
                pun := pun + 1;
             end;
          end;
           close(fichero);
           close(tt);
           erase(fichero);
           rename(tt,'FIREG1.DAT');
       end;
    end;
 
   begin
 
   end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Fichero secuencial Modificar + Baja Ayuda

Publicado por Manel (5 intervenciones) el 02/05/2015 13:50:41
Lo intento ejecutar y no me muestra nada, la nota que me has puesto que tengo que modificar a que te refieres? Gracias.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Fichero secuencial Modificar + Baja Ayuda

Publicado por ramon (2072 intervenciones) el 02/05/2015 14:18:57
Tienes que poner entre el begin y el end lo que quieres ejecutar como veras no tiene puesto nada
por ejemplo:

begin
modifica_registro; {esto ejecutara la modificación de registros }
end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar