{A ver si esto te sirve te e puesto modificación también}
program diccionarios;
uses
crt;
type
espanol = record
palabra : string;
significado : string;
end;
ingles = record
esp : string;
ingl : string;
end;
frances = record
esp : string;
fran : string;
end;
const
aespa = 'elespano.dat';
aingl = 'elingles.dat';
afran = 'elfrance.dat';
var
espa : espanol;
ingle : ingles;
france : frances;
dicE : file of espanol;
dicI : file of ingles;
dicF : file of frances;
procedure entrada_datos(cual : char);
var
nombre : string;
begin
clrscr;
if upcase(cual) = 'E' then
begin
nombre := aespa;
write(' Entre Palabra : '); readln(espa.palabra);
write(' Entre Significado : '); readln(espa.significado);
end;
if upcase(cual) = 'I' then
begin
nombre := aingl;
write(' Entre Palabra En Espanol : '); readln(ingle.esp);
write(' Entre Palabra En Ingles : '); readln(ingle.ingl);
end;
if upcase(cual) = 'F' then
begin
nombre := afran;
write(' Entre Palabra En Espanol : '); readln(france.esp);
write(' Entre Palabra En Frances : '); readln(france.fran);
end;
case upcase(cual) of
'E' : begin
assign(dicE,nombre);
{$I-} reset(dicE); {$I+} if ioresult <> 0 then
begin
rewrite(dicE);
seek(dicE,0);
write(dicE,espa);
close(dicE);
end
else
begin
seek(dicE,filesize(dicE));
write(dicE,espa);
close(dicE);
end;
end;
'I' : begin
assign(dicI,nombre);
{$I-} reset(dicI); {$I+} if ioresult <> 0 then
begin
rewrite(dicI);
seek(dicI,0);
write(dicI,ingle);
close(dicI);
end
else
begin
seek(dicI,filesize(dicI));
write(dicI,ingle);
close(dicI);
end;
end;
'F' : begin
assign(dicF,nombre);
{$I-} reset(dicF); {$I+} if ioresult <> 0 then
begin
rewrite(dicf);
seek(dicf,0);
write(dicf,france);
close(dicf);
end
else
begin
seek(dicf,filesize(dicf));
write(dicf,france);
close(dicf);
end;
end;
end;
end;
procedure modifica_datos(cual : char);
var
frase, nombre : string;
pos, i : longint;
esta : boolean;
pul : char;
begin
clrscr;
if upcase(cual) = 'E' then
begin
nombre := aespa;
assign(dicE,nombre);
{$I-} reset(dicE); {$I+} if ioresult <> 0 then
begin
writeln(' Error De Archivo o No Existe '); writeln;
writeln(' Pulse Una Tecla '); readkey;
end
else
begin
write(' Entre Frase a Modificar : '); readln(frase);
end;
end;
if upcase(cual) = 'I' then
begin
nombre := aingl;
assign(dici,nombre);
{$I-} reset(dici); {$I+} if ioresult <> 0 then
begin
writeln(' Error De Archivo o No Existe '); writeln;
writeln(' Pulse Una Tecla '); readkey;
end
else
begin
write(' Entre Frase a Modificar : '); readln(frase);
end;
end;
if upcase(cual) = 'F' then
begin
nombre := afran;
assign(dicf,nombre);
{$I-} reset(dicf); {$I+} if ioresult <> 0 then
begin
writeln(' Error De Archivo o No Existe '); writeln;
writeln(' Pulse Una Tecla '); readkey;
end
else
begin
write(' Entre Frase a Modificar : '); readln(frase);
end;
end;
case upcase(cual) of
'E' : begin
esta := false;
pos := 0;
for i := 0 to filesize(dicE) - 1 do
begin
seek(dicE,i);
read(dicE,espa);
if espa.palabra = frase then
begin
esta := true;
pos := i;
break;
end;
end;
if esta = true then
begin
clrscr;
write(' Entre Palabra : '); readln(espa.palabra);
write(' Entre Significado : '); readln(espa.significado);
writeln;
writeln(' Desea Realizar El Cambio S/N '); repeat
pul := upcase(readkey);
until pul in['S','N'];
if pul = 'S' then
begin
seek(dicE,pos);
write(dicE,espa);
end;
end
else
begin
writeln(' Dato No Encontrado Pulse Una Tecla'); readkey;
end;
close(dicE);
end;
'I' : begin
esta := false;
pos := 0;
for i := 0 to filesize(dici) - 1 do
begin
seek(dici,i);
read(dici,ingle);
if ingle.esp = frase then
begin
esta := true;
pos := i;
break;
end;
end;
if esta = true then
begin
clrscr;
write(' Entre Palabra En Espanol : '); readln(ingle.esp);
write(' Entre Palabra En Ingles : '); readln(ingle.ingl);
writeln;
writeln(' Desea Realizar El Cambio S/N '); repeat
pul := upcase(readkey);
until pul in['S','N'];
if pul = 'S' then
begin
seek(dici,pos);
write(dici,ingle);
end;
end
else
begin
writeln(' Dato No Encontrado Pulse Una Tecla'); readkey;
end;
close(dici);
end;
'F' : begin
esta := false;
pos := 0;
for i := 0 to filesize(dicf) - 1 do
begin
seek(dicf,i);
read(dicf,france);
if france.esp = frase then
begin
esta := true;
pos := i;
break;
end;
end;
if esta = true then
begin
clrscr;
write(' Entre Palabra En Espanol : '); readln(france.esp);
write(' Entre Palabra En Frances : '); readln(france.fran);
writeln;
writeln(' Desea Realizar El Cambio S/N '); repeat
pul := upcase(readkey);
until pul in['S','N'];
if pul = 'S' then
begin
seek(dicf,pos);
write(dicf,france);
end;
end
else
begin
writeln(' Dato No Encontrado Pulse Una Tecla'); readkey;
end;
close(dicf);
end;
end;
end;
procedure limpia_Diccionarios;
var
bb : char;
nombre : string;
begin
clrscr;
writeln('>>>>>> Desea Eliminar Los Diccionarios S/N <<<<<<'); repeat
bb := upcase(readkey);
until bb in['S','N'];
if bb = 'S' then
begin
assign(dicE,nombre);
{$I-} reset(dicE); {$I+} if ioresult = 0 then
begin
close(dicE);
erase(dicE);
end;
assign(dicI,nombre);
{$I-} reset(dicI); {$I+} if ioresult = 0 then
begin
close(dicI);
erase(dicI);
end;
assign(dicF,nombre);
{$I-} reset(dicF); {$I+} if ioresult = 0 then
begin
close(dicF);
erase(dicF);
end;
end;
end;
procedure menu;
var
letra, tec : char;
sal : boolean;
begin
sal := false;
repeat
clrscr;
writeln('***** Menu Jeneras *****'); writeln;
writeln(' 1 = Entrada Diccionario'); writeln(' 2 = Anular Diccionarios'); writeln(' 3 = Entrar Nuevos Datos'); writeln(' 4 = Modificar Datos'); writeln(' 5 = Salir'); writeln;
writeln('<<<< Elija Opcion >>>>'); repeat
tec := readkey;
until tec in['1','2','3','4','5'];
clrscr;
case tec of
'1' : begin
write(' Entre Que Diccionario [E/I/F]'); readln(letra);
entrada_datos(letra);
end;
'2' : begin
limpia_Diccionarios;
end;
'3' : begin
write(' Entre En Que Diccionario [E/I/F]'); readln(letra);
entrada_datos(letra);
end;
'4' : begin
write(' Entre Diccionario A Modificar [E/I/F]'); readln(letra);
modifica_datos(letra);
end;
'5' : sal := true;
end;
until sal = true;
end;
begin
menu;
end.
Crear cuenta