program ejemplo_archivos;
uses crt,dos,sysutils;
{en este ejemplo se refleja el uso de registros con archivos
haciendo el uso de insercion, modificacion , y borrado fisico de los
registros}
type
TipoRegistro = Record
Numero : Longint;
Nombre : String[40];
Direccion : String[40];
Telefono : String[10];
End;
TipoArchivo = File Of TipoRegistro;
{*------|------|------|------|------|------|------|------|------|------|----*}
Procedure AperturaDeArchivo(var TArchivo:Tipoarchivo);
var
Error: Word;
Tecla:Char;
Begin
Assign(TArchivo,'c:Archivo.dat');
{$I-}
Reset(TArchivo);
Error:=IOResult;
{$I+}
If Error <> 0 Then
Begin
textattr:=14+4*16;
gotoxy(4,24);write('Creando Bases Temporal !! ');
rewrite(TArchivo);
End;
End;
{*------|------|------|------|------|------|------|------|------|------|----*}
procedure AperturaDeArchivoTemporal(var TTmpAArchivo:TipoArchivo);
var
Error: word;
Tecla:Char;
Begin
Assign(TTmpAArchivo,'c:Archivo.Tmp');
{$I-}
Reset(TTmpAArchivo);
Error:=IOResult;
{$I+}
If Error <> 0 Then
Begin
textattr:=14+4*16;
gotoxy(4,24);write('Creando Bases Temporal !! ');
rewrite(TTmpAArchivo);
End;
End;
{*------|------|------|------|------|------|------|------|------|------|----*}
function BuscaRegistro(Var AArchivo:tipoArchivo;Var TIRegistro:TipoRegistro;Numero:LongInt):longint;
Var
Encontrado:longint;
Begin
textattr:=14+4*16;
gotoxy(4,24);write('Buscando Registro..');
Encontrado :=-1; {inicializamos Encontrado a -1, valor inexistente}
Seek(AArchivo,0); {Posicionamos al inicio el puntero del archivo}
While not EOF(AArchivo) do {iniciamos ciclode recorrido del archivo}
Begin
Read(AArchivo,TIRegistro); {Leemos el Registro segun posicion del puntero}
IF TIRegistro.Numero = Numero then{Comparamos el n£mero de registo con el numero solicitado}
Begin {si es igual el registro encontrado}
Encontrado:=FilePos(AArchivo)-1; {se envia la posicion del registro hallado}
Seek(AARchivo,FileSize(AArchivo)); {se envia el puntero al final del archivo para terminar ciclo}
End;
End;
IF Encontrado <> -1 then {si Encontrado no es igual a -1 , mandamos el valor de la funcion}
Begin
BuscaRegistro:=Encontrado;
End
Else {si no fue encontrado regresamos -1 a la busqueda}
Begin
BuscaRegistro:=-1;
End;
textattr:=0+2*16;
gotoxy(4,24);write(' ');
End;
{*------|------|------|------|------|------|------|------|------|------|----*}
Procedure BorraRegistro(Var AArchivo:Tipoarchivo; TIRegistro:TipoRegistro;Numero:LongInt);
var
TmpArchivo:tipoArchivo;
TmpRegistro:tipoRegistro;
EncontradoB:longint;
Begin {Buscamos si existe el Registro a borrar}
EncontradoB:=BuscaRegistro(AArchivo,TIRegistro,Numero);
IF EncontradoB <> -1 then {Si existe}
Begin
seek(AArchivo,0); {nos posicionamos al inicio del archivo}
While not eof(AArchivo) do {hacemos un ciclo de vaciado de registros a un archivo temporal menos el eliminado}
Begin
Read(AArchivo,TIRegistro); {leemos el registro completo}
IF TIRegistro.Numero <> Numero then {comparamos el campo Registro.numero con el solicitado }
Begin
AperturaDeArchivoTemporal(TmpArchivo); {creamos el temporal}
seek (TmpArchivo,filesize(TmpArchivo)); {nos posicionamos al final del archivo temporal}
write(TmpArchivo,TIRegistro); {escribimos el registro}
Close(TmpArchivo);{cerramos el registro}
End;
End;
Close(AArchivo); {cerramos la bd de trabajo}
erase(AArchivo); {eliminamos la bd de trabajo}
{ se puede usar en caso de no contar con la utileria sysutils
Assign(TmpArchivo,'c:Archivo.Tmp');
Rename(TmpArchivo,'c:Archivo.dat'), en el caso de RenameFile }
If RenameFile ('c:Archivo.tmp','c:Archivo.dat') then
begin
Gotoxy(3,24);write('Registro Eliminado');
Delay(600);
End;
End {encontrado <> -1}
Else
Begin
textattr:=14+4*16;
gotoxy(27,12);write('No Hallado ......!! ');
Delay(1000);
Close(AArchivo); {cerramos la bd de trabajo}
End;
End;
{*------|------|------|------|------|------|------|------|------|------|----*}
Procedure InicializaRegistro(Var TiRegistro : TipoRegistro);
Begin
TiRegistro.Numero :=0;
TiRegistro.Nombre :='';
TiRegistro.Direccion:='';
TiRegistro.Telefono :='';
End;
{*------|------|------|------|------|------|------|------|------|------|----*}
Procedure Alta(TiRegistro:TipoRegistro;Var TiArchivo :TipoArchivo);
Var
Encontrado:Longint;
TmpNumero:Longint;
Salir:char;
Begin
Repeat
InicializaRegistro(TiRegistro);
textattr:=7+0*16;{atributos de pantalla}
Clrscr;
Gotoxy(25,4);write('Alta de Registro');
Gotoxy(25,10);write('Proporcione Numero : ');
readln(TmpNumero);
AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
Encontrado:= BuscaRegistro(TiArchivo,TIRegistro,TmpNumero); {buscamos el registro}
Close(Tiarchivo); {cerramos el archivo}
If Encontrado = -1 Then {no existe}
Begin
textattr:=7+0*16;{atributos de pantalla}
Tiregistro.Numero:=TmpNumero;
Gotoxy(25,12);write('Proporcione Nombre : ');
readln(TiRegistro.Nombre );
Gotoxy(25,14);write('Proporcione Direccion : ');
readln(TiRegistro.Direccion );
Gotoxy(25,16);write('Proporcione Tel‚fono : ');
readln(TiRegistro.Telefono);
{posicionamos el puntero al final del archivo y guardamos}
AperturaDeArchivo(TIArchivo);
Seek (TIArchivo,filesize(TIArchivo));{posicionamos el puntero al final del archivo}
Write(TiArchivo,TiRegistro);{guardamos el registro al final del archivo}
Close(TiArchivo);
delay(100);
End
else {si existe}
begin
Gotoxy(15,17);write('Registro Existente,Pulse Enter');
readkey;
end;
gotoxy(20,22);write('Desea Continuar Almacenando Registros [S/N]');
Salir:=Readkey;
Until (Salir='n') or (Salir='N');
End;
{*------|------|------|------|------|------|------|------|------|------|----*}
Procedure Baja(TiRegistro:TipoRegistro;Var TiArchivo :TipoArchivo);
Var
Encontrado:Longint;
TmpNumero:Longint;
Salir:char;
Begin
Repeat
InicializaRegistro(TiRegistro);
textattr:=7+0*16;{atributos de pantalla}
Clrscr;
Gotoxy(25,4);write('Baja de Registro');
Gotoxy(25,10);write('Proporcione Numero : ');
readln(TmpNumero);
AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
Encontrado:= BuscaRegistro(TiArchivo,TIRegistro,TmpNumero); {buscamos el registro}
Close(Tiarchivo); {cerramos el archivo}
If Encontrado <> -1 Then {existe}
Begin
AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
BorraRegistro(Tiarchivo,TIRegistro,TmpNumero); {llamada al procedimiento de borrado fisico}
End
Else {si no esxiste el registro}
Begin
Gotoxy(15,17);write('Registro No Existe,Pulse Enter');
readkey;
End;
Gotoxy(20,22);Write('Desea Continuar Dando de Baja a Registros [S/N]');
Salir:=Readkey;
Until (Salir='n') or (Salir='N');
End;
{*------|------|------|------|------|------|------|------|------|------|----*}
Procedure Modificacion(TiRegistro:TipoRegistro;Var TiArchivo :TipoArchivo);
Var
Encontrado:Longint;
Salir:char;
Begin
Repeat
InicializaRegistro(TiRegistro);
textattr:=7+0*16;{atributos de pantalla}
Clrscr;
Gotoxy(25,4);write('Modificacion de Registro');
Gotoxy(25,10);write('Proporcione Numero : ');
readln(TiRegistro.Numero);
AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
Encontrado:= BuscaRegistro(TiArchivo,TIRegistro,TiRegistro.Numero); {buscamos el registro}
Close(Tiarchivo); {cerramos el archivo}
If Encontrado <> -1 Then {existe}
Begin
textattr:=7+0*16;{atributos de pantalla}
Gotoxy(25,12);write('Proporcione Nombre : ');
readln(TiRegistro.Nombre );
Gotoxy(25,14);write('Proporcione Direccion : ');
readln(TiRegistro.Direccion );
Gotoxy(25,16);write('Proporcione Tel‚fono : ');
readln(TiRegistro.Telefono);
AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
seek (TIArchivo,Encontrado);{posicionamos el p£ntero en la posici¢n donde se encontr¢ el registro en el archivo}
write(TiArchivo,TiRegistro);{escribimos el registor modificado}
close(TiArchivo);
End
Else
Begin
Gotoxy(15,17);write('Registro No Existe,Pulse Enter');
readkey;
End;
Gotoxy(20,22);Write('Desea Continuar Modificando Registros [S/N]');
Salir:=Readkey;
Until (Salir='n') or (Salir='N');
End;
{*------|------|------|------|------|------|------|------|------|------|----*}
Procedure Consulta(TiRegistro:TipoRegistro;Var TiArchivo :TipoArchivo);
Var
Encontrado:Longint;
Salir:char;
Begin
Repeat
InicializaRegistro(TiRegistro);
textattr:=7+0*16;{atributos de pantalla}
Clrscr;
Gotoxy(25,4);write('Consulta de Registro');
Gotoxy(25,10);write('Proporcione Numero : ');
readln(TiRegistro.Numero);
AperturaDeArchivo(TIArchivo); {aperturamos el archivo}
Encontrado:= BuscaRegistro(TiArchivo,TIRegistro,TiRegistro.Numero); {buscamos el registro}
Close(Tiarchivo); {cerramos el archivo}
If Encontrado <> -1 Then {existe}
Begin
textattr:=7+0*16;{atributos de pantalla}
Gotoxy(25,12);write('Nombre : ',TiRegistro.Nombre );
Gotoxy(25,14);write('Direccion : ',TiRegistro.Direccion );
Gotoxy(25,16);write('Tel‚fono : ',TiRegistro.Telefono);
End
Else {si no existe el registro}
Begin
Gotoxy(15,17);write('Registro No Existe,Pulse Enter');
readkey;
End;
Gotoxy(20,22);Write('Desea Continuar Consultando Registros [S/N]');
Salir:=Readkey;
Until (Salir='n') or (Salir='N');
End;
{*------|------|------|------|------|------|------|------|------|------|----*}
Procedure Listado(TiRegistro:TipoRegistro;var TiArchivo:tipoArchivo);
Var
Contador:integer;
Begin
textattr:=7+0*16;{atributos de pantalla}
Clrscr;
Gotoxy(2,2);write('Numero Nombre Direccion');
Seek(TiArchivo,0); {Posicionamos al inicio el puntero del archivo}
contador:=3;
While not eof(TiArchivo) do
Begin
Read(TiArchivo,TIRegistro); {Leemos el Registro segun posicion del puntero}
gotoxy(2,contador); Write(TIRegistro.Numero);
gotoxy(17,contador); Write(TIRegistro.Nombre);
gotoxy(47,contador); Write(TIRegistro.Direccion);
inc(contador);
End;
readkey;
End;
{*------|------|------|------|------|------|------|------|------|------|----*}
Procedure Menu(TiRegistro:TipoRegistro; Var TiArchivo:TipoArchivo);
Var
Tecla:Char;
Begin
ClrScr;
Repeat
textattr:=7+0*16;{atributos de pantalla}
ClrScr;
Gotoxy(25,6);Write('Alta de Registro ..............[1]');
Gotoxy(25,8);Write('Modificacion de Registro ......[2]');
Gotoxy(25,10);Write('Baja de Registro ..............[3]');
Gotoxy(25,12);Write('Consulta de Registro ..........[4]');
Gotoxy(25,14);Write('Listado de Registros...........[5]');
Gotoxy(25,16);Write('Salir .........................[6]');
Tecla:=Readkey;
Case Tecla of
'1':Begin
Alta(Tiregistro,TiArchivo);
End;
'2':Begin
Modificacion(TiRegistro,TiArchivo );
End;
'3':Begin
Baja(TiRegistro,TiArchivo );
End;
'4':Begin
Consulta(TiRegistro,TiArchivo );
End;
'5':Begin
AperturaDeArchivo(Tiarchivo);
Listado(TiRegistro,TiArchivo);
Close(TiArchivo);
End;
End;
Until Tecla = '6';
end;
{*------|------|------|------|------|------|------|------|------|------|----*}
{ Cuerpo del programa }
var
TiArchivo : TipoArchivo;
TiRegistro : TipoRegistro;
Begin
Menu(TiRegistro,TiArchivo);
end.
Mostrar Mensajes
