Pascal/Turbo Pascal Ordenar un archivo y realizar una busqueda
{A ver si esto sirve}
program ordenaarchivo;
uses
crt;
type
Fecha = RECORD
Dia:integer;
Mes:integer;
Anio:integer;
ftotal:integer;
end;
Viajes = RECORD
fech : fecha;
Tran:STRING[3] ;
Orig:STRING[3];
Dest:STRING[3];
Val:REAL;
Lib:INTEGER;
But:ARRAY[1..3,1..20] OF STRING[8];
END;
const
nombre : string = 'prueva5.dat';
var
f, f1 : file of viajes;
datos : viajes;
tt, bb : integer;
procedure limpiareg;
begin
fillchar(datos,sizeof(viajes),0);
end;
procedure guardaregistros(d : viajes);
begin
assign(f,nombre);
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
rewrite(f);
seek(f,0);
write(f,d);
close(f);
end
else
begin
seek(f,filesize(f));
write(f,d);
close(f);
end;
end;
procedure ordenaarchivos;
var
d, h : longint;
da, temp : viajes;
begin
assign(f,nombre);
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
writeln(' Error de archivo falta o esta da¤ado');
writeln(' Pulse Una Tecla');
readkey;
end
else
begin
writeln(' Ordenando Archivos');
for d := 0 to filesize(f) - 1 do
begin
seek(f,d);
read(f,datos);
for h := filesize(f) - 1 downto d + 1 do
begin
seek(f,h);
read(f,da);
if datos.fech.ftotal > da.fech.ftotal then
begin
temp := da;
da := datos;
datos := temp;
seek(f,d);
write(f,datos);
seek(f,h);
write(f,da);
end;
end;
end;
close(f);
delay(500);
end;
end;
procedure presentaarchivos;
var
mm : longint;
lee : viajes;
begin
assign(f,nombre);
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
writeln(' Error de archivo falta o esta da¤ado');
writeln(' Pulse Una Tecla');
readkey;
end
else
begin
writeln(' Dia Mes Anio Ftotal');
writeln;
for mm := 0 to filesize(f) - 1 do
begin
seek(f,mm);
read(f,lee);
writeln(' ',lee.fech.dia,' ',lee.fech.mes,' ',
lee.fech.anio,' ',lee.fech.ftotal);
end;
close(f);
writeln;
writeln(' Pulse Una Tecla');
readkey;
end;
end;
procedure ejemplo;
begin
assign(f,nombre);
{$I-} reset(f); {$I+}
if ioresult = 0 then
begin
close(f);
erase(f);
end;
for tt := 1 to 9 do
begin
limpiareg;
bb := random(600) + 1;
datos.fech.Dia := tt;
datos.fech.mes := tt * 2;
datos.fech.Anio := tt * 3;
datos.fech.ftotal := bb;
guardaregistros(datos);
end;
delay(500);
end;
procedure buscardato(n : integer);
var
bb : longint;
si : boolean;
t, u : integer;
begin
si := false;
assign(f,nombre);
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
writeln(' Error de archivo falta o esta da¤ado');
writeln(' Pulse Una Tecla');
readkey;
end
else
begin
for bb := 0 to filesize(f) - 1 do
begin
seek(f,bb);
read(f,datos);
if datos.fech.ftotal = n then
begin
si := true;
clrscr;
writeln;
writeln(' ****** Los Datos Pedidos Son ******');
writeln;
writeln(' Dia Mes A¤o Ftotal');
writeln(' ',datos.fech.dia,' ',datos.fech.mes,' ',
datos.fech.anio,' ',datos.fech.ftotal);
writeln(' ',datos.Tran,' ',datos.Orig,' ',datos.Dest,' ',
datos.Val:0:2,' ',datos.Lib);
for t := 1 to 3 do
for u := 1 to 20 do
write(' ',datos.But[t,u]);
writeln;
writeln(' Pulse Una Tecla');
readkey;
close(f);
break;
end;
end;
if si = false then
begin
writeln(' Dato No Encontrado Pulse Una Tecla');
readkey;
close(f);
end;
end;
end;
procedure menu;
var
tecla : char;
salir : boolean;
busq : integer;
begin
randomize;
salir := false;
repeat
clrscr;
writeln(' ***** Menu Jeneral *****');
writeln(' ------------------------');
writeln(' 1 = Crear Archivo Prueva');
writeln(' 2 = Ver Archivo');
writeln(' 3 = Ordenar Por Ftotal');
writeln(' 4 = Busqueda En Archivo');
writeln(' 5 = Salir');
writeln;
writeln(' /// Elija Opcion ///');
repeat
tecla := readkey;
until tecla in['1','2','3','4','5'];
clrscr;
case tecla of
'1' : begin
writeln(' Creando Archivo Ejemplo');
ejemplo;
end;
'2' : presentaarchivos;
'3' : ordenaarchivos;
'4' : begin
writeln(' ***** Busqueda De Un dato En Archivo *****');
writeln;
write(' Entre Valor Ftotal De Busqueda : ');
readln(busq);
buscardato(busq);
end;
'5' : salir := true;
end;
until salir = true;
end;
begin
menu;
end.
