Pascal/Turbo Pascal - Pascal/Turbo Pascal Ordenar un archivo y realizar una busqueda

   
Vista:

Pascal/Turbo Pascal Ordenar un archivo y realizar una busqueda

Publicado por Andres Matias (1 intervención) el 11/11/2015 14:10:29
Tengo este archivo:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Viajes = RECORD
      Fecha:RECORD
        Dia:integer;
        Mes:integer;
        Anio:integer;
        ftotal:integer;
       end;
      Tran:STRING[3] ;
      Orig:STRING[3];
      Dest:STRING[3];
      Val:REAL;
      Lib:INTEGER;
      But:ARRAY [1..3,1..20] OF STRING[8];
 END;

y lo quiero ordenarlo por el campo "ftotal" para despues de buscar un valor. Hasta ahora lo unico que tengo es esto:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
PROCEDURE Orden;
 
var i,j,min,aux,k,posmin,n:integer;
Begin reset(Viajes_arch);n:=filesize(Viajes_arch);
for i:=0 to n-2 do
begin seek(Viajes_arch,i);
read(Viaj.Fecha.ftotal,k);
aux:=k;
min:=k;
posmin:=filepos(Viajes_arch)-1;
for j:=i+1 to n-1 do
begin seek(Viajes_arch,j);
read(Viaj.Fecha.ftotal,k);
if k<min then begin min:=k;
posmin:=filepos(Viajes_arch)-1
end;
 End;  seek(Viajes_arch,i);
write(Viaj.,min);
seek(Viajes_arch,posmin);
write(Viaj.Fecha.ftotal,aux)
end;  end;

Muchas gracias por su ayuda.
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

Pascal/Turbo Pascal Ordenar un archivo y realizar una busqueda

Publicado por ramon (2072 intervenciones) el 16/11/2015 13:12:26
{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.
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