Pascal/Turbo Pascal - Ficheros Pascal ayuda

   
Vista:

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



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=record
				 nom: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 begin
										posi:=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
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

Ficheros Pascal ayuda

Publicado por ramon (2072 intervenciones) el 10/05/2016 19:08:56
Me puedes explicar esto {Cada vez que entre un fichero crear una función} que quieres decir
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

Ficheros Pascal ayuda

Publicado por jorge (4 intervenciones) el 11/05/2016 08:16:55
donde esta creado el fichero hacerlo con una funcion en vez de procedimiento
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

Ficheros Pascal ayuda

Publicado por jorge (4 intervenciones) el 11/05/2016 08:19:52
donde esta creado el fichero hacerlo con una funcion en vez de procedimiento
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

Ficheros Pascal ayuda

Publicado por ramon (2072 intervenciones) el 11/05/2016 11:16:40
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
{Mira esto espero te sirva de ayuda }
 
 program archivos;
 uses
     crt;
  const
     existe : boolean = false;
   type
      string9 = string[9];
      string20 = string[20];
 
      registros = record
            nombre : string20;
               dni : string9;
             end;
 
   var
     f : file of registros;
     te, dat : registros;
     i : longint;
     eldni : string9;
     tecla : char;
     cont : longint;
 
    procedure inicio(d : registros);
    begin
       assign(f,'datos.dat');
      if existe = false then
      begin
       rewrite(f);
       seek(f,0);
       write(f,d);
       close(f);
       existe := true;
     end
  else
      begin
        reset(f);
        seek(f,filesize(f));
        write(f,d);
        close(f);
      end;
   end;
 
  function estadni(dn : string9) : boolean;
  begin
      estadni := false;
      if existe = true then
      begin
      assign(f,'datos.dat');
      reset(f);
      for i := 0 to filesize(f) - 1 do
      begin
         seek(f,i);
         read(f,te);
         if te.dni = dn then
         begin
            estadni := true;
            break;
         end;
      end;
        close(f);
    end
  else
     begin
        writeln('   No Datos Disponibles Pulse Una Tecla');
        readkey;
     end;
  end;
 
  procedure entradadatos;
  begin
     writeln('   ***** Entrada De Datos *****');
     writeln;
     write('     Nombre : ');
     readln(dat.nombre);
     write('     DNI    : ');
     readln(dat.dni);
     cont := cont + 1;
     if cont > 1 then
     begin
     if estadni(dat.dni) = false then
     begin
       inicio(dat);
     end
   else
      begin
         writeln('   El DNI Entrado Existe Pulse Una Tecla');
         readkey;
      end;
     end
  else
     begin
        inicio(dat);
     end;
  end;
 
  procedure mostrarregistros;
  begin
     if existe = true then
     begin
        assign(f,'datos.dat');
        reset(f);
        for i := 0 to filesize(f) - 1 do
        begin
          seek(f,i);
          read(f,dat);
          writeln('    Nombre = ',dat.nombre,'      N. DNI = ',dat.dni);
        end;
        close(f);
        writeln;
        writeln('   Pulse Una Tecla');
        readkey;
     end
  else
     begin
        writeln('   No Datos Disponibles Pulse Una Tecla');
        readkey;
     end;
  end;
 
 
  procedure menu;
  begin
     cont := 0;
     repeat
       clrscr;
       writeln('    ***** Menu General *****');
       writeln;
       writeln('    1 = Entrar Registro');
       writeln('    2 = Mostrar Registros');
       writeln('    3 = Salir');
       repeat
          tecla := readkey;
       until tecla in['1','2','3'];
       clrscr;
   case tecla of
 '1' : entradadatos;
 '2' : mostrarregistros;
    end;
     until tecla = '3';
     if existe = true then
     erase(f);
  end;
 
 
  begin
     menu;
  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