lunes, 11 de febrero de 2008

PROGRMA DE ARCHIVO

Program Directo1;
Uses WinCrt;
Const
esc = #27;
Type
datos = record
clave : integer;
PRECIO : REAL;
PLACA : STRING[7];
descripcion : string[30];
MODELO : string[20];
cantexist : integer;
estado : boolean;
end;
Var
archivo :file of datos;
registro :datos;
tecla :char;

procedure error(error:integer);
begin
Gotoxy(20,21);
Case error Of
152:Write('UNIDAD NO PREPARADA');
162:Write('FALLA EN EL HARDWARE');
104:Write('ARCHIVO NO ABIERTO PARA ENTRADA');
100:Write('ERROR DE LECTURA EN DISCO');
150:Write('PROTEGIDO CONTRA ESCRITURA');
2 :Write('EL ARCHIVO NO EXISTE')
end;
ReadKey
end;


procedure AGREGAR;
Var
otro :char;
CodError:integer;
begin
{$I-}
Reset(archivo);
CodError:=IOResult;
{$I+}
Case CodError Of
0: Seek(archivo,FileSize(archivo));
2: Rewrite(archivo)
else
begin
error(CodError);
exit
end
end;
With registro Do
begin
Repeat
ClrScr;
gotoxy(30,5);Write('¿¿¿¿¿¿¿ INGRESO DE MODELOS AL SISTEMA ¿¿¿¿¿¿¿');
clave:=FileSize(archivo);
gotoxy(25,7);Write('Clave : ',clave);
gotoxy(25,8);Write('descripcion : ');
ReadLn(descripcion);
gotoxy(25,9);Write('PLACA : ');
ReadLn(placa);
gotoxy(25,10);Write('MODELO : ');
ReadLn(MODELO);
gotoxy(25,11);Write('PRECIO : ');
ReadLn(PRECIO);
Repeat

