{Mira esto te Ayudara }
program ordenarchi;
uses
crt;
type
archivo = record
nombre : string[50];
telefo : longint;
ciudad : string[100];
end;
const
archi = 'c:\tp\bin\miprueva.rek';
var
f : file of archivo;
dato : archivo;
procedure cargadatos_a_archivo(nom : string);
var
tkl : char;
begin
repeat
clrscr;
write(' Entre Nombre : '); readln(dato.nombre);
write(' Entre Telefono : '); readln(dato.telefo);
write(' Entre Ciudad : '); readln(dato.ciudad);
assign(f,archi);
{$I-} reset(f); {$I+} if ioresult <> 0 then
begin
rewrite(f);
seek(f,0);
write(f,dato);
close(f);
end
else
begin
seek(f,filesize(f));
write(f,dato);
close(f);
end;
writeln;
writeln(' Desea Entrar Mas Datos [S/N]'); repeat
tkl := upcase(readkey);
until tkl in['S','N'];
until tkl = 'N';
end;
procedure ver_archivos;
var
ar : longint;
begin
assign(f,archi);
{$I-} reset(f); {$I+} if ioresult <> 0 then
begin
writeln(' El Archivo No Existe o Esta Da¤ado Pulse Una Tecla'); readkey;
exit;
end
else
begin
clrscr;
ar := 0;
repeat
seek(f,ar);
read(f,dato);
writeln(dato.nombre,' ',dato.telefo,' ',dato.ciudad);
ar := ar + 1;
until ar > filesize(f) - 1;
writeln(' Fin De Datos Pulse Una Tecla'); readkey;
close(f);
end;
end;
procedure intercambio(var d, b : archivo);
var
temp : archivo;
begin
temp := d;
d := b;
b := temp;
end;
procedure ordenacion_burbuja;
var
longt, i, j : longint;
da, ja : archivo;
begin
assign(f,archi);
{$I-} reset(f); {$I+} if ioresult = 0 then
begin
longt := filesize(f) - 1;
for i := 0 to longt do
begin
seek(f,i);
read(f,da);
for j := longt downto i + 1 do
begin
seek(f, j);
read(f, ja);
if da.nombre > ja.nombre then
begin
Intercambio(da,ja);
seek(f,i);
write(f,da);
seek(f,j);
write(f,ja);
end;
end;
end;
close(f);
end;
end;
procedure menu;
var
tecla : char;
fin : boolean;
begin
fin := false;
repeat
clrscr;
writeln('***** Menu Jeneral *****'); writeln;
writeln(' 1 = Entrada De Datos'); writeln(' 2 = Ver Datos Guardados'); writeln(' 3 = Ordenar Archivo Por Nombre'); writeln(' 4 = Salir'); writeln;
writeln('<<<<< Elija Opcion >>>>>>'); repeat
tecla := readkey;
until tecla in['1','2','3','4'];
clrscr;
case tecla of
'1' : cargadatos_a_archivo(archi);
'2' : ver_archivos;
'3' : ordenacion_burbuja;
'4' : fin := true;
end;
until fin = true;
end;
begin
menu;
end.
Crear cuenta