Pascal/Turbo Pascal - Lista no muestra nada.

program projecto2;

USES crt;

CONST {declaracion de archivos como constantes}

FICHEROPER =  'D:\Programacion\PASCAL\Ficheros\ficherouser1.dat'; {fichero guarda clientes 1}

FICHEROPERT = 'D:\Programacion\PASCAL\Ficheros\ficherouser2.dat'; {Fichero aux}

FICHEROINS =  'D:\Programacion\PASCAL\Ficheros\ficheroinst1.dat'; {fichero guarda instrumentos 1}

FICHEROINST = 'D:\Programacion\PASCAL\Ficheros\Ficheroinst2.dat'; {fichero aux cli}

TYPE

regcli = record              //Registro de clientes//

 nomape: string[40];

 documento,telefono: real;

 nrouser: word;

 direccion: string[40];

 prestamo: boolean;

 codin: word;

end;

reginst = record              //Registro de Instrumentos//

 Nombre,Tipo: string[40];

 stock: word;

 codigo: word;

end;

reglista = record                //registro//

 Nom,Dnom,Dti:string[40];

 Udoc,Utel:real;

 COD:word;

end;

lista = ^nodo;

nodo =  record

 datos:reglista;

 psig:lista;

end;

clientes=file of regcli;

instrumentos=file of reginst;

{-----------PROCEDIMIENTOS----------}

procedure insord (var L:lista ;var datos:reglista; rega:regcli; regb:reginst);

var

nuevo:lista;

begin

new (nuevo);

nuevo^.datos.Nom:=rega.nomape;               //envia a un vector de 2 posiciones los datos del usuario e inst//

nuevo^.datos.Udoc:=rega.documento;           //v[1]contiene datos del usuario, el otro dle instrumento

nuevo^.datos.Utel:=rega.telefono;

nuevo^.datos.Dnom:=regb.Nombre;

nuevo^.datos.Dti:=regb.tipo;

nuevo^.datos.COD:=regb.codigo;

nuevo^.psig:=L;

L:=nuevo;

end;

procedure mostrarlista (var L:lista; var datos:reglista);                 //muestra lista mientras no sea = nil//

 var

 aux:lista;

begin

     aux:=L;

     while aux<>nil do

begin

         writeln ('Nombre ', aux^.datos.nom);

         writeln ('Documento ', aux^.datos.udoc:7:0);

         writeln ('Telefono ', aux^.datos.utel:9:0);

         writeln ('Nombre ins ',aux^.datos.Dnom);

         writeln ('Tipo ',aux^.datos.dti);

         writeln ('Codigo ',aux^.datos.COD);

         aux:=aux^.psig;

         end;

     end;

procedure cargacli (var clients:clientes ; var reg_cli:regcli); {procedimiento carga de datos de cliente}

begin

seek (clients,filesize(clients));

writeln ('ingrese el numero de documento sin (.)');   //Carga en el archivo los datos del cliente//

readln (reg_cli.documento);

writeln ('ingrese el numero de telefono');

readln (reg_cli.telefono);

writeln ('ingrese la direccion');

readln (reg_cli.direccion);

reg_cli.prestamo := false;                           //bandera de prestamo

reg_cli.nrouser := filesize(clients) + 1;            //asigna un codigo al usuario

reg_cli.codin:=0;                                    //variable para el codigo del instrumento que posee prestado//

writeln ('El codigo de usuario es ', reg_cli.nrouser);

end;

procedure cargains (var instru:instrumentos; var reg_ins:reginst); {procedimiento carga de instrumentos}

begin

seek (instru,filesize(instru));

writeln ('ingrese el tipo de instrumento [CUERDA / VIENTO / ELECTRONICO / PERCUCION]');//carga los datos del inst//

readln (reg_ins.Tipo);

writeln ('ingrese la cantidad de instrumentos a registrar');

readln (reg_ins.stock);

reg_ins.codigo:=filesize(instru) + 1;                      //Asigna un codigo al instrumento//

writeln ('el codigo del instrumento es ', reg_ins.codigo);

end;

procedure clisearch (var clients:clientes ; var reg_cli:regcli; var controlc:real ;var exist:boolean;var a:word );  {procedimiento recorrer archivo}

var

i:word;

begin

exist:=false;

i:=0;

writeln ('Ingrese DNI sin puntos [.]');

readln (controlc);

for i:=0 to fileSize(clients)-1 do                      //se ingresa el dni y se busca en el archivo//

begin

seek (clients,i);

read (clients,reg_cli);

if reg_cli.documento=controlc then

begin                                                   //cuando se encuentra se guarda la posicion en la variable a//

a:=i;                                                   //se marca la vandera exist en true//

exist:=true;

writeln ('El nombre y apellido es :',reg_cli.nomape);             //se muestran todos los datos//