{$I-}
gotoxy(25,12);write('existencia : ');
ReadLn(cantexist);
{$I+}
until IOResult=0;
estado:=true;
Write(archivo,registro);
gotoxy(20,22);write('Desea dar AGREGAR OTRO MODELO s/n? ');
otro:=ReadKey
until otro in ['n','N',Esc]
end;
Close(archivo)
end;
procedure ELIMINAR;
Var
otro :char;
clave :integer;
CodError:integer;
begin
{$I-}
Reset(archivo);
CodError:=IOResult;
{$I+}
if CodError<>0 then
begin
error(CodError);
exit
end;
Repeat
ClrScr;
gotoxy(30,5);Write('%%%%%%%%%%%% ELIMINAR MODELO %%%%%%%%%%%%');
Repeat
{$I-}
gotoxy(25,7);Write('Clave : ');
ReadLn(clave);
{$I+}
until IOResult=0;
registro.estado:=false;
if((clave>=0)and(clave<=FileSize(archivo)-1)) then
begin
seek(archivo,clave);
Read(archivo,registro)
end;
if registro.estado=true then
begin
gotoxy(25,8);Write('descripcion : ');
Write(registro.descripcion);
gotoxy(25,9);Write('tipo : ');
Write(registro.MODELO);
GOTOXY(25,10);WRITE('PLACA : ');
WRITE(REGISTRO.placa);
gotoxy(25,11);write('existencia : ');
Write(registro.cantexist);
gotoxy(25,12);Write('PRECIO : ');
WRITE(REGISTRO.PRECIO:03:02);
gotoxy(20,15);Write('Desea eliminarlo s/n? ');
if otro in['s','S'] then
begin
Seek(archivo,clave);
registro.estado:=false;
Write(archivo,registro);
gotoxy(20,17);Write('Registro Eliminado...')
end
end
else
begin
gotoxy(20,10); Write('modelo no existe...')
end;
gotoxy(20,22);write('Desea eliminar otro s/n? ');
otro:=ReadKey
until otro in ['n','N',Esc];
Close(archivo)
end;
procedure MODIFICAR;
Var
otro :char;
clave :integer;
CodError:integer;
aux :datos;
begin
{$I-}
Reset(archivo);
CodError:=IOResult;
{$I+}
if CodError<>0 then
begin
error(CodError);
exit
end;
Repeat
ClrScr;
gotoxy(30,5);Write('çççççç MODIFICACIONES DE LOS MODELOS çççççç');
gotoxy(25,6);Write('Si no desea modificar presione Enter');
Repeat
{$I-}
gotoxy(25,7);Write('Clave : ');
ReadLn(clave);
{$I+}
until IOResult=0;
registro.estado:=false;
if((clave>=0)and(clave<=FileSize(archivo)-1)) then
begin
seek(archivo,clave);
Read(archivo,registro)
end;
if registro.estado=true then
begin
move(registro,aux,SizeOf(aux));
gotoxy(1,10);Write('descripcion : ');Write(registro.descripcion);
gotoxy(35,10);Write('Nuevo descripcion : ');ReadLn(aux.descripcion);
if(length(aux.descripcion)=0) then
begin
aux.descripcion:=registro.descripcion;
gotoxy(50,10);WriteLn(aux.descripcion);
end;
gotoxy(1,11);Write('PLACA : ');Write(registro.PLACA);
gotoxy(35,11);Write('NUEVA PLACA : ');ReadLn(aux.PLACA);
if(length(aux.PLACA)=0) then
begin
aux.PLACA:=registro.PLACA;
gotoxy(50,11);WriteLn(aux.PLACA);
end;
gotoxy(1,12);Write('MODELO : ');Write(registro.MODELO);
gotoxy(35,12);Write('NUEVO MODELO : ');ReadLn(aux.MODELO);
if(length(aux.MODELO)=0) then
begin
aux.MODELO:=registro.MODELO;
gotoxy(50,12);WriteLn(aux.MODELO);
end;
gotoxy(1,13);Write('PRECIO : ');Write(registro.PRECIO:03:02);
gotoxy(35,13);Write('NUEVO PRECIO : ');ReadLn(aux.PRECIO);
if(aux.PRECIO=0) then
begin
aux.PRECIO:=registro.PRECIO;
gotoxy(50,13);WriteLn(aux.PRECIO);
END;
gotoxy(1,14);write('existencia : ');Write(registro.cantexist);
Repeat
{$I-} {validación de entrada de datos}
gotoxy(35,14);Write('Nuevo existencia : ');ReadLn(aux.cantexist);
{$I+}
until (IOResult=0);
if(aux.cantexist=0) then
begin
aux.cantexist:=registro.cantexist;
gotoxy(50,12);WriteLn(aux.cantexist);
end;
gotoxy(20,15);Write('Las modificaciones están correctas s/n? ');
otro:=ReadKey;Write(otro);
if otro in['s','S'] then
begin
Seek(archivo,clave);
Write(archivo,aux);
gotoxy(20,17);Write('Registro modificado...')
end
end
else
begin
gotoxy(20,10); Write('La clave no existe...')
end;
gotoxy(20,22);write('Desea realizar otra modificación s/n? ');
otro:=ReadKey
until otro in ['n','N',Esc]
end;
procedure INDIVIDUAL;
Var
otro:char;
clave:integer;
CodError:integer;
begin
{$I-}
Reset(archivo);
CodError:=IOResult;
{$I+}
if CodError<>0 then
begin
error(CodError);
exit
end;
Repeat
ClrScr;
gotoxy(30,5);Write('@@@@@ COSNSULTA DE LOS MODELOS INDIVIDUAL @@@@');
Repeat
{$I-}
gotoxy(25,7);Write('Clave : ');
ReadLn(clave);
{$I+}
until IOResult=0;
registro.estado:=false;
if((clave>=0)and(clave<=FileSize(archivo)-1)) then
begin
seek(archivo,clave);
Read(archivo,registro)
end;
if registro.estado=true then
begin
gotoxy(25,8);Write('DESCRIPCION : ');
Write(registro.descripcion);
gotoxy(25,9);Write('PLACA : ');
Write(registro.PLACA);
gotoxy(25,10);Write('MODELO : ');
Write(registro.MODELO);
gotoxy(25,11);Write('PRECIO : ');
Write(registro.PRECIO:03:02);
gotoxy(25,12);write('existencia : ');
Write(registro.cantexist);
end
else
begin
gotoxy(20,13); Write('LA CLAVE NO EXISTE')
end;
gotoxy(20,22);write('Desea consultar otro producto s/n? ');
otro:=ReadKey
until otro in ['n','N',Esc];
Close(archivo)
end;
procedure GENERAL;
Var
CodError:integer;
begin
{$I-}
reset(archivo);
CodError:=IOResult;
{$I+}
if CodError<>0 then
error(CodError)
else
begin
With registro Do
begin
while not(Eof(archivo)) Do
begin
ClrScr;
Read(archivo,registro);
Writeln('********** CONSULTA DE MODELOS ***********');
Writeln('CLAVE DESCRIPCION MODELO EXISTENCIA PLACA');
Writeln(clave,' ',descripcion,' ',MODELO,' ',cantexist,' ',PLACA);
readkey;
end;
end;
Close(archivo)
end
end;

begin
Assign(archivo,'MODELO.dat');
Repeat
ClrScr;
gotoxy(30,5);Write('&&&&&& CONCESONARIO TIRAME ALGO &&&&&&&&&');
gotoxy(35,8);Write('1. AGREGAR AUTOMOVILES');
gotoxy(35,9);Write('2. ELIMINAR UTOMOVILES');
gotoxy(35,10);Write('3. MODIFICA AUTOMOVILES');
gotoxy(35,11);write('4. CONSULTAR AUTOMOVILES EN ORDEN');
gotoxy(35,12);write('5. CONSULTAR DE MANERA INDIVIDUAL');
gotoxy(35,13);Write('6. SALIR (Esc)');
gotoxy(35,15);Write('OPCION [ ]');
gotoxy(43,15);
tecla:=ReadKey;
case tecla of
'1' :AGREGAR;
'2' :ELIMINAR;
'3' :MODIFICAR;
'4' :GENERAL;
'5' :INDIVIDUAL
end
until tecla in ['6',esc];
ClrScr
end.