{Mira este programa veras el uso del archivo indice. El cual guarda el nombre y la posición del producto a buscar.}
program archivos;
uses
crt;
const
nombre = 'c:\tp\bin\indice.dat';
type
indice = record
nombre : string[10];
posi : longint;
end;
registro = record
producto : string[10];
precio : real;
posicion : integer;
cantidad : integer;
end;
var
archindi : file of indice;
dat : indice;
product : string[10];
cont : integer;
regi : file of registro;
datos : registro;
busca : longint;
procedure crea_indice(da : indice);
begin
assign(archindi,nombre);
{$I-} reset(archindi); {$I+} if ioresult <> 0 then
begin
rewrite(archindi);
seek(archindi,0);
write(archindi,da);
close(archindi);
end
else
begin
seek(archindi,filesize(archindi));
write(archindi,da);
close(archindi);
end;
end;
procedure entrada_datos;
var
tec : char;
posicion : longint;
begin
repeat
clrscr;
writeln('***** Entrada Datos Productos *****'); writeln;
write(' Entre Nombre Producto : '); readln(datos.producto);
write(' Entre Precio Unidad : '); readln(datos.precio);
write(' Entre Num Posicion Almacen : '); readln(datos.posicion);
write(' Entre Cantidad De Productos : '); readln(datos.cantidad);
assign(regi,'c:\tp\bin\producto.dat');
{$I-} reset(regi); {$I+} if ioresult <> 0 then
begin
rewrite(regi);
seek(regi,0);
write(regi,datos);
posicion := filesize(regi) - 1;
close(regi);
end
else
begin
seek(regi,filesize(regi));
write(regi,datos);
posicion := filesize(regi) - 1;
close(regi);
end;
dat.nombre := datos.producto;
dat.posi := posicion;
crea_indice(dat);
clrscr;
writeln('<<<<<< Desea entrar Mas Datos [S/N] >>>>>>>'); repeat
tec := upcase(readkey);
until tec in['S','N'];
until tec = 'N';
end;
procedure toma_referencia;
var
nom : string[10];
buscado : string[10];
i : integer;
begin
clrscr;
writeln('<<<<<<<<< Entre Nombre Producto >>>>>>>>>>>'); write(' Nombre : '); readln(nom);
for i := 1 to length(nom) do
nom[i] := upcase(nom[i]);
assign(archindi,nombre);
{$I-} reset(archindi); {$I+} if ioresult <> 0 then
begin
writeln('*** Falta El Archivo indice Pulse Una tecla ***'); readkey;
exit;
end
else
begin
for busca := 0 to filesize(archindi) - 1 do
begin
for i := 1 to length(dat.nombre) do
begin
buscado[i] := upcase(dat.nombre[i]);
buscado[0] := chr(i);
end;
if buscado = nom then
begin
clrscr;
assign(regi,'c:\tp\bin\producto.dat');
{$I-} reset(regi); {$I+} if ioresult <> 0 then
begin
writeln('****** El Archivo No Existe Pulse Una Tecla *******'); readkey;
end
else
begin
seek(regi,dat.posi);
read(regi,datos);
close(regi);
writeln('**** Los Datos Del Producto Son ****'); writeln;
writeln(' Producto : ',datos.producto); writeln(' Precio Unidad : ',datos.precio:0:2); writeln(' Posicion En : ',datos.posicion); writeln(' Cantidad : ',datos.cantidad); writeln;
writeln('>>>>>>> Pulse Una Tecla <<<<<<<<<'); readkey;
end;
end;
end;
end;
end;
procedure menu;
var
sal : boolean;
teb : char;
begin
sal := false;
repeat
clrscr;
writeln(' ****** Menu General ******'); writeln;
writeln(' 1 = Entrada De Productos'); writeln(' 2 = Busqueda De Producto'); writeln(' 3 = Salir'); writeln;
writeln(' <<<< Elija Opcion >>>>'); repeat
teb := readkey;
until teb in['1','2','3'];
clrscr;
case teb of
'1' : entrada_datos;
'2' : toma_referencia;
'3' : sal := true;
end;
until sal = true;
end;
begin
menu;
end.
Crear cuenta