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!
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=recordnom: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 beginwhile(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
0