writeln ('El numero de documento es:',reg_cli.documento:8:0);

writeln ('El numero de telefono es:',reg_cli.telefono:12:0);

writeln ('La direccion es:',reg_cli.direccion);

writeln ('El numero de usuario es:',reg_cli.nrouser);

 if reg_cli.prestamo = true then

               begin

               writeln ('El usuario posee instrumentos prestados');

               end

               else

               writeln ('El usuario no posee instrumentos prestados');

end;

end;

if exist=false then                                                //si no se encontro se muestra el siguiente mensaje//

begin

 writeln ('No existe un usuario con el documento nro >> ', controlc:8:0 ,' <<');

end;

end;

procedure editcli (var clients:clientes ; var reg_cli:regcli);    {Procedimiento editar usuario}

var

k:word;

begin

writeln ('1) Para editar nombre y apellido');

writeln ('2) Para editar DNI');

writeln ('3) Para editar numero telefonico');

writeln ('4) Para editar domicilio');

readln (k);

case k of                                                    //un caso nos da a elegir que dato especifico queremos editar//

 1: begin

     writeln ('Ingrese el nuevo nombre');

     readln (reg_cli.nomape)

    end;

 2: begin

     writeln ('Ingrese el nuevo DNI');

     readln (reg_cli.documento);

    end;

 3: begin

     writeln ('Ingrese el nuevo numero telefonico');

     readln (reg_cli.telefono);

 end;

 4: begin

     writeln ('Ingrese el nuevo domicilio');

     readln (reg_cli.direccion);

 end;

 end;

 writeln ('*DATOS MODIFICADOS CON EXITO*');

end;

procedure borraruser (var a:word ; var clients:clientes ; var clientsx:clientes);   {procedimiento borrar usuario}

var

l,m:word;

reg_cliaux: regcli;

reg_cliaux2: regcli;

begin                                                                      //crea un fichero auxiliar//

  Assign (clientsx,FICHEROPERT);

  rewrite (clientsx);

  for l:= 0 to filesize(clients)-1 do                                      //recorre el fichero y mientras el registr sea distinto del seleccionado es enviado al auxiliar//

   begin

   if l <> a then

    begin

    seek (clients,l);

    read (clients,reg_cliaux);

    reg_cliaux2:=reg_cliaux;

    write (clientsx,reg_cliaux2);

    end;

   end;

   ReWrite (clients);                                                    //se pone el fichero principal en blanco//

   for m:=0 to filesize(clientsx)-1 do                                   //recorre el fichero auxiliar y copia todos los datos para volver a enviarlos al fichero principal//

    begin

    seek (clientsx,m);

    read (clientsx,reg_cliaux2);

    reg_cliaux:=reg_cliaux2;

    write (clients,reg_cliaux);

    end;

   close (clientsx);

end;

procedure searchinst (var b:word ; var instru:instrumentos ; var reg_ins:reginst; var existe:boolean); {procedimiento busca instrumentos}

var

controlA,controlB:string[20];

i:word ;

begin

 existe:=false;

   writeln ('Ingrese el nombre del instrumento');

    readln (controlA);

    writeln ('Ingrese el tipo de instrumento');

    readln (controlB);                                               //ingresa 2 variables por teclado y recorre el archivo, mientras las 2 variables sean verdaderas //

    for i:=0 to fileSize(instru)-1 do                                //se entrega una variable con la posicion y un bool en true para señalar que existe//

     begin

      seek (instru,i);

      read (instru,reg_ins);

       if reg_ins.nombre=controlA then

       begin

        if reg_ins.tipo=controlB then

        begin

        existe:=true;

        b:=i;

    end;

        if existe = false then

        begin

       writeln ('No existe ningun instrumento con esas caracteristicas');

        end;

     end;

end;

end;

procedure borrarinst (var a:word ; var instru:instrumentos ; var instrux:instrumentos); {procedimiento borrar instrumento}

var

l,m:word;

reg_insaux:reginst;

reg_insaux2:reginst;

begin                                                                    //recorre el archivo//

Assign (instrux,FICHEROINST);

rewrite (instrux);

for l:=0 to filesize(instru)-1 do

 begin

 if l <> a then                                                         //mientras el registro sea distinto al seleccionado se copia a otro archivo auxiliar//

  begin

  seek (instru,l);

  read (instru,reg_insaux);

  reg_insaux2:=reg_insaux;

  write (instrux,reg_insaux2);

  end;

  end;

  Rewrite (instru);

  for m:=0 to filesize(instrux)-1 do                                   //se pone en blanco el archivo principal y luego todo lo del auxiliar es vuelto a copiar//

   begin

   seek (instrux,m);

   read (instrux,reg_insaux2);

   reg_insaux:=reg_insaux2;

   write (instru,reg_insaux);                                          //por ultimo el archivo aux tambien se pone en blanco//

   end;

  close (instrux);

 end;

