Ficheros Pascal ayuda
Publicado por jr (4 intervenciones) el 10/05/2016 08:39:30
Alguien me puede ayudar a hacer este ejercicio pero en local.
Tengo que hacer, que al abrir el archivo hacerlo en una función o procedimiento
Quitarle lo del ioresult
Cada vez que entre un fichero crear una función
Todo en local, necesito declarar un fichero file of.
declarar una variable de tipo registro.
Proceso o función que no se pueda entrar DNI repetido
Tengo que hacer, que al abrir el archivo hacerlo en una función o procedimiento
Quitarle lo del ioresult
Cada vez que entre un fichero crear una función
Todo en local, necesito declarar un fichero file of.
declarar una variable de tipo registro.
Proceso o función que no se pueda entrar DNI repetido
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;
const
letra='TRWAGMYFPDXBNJZSQVHLCKE';
type
registro=recordnom:string[20];
dni:string[9];
end;
fich=file of registro;dni1=string[10];
p1=string[2];
procedure iniciar(var fichero:fich);
var
ok:boolean;begin
{$I-}
reset(fichero);
{$I+}
ok:=(ioresult=0);
if ok then begin
clrscr;
writeln(' Fichero Creado Err :',ioresult);
(*mantengo info fichero*)
delay(1000);
reset(fichero);
end
else begin
writeln(' Creo Fichero Err :',ioresult);
delay(1000);
rewrite(fichero);
end;
end;
function entradni(nif:string):string;
var
op:char;con,posi,codi:integer;
dni:string[10];
p2:string[2];
aa:longint;begin
clrscr;
con:=15;
posi:=1;
clrscr;
dni:='';
writeln('Entra tu DNI:');
repeat
gotoxy(con,1);
op:=readkey;
case op of
'0'..'9':begin
if (posi<=8) then begin
gotoxy(con,1);write(op);
insert(op,dni,posi);
inc(con);
inc(posi);
end;
end;
#8:begin
if posi>1 then beginposi:=posi-1;
delete(dni,posi,1);
dec(con);
gotoxy(con,1);write(CHR(176));
end;
end;
end;
until(posi>8)and(op=#13);
val(dni,aa,codi);
if (codi=0) then posi:= aa mod 23;
p2:=copy(letra,posi+1,1);
nif:=dni+p2;
entradni:=nif;
end;
procedure entrada(var fichero:fich;var a:registro);
var
nn:string; con:char; nif:string;begin
CON:='S';
reset(fichero);
WHILE(CON='S') DO BEGIN
clrscr;
write(' Dar Nom : ');
nn:='';
readln(nn);
a.nom:=nn;
clrscr;
nif:='';
a.dni:=entradni(nif);
seek(fichero,filesize(fichero));
write(fichero,a);
clrscr;
writeln;
write('Mas entradas S - N : ');
REPEAT
con:=upcase(readkey);
UNTIL UPCASE(CON) IN['N','S'];
END;
close(fichero);
end;
procedure listado(var fichero:fich;var a:registro);
var
i:integer;begin
reset(fichero);
clrscr;
writeln(' LISTADO DE NOMBRE Y DNI ');
WRITELN(' ############################## ');
writeln;
i:=0;
for i:=0 to filesize(fichero)-1 do begin
read(fichero,a);
writeln(a.nom:21,a.dni:10);
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;
var
op,op1:char;
a:registro; fichero:fich;begin
clrscr;
assign(fichero,'Fich1.dat');
iniciar(fichero);
repeat
menu;
op:=readkey;
case op of
'1':entrada(fichero,a);
'2':listado(fichero,a);
'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