VAR

m,rta3,a,b,aux,rta,i,menu:word;

clients,clientsx: clientes;

instru,instrux: instrumentos;

reg_cli,rega: regcli;

reg_ins,regb: reginst;

controlA,controlB:string[20];

lit,bol,exist,k,existe:boolean;

controlc:real;

rta2,rta4:char;

datos:reglista;

L,list:lista;

BEGIN

Assign (clients,FICHEROPER);

{$I-} reset(clients); {$I+}

if ioresult <> 0 then

 begin

 rewrite (clients);

 end;

Assign (instru,FICHEROINS);

{$I-} ReSet (instru); {$I+}

if ioresult <> 0 then

 begin

 rewrite (instru);

 end;

k:= false;

L:=nil;

repeat

writeln ('Ingrese la opcion que desea (1-2-3-4)');

writeln ('1)Agregar un usuario');

writeln ('2)Agregar un instrumento');

writeln ('3)Buscar un usuario o instrumento');

writeln ('4)Registrar un prestamo o devolucion');

writeln ('5)Salir');

readln (menu);

case menu of

1:Begin                                                                  //CASO PRINCIPAL: AGREGAR USUARIO//

  end;

2:begin                                                                           //CASO PRINCIPAL: AGREGAR INSTRUMENTO//

3:begin                                                             //CASO PRINCIPAL:BUSCADOR//

4:begin                                    //CASO PRINCIPAL: PRESTAMOS Y DEVOLUCIONES//

  writeln ('***** PRESTAMOS Y DEVOLUCIONES *****');

  writeln ('1)Registrar un prestamo');

  writeln ('2)Registrar una devolucion');

  readln (rta3);

  case rta3 of                                    //caso para elegir la opcion deseada, prestamo o devolucion//

  1:begin

    seek (clients,0);

    seek (instru,0);

    writeln (' *** PRESTAMO *** ');               //subcaso 1 prestamo//

    Writeln ('Busqueda del cliente');

    clisearch (clients,reg_cli,controlc,exist,a); //procedimiento busqueda de cliente//

    if exist = true then

    begin

    seek (clients,a);

    read (clients,reg_cli);

    if reg_cli.prestamo = false then               //reg_cli.prestamo es un booleano que señala si posee instrumento (true) o no (false)

    begin

    writeln ('Busqueda del instrumento');

    searchinst (b,instru,reg_ins,existe);          //procedimiento busqueda del instrumento//

    seek (instru,b);

    read (instru,reg_ins);

    if existe = true then

    begin

     seek (clients,a);

     seek (instru,b);

     reg_cli.prestamo:= true;

     reg_cli.codin:=reg_ins.codigo;               //se le asigna el codigo del instrumento prestado//

     if reg_ins.stock > 0 then

     begin

     rega.nomape:=reg_cli.nomape;

     rega.direccion:=reg_cli.direccion;

     rega.telefono:=reg_cli.telefono;

     regb.Nombre:=reg_ins.Nombre;

     regb.Tipo:=reg_ins.tipo;

     regb.codigo:=reg_ins.codigo;

     reg_ins.stock:=reg_ins.stock-1;              //se resta el stock//

     writeln ('Instrumento asociado correctamente');

     Writeln;

     insord (L,datos,reg_cli,reg_ins);

     writeln ('La cantidad de ',reg_ins.Nombre,'s actualmente es de ',reg_ins.stock); //se muestra lo asociado//

      write (clients,reg_cli);

      write (instru,reg_ins);

     end else

     writeln('No hay stock suficiente');

     reg_cli.prestamo:=true;

     reg_cli.codin:=0

    end;

    end;

    end;

    readkey;

   end;

  2:begin

     writeln (' *** DEVOLUCION *** ');                //Subcaso devolucion//

     writeln ('Busqueda del cliente');

     clisearch (clients,reg_cli,controlc,exist,a);

     if exist = true then

     begin

      seek (clients,a);

      read (clients,reg_cli);

      if reg_cli.prestamo = true then

      begin

         seek(clients,a);

         reg_cli.prestamo := false;

         write (clients,reg_cli);

         {funcion que busca nodo usando el nro de doc y devuelve el cod de inst}

         {funcion busca inst por cod en el archivo}

         {reg_ins.stock:=reg_ins.stock + 1 <--- agregar};

      end;

     end;

  end;

  end;

  end;

5:begin

 k:=true

 end;

6:begin

  mostrarlista (list,datos);

  readkey;

 end;

end;{fincaso}

clrscr;

until k=true;

close (clients);

close (instru);

writeln ('*** EL PROGRAMA SE CERRARA ***');

readkey;

END.