Pascal/Turbo Pascal - Ayuda para crear un archivo

{Mira esto seria algo como esto comenta si valdría y si es con punteros o solo archivo }

program libreria;

  uses

     crt;

  type

     libro = record

            numero    : longint;

            titulo    : string[80];

            autor     : string[100];

            editorial : string[80];

            edicion   : string[12];

            codigo    : longint;

            estado    : boolean;

         end;

     socios = record

            numero             : longint;

            apellido           : string[80];

            nombres            : string[80];

            domicilio          : string[120];

            localidad          : string[100];

            codigo_postal      : string[60];

            telefono           : longint;

            correo_electronico : string;

         end;

     prestamo = record

            numero_socio : longint;

            numero_libro : longint;

          fecha_prestamo : string[12];

             devolucion  : boolean;

         end;

     biblioteca = record

            plibros : libro;

            psocios : socios;

            pprestamo : prestamo;

         end;

  const

     codigo_temas : array[1..8] of string[20] = (

     'matematica','lengua y literatura','ciencias sociales',

     'idiomas extranjeros','informatica','arte y cultura',

     'pedagogia y didactica','otros');

     prestamomax = 2;

  var

    f : file of biblioteca;

    dato : biblioteca;

  begin

  end.

{Mira esto como te parece te valdrá queda algo luego te lo paso cuando lo termine pero pasa te esto}

program libreria;

  uses

     crt;

  type

     ptlibro = ^libro;

     libro = record

            numero    : longint;

            titulo    : string[80];

            autor     : string[100];

            editorial : string[80];

            edicion   : string[12];

            codigo    : string[20];

            estado    : boolean;

            sig : ptlibro;

         end;

     ptsocios = ^socios;

     socios = record

            numero             : longint;

            apellido           : string[80];

            nombres            : string[80];

            domicilio          : string[120];

            localidad          : string[100];

            codigo_postal      : string[60];

            telefono           : longint;

            correo_electronico : string;

                        estado : boolean;

                          sigs : ptsocios;

              end;

     ptprestamo = ^prestamo;

     prestamo = record

            numero_socio : longint;

            numero_libro : longint;

          fecha_prestamo : string[12];

              devolucion : boolean;

                   sigp  : ptprestamo;

         end;

  const

     codigo_temas : array[1..8] of string[20] = (

     'matematica','lengua y literatura','ciencias sociales',

     'idiomas extranjeros','informatica','arte y cultura',

     'pedagogia y didactica','otros');

     prestamomax = 2;

  var

    fl : file of libro;

    fs : file of socios;

    fp : file of prestamo;

    plibros : libro;

    psocios : socios;

    pprestamo : prestamo;

    actul, priml, ultiml : ptlibro;

    actus, prims, ultims : ptsocios;

    actup, primp, ultimp : ptprestamo;

  procedure guarda_datos(cual : char);

  begin

   if cual = 'L' then

   begin

     assign(fl,'estantes.dat');

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

     if ioresult <> 0 then

     begin

        rewrite(fl);

        seek(fl,0);

        write(fl,actul^);

        close(fl);

     end

  else

      begin

         seek(fl,filesize(fl));

         write(fl,actul^);

         close(fl);

      end;

    end;

      if cual = 'S' then

   begin

     assign(fs,'socios.dat');

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

     if ioresult <> 0 then

     begin

        rewrite(fs);

        seek(fs,0);

        write(fs,actus^);

        close(fs);

     end

  else

      begin

         seek(fs,filesize(fs));

         write(fs,actus^);

         close(fs);

      end;

    end;

    if cual = 'P' then

   begin

     assign(fp,'prestamo.dat');

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

     if ioresult <> 0 then

     begin

        rewrite(fp);

        seek(fp,0);

        write(fp,actup^);

        close(fp);

     end

  else

      begin

         seek(fp,filesize(fp));

         write(fp,actup^);

         close(fp);

      end;

    end;

  end;

  procedure entrada_puntero(let : char);

  begin

  if let = 'L' then

  begin

     if priml = nil then

     begin

        new(actul);

        actul^ := plibros;

        priml := actul;

        actul^.sig := nil;

      end

    else

       begin

         ultiml := actul;

         new(actul);

         actul^ := plibros;

         ultiml^.sig := actul;

         actul^.sig := nil;

       end;

     end;

    if let = 'S' then

    begin

       if prims = nil then

     begin

        new(actus);

        actus^ := psocios;

        prims := actus;

        actus^.sigs := nil;

      end

    else

       begin

         ultims := actus;

         new(actus);

         actus^ := psocios;

         ultims^.sigs := actus;

         actus^.sigs := nil;

       end;

     end;

    if let = 'P' then

    begin

       if primp = nil then

        begin

        new(actup);

        actup^ := pprestamo;

        primp := actup;

        actup^.sigp := nil;

      end

    else

       begin

         ultimp := actup;

         new(actup);

         actup^ := pprestamo;

         ultimp^.sigp := actup;

         actup^.sigp := nil;

       end;

     end;

       guarda_datos(let);

    end;

  procedure entrada_libros;

  var

    codi : integer;

  begin

     clrscr;

     writeln('   ***** Entrada Libros *****');

     writeln;

     write('   Numero            : ');

     readln(plibros.numero);

     write('   Titulo            : ');

     readln(plibros.titulo);

     write('   Autor             : ');

     readln(plibros.autor);

     write('   Editorial         : ');

     readln(plibros.editorial);

     write('   Edicion           : ');

     readln(plibros.edicion);

     write('   Codigo Num. 1 a 8 : ');

     readln(codi);

     if (codi < 1) or (codi > 8) then

     begin

       repeat

        writeln('Codigo No Correcto Es De 1..8');

        writeln;

        write('   Codigo Num. 1 a 8 : ');

        readln(codi);

      until codi in[1..8];

     end;

     plibros.codigo := codigo_temas[codi];

     plibros.estado := true;

     entrada_puntero('L');

  end;

  function es_sicio(ns : longint) : boolean;

  var

    t : longint;

    tem : socios;

  begin

      es_sicio := false;

      assign(fs,'socios.dat');

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

     if ioresult <> 0 then

     begin

        writeln('   Error De Archivo No Encontrado Pulse Una Tecla');

        readkey;

     end

   else

      begin

        for t := 0 to filesize(fs) - 1 do

        begin

           seek(fs,t);

           read(fs,tem);

           if tem.numero = ns then

           begin

              es_sicio := true;

              break;

           end;

        end;

         close(fs);

     end;

  end;

  procedure alta_socio;

  begin

      clrscr;

      writeln('   ***** Entrada Socios *****');

      writeln;

      write('  Entre Num. Socio         : ');

      readln(psocios.numero);

      if es_sicio(psocios.numero) = false then

      begin

      write('  Entre Apellido           : ');

      readln(psocios.apellido);

      write('  Entre Nombre             : ');

      readln(psocios.nombres);

      write('  Entre Domicilio          : ');

      readln(psocios.domicilio);

      write('  Entre Localidad          : ');

      readln(psocios.localidad);

      write('  Entre Codigo Postal      : ');

      readln(psocios.codigo_postal);

      write('  Entre Telefono           : ');

      readln(psocios.telefono);

      write('  Entre Correo Electronico : ');

      readln(psocios.correo_electronico);

      psocios.estado := true;

      guarda_datos('S');

     end

   else

      begin

      writeln('  El Socio Ya existe Pulse Una Tecla');

      readkey;

      end;

    end;

  procedure el_prestamo;

  begin

     clrscr;

     writeln('   ***** Entrada Prestamo *****');

     writeln;

     write('  Entre Num. Socio     : ');

     readln(pprestamo.numero_socio);

     if es_sicio(pprestamo.numero_socio) = true then

     begin

     write('  Entre Num. Libro     : ');

     readln(pprestamo.numero_libro);

     write('  Entre Fecha Prestamo : ');

     readln(pprestamo.fecha_prestamo);

     pprestamo.devolucion := false;

     guarda_datos('P');

     end

  else

     begin

        writeln('  Error Socio Desconocido Pulse Una Tecla');

        readkey;

     end;

  end;

  procedure anula_libro;

  var

    nn, ds : longint;

    ssi : boolean;

   begin

      clrscr;

      writeln('   Anular Un Libro');

      writeln;

      write('   Entre Num. Libro : ');

      readln(nn);

      assign(fl,'estantes.dat');

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

     if ioresult <> 0 then

     begin

        writeln('   Error De Archivo Pulse Una Tecla');

        readkey;

     end

   else

      begin

         ssi := false;

         for ds := 0 to filesize(fl) - 1 do

         begin

            seek(fl,ds);

            read(fl,plibros);

            if plibros.numero = nn then

            begin

               plibros.estado := false;

               ssi := true;

               break;

            end;

         end;

         close(fl);

         if ssi = true then

         writeln('  Libro Anulado Pulse Una Tecla')

       else

         writeln('  El Num. Entrado No Existe Pulse Una Tecla');

         readkey;

      end;

   end;

  procedure anula_socio;

  var

    nn, ds : longint;

    ssi : boolean;

   begin

      clrscr;

      writeln('   Anular Un Socio');

      writeln;

      write('   Entre Num. Socio : ');

      readln(nn);

      assign(fs,'socios.dat');

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

     if ioresult <> 0 then

     begin

        writeln('   Error De Archivo Pulse Una Tecla');

        readkey;

     end

   else

      begin

         ssi := false;

         for ds := 0 to filesize(fs) - 1 do

         begin

            seek(fs,ds);

            read(fs,psocios);

            if psocios.numero = nn then

            begin

               psocios.estado := false;

               ssi := true;

               break;

            end;

         end;

         close(fp);

         if ssi = true then

         writeln('  Socio Anulado Pulse Una Tecla')

       else

         writeln('  El Num. Socio Entrado No Existe Pulse Una Tecla');

         readkey;

      end;

   end;

  procedure anula_prestamo;

  var

    nn, ds : longint;

    ssi : boolean;

   begin

      clrscr;

      writeln('   Anular Un Prestamo');

      writeln;

      write('   Entre Num. Socio : ');

      readln(nn);

      assign(fp,'prestamo.dat');

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

     if ioresult <> 0 then

     begin

        writeln('   Error De Archivo Pulse Una Tecla');

        readkey;

     end

   else

      begin

         ssi := false;

         for ds := 0 to filesize(fp) - 1 do

         begin

            seek(fp,ds);

            read(fp,pprestamo);

            if pprestamo.numero_socio = nn then

            begin

               pprestamo.devolucion := false;

               ssi := true;

               break;

            end;

         end;

         close(fp);

         if ssi = true then

         writeln('  Prestamo Anulado Pulse Una Tecla')

       else

         writeln('  El Num. Socio Entrado No Existe Pulse Una Tecla');

         readkey;

      end;

   end;

  procedure carga_a_puntero(cual : char);

  var

    gg : longint;

   begin

      if cual = 'L' then

      begin

          assign(fl,'estantes.dat');

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

     if ioresult <> 0 then

     begin

        writeln('   Error De Archivo Pulse Una Tecla');

        readkey;

     end

  else

     begin

        priml := nil;

        for gg := 0 to filesize(fl) - 1 do

        begin

           seek(fl,gg);

           read(fl,plibros);

           if plibros.estado <> false then

           entrada_puntero(cual);

        end;

     end;

   end;

       if cual = 'S' then

       begin

          assign(fs,'socios.dat');

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

     if ioresult <> 0 then

     begin

        writeln('   Error De Archivo Pulse Una Tecla');

        readkey;

     end

  else

     begin

        prims := nil;

        for gg := 0 to filesize(fs) - 1 do

        begin

           seek(fs,gg);

           read(fs,psocios);

           if psocios.estado <> false then

           entrada_puntero(cual);

        end;

     end;

   end;

      if cual = 'P' then

      begin

         assign(fp,'prestamo.dat');

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

     if ioresult <> 0 then

     begin

        writeln('   Error De Archivo Pulse Una Tecla');

        readkey;

     end

  else

     begin

        primp := nil;

        for gg := 0 to filesize(fp) - 1 do

        begin

           seek(fp,gg);

           read(fp,pprestamo);

           if pprestamo.devolucion <> false then

           entrada_puntero(cual);

        end;

     end;

   end;

 end;

 procedure menu;

 var

   rt, tre : char;

   salir : boolean;

 begin

    salir := false;

   repeat

       clrscr;

       writeln('***** Menu Jeneral *****');

       writeln;

       writeln('   1 = altas');

       writeln('   2 = baja');

       writeln('   3 = Modificacion');

       writeln('   4 = Consulta');

       writeln('   5 = Listados');

       writeln('   6 = Salir');

       writeln;

       writeln('   Elija Opcion ');

       repeat

           tre := readkey;

       until tre in['1','2','3','4','5','6'];

       clrscr;

   case tre of

 '1' : begin

         entrada_libros;

         entrada_puntero('L');

       end;

 '2' : begin

         writeln('1 = Baja Libro / 2 = Baja socio / 3 = Baja Prestamo / 0 = Nada');

         writeln;

         write('  Elija Opcion');

       repeat

           rt := readkey;

       until rt in['1','2','3','0'];

    case rt of

  '1' : anula_libro;

  '2' : anula_socio;

  '3' : anula_prestamo;

  '0' :;

    end;

  end;

 '3' :;

 '4' :;

 '5' :;

 '6' : salir := true;

   end;

   until salir = true;

 end;

  begin

     clrscr;

     priml := nil;

     prims := nil;

     primp := nil;

     menu;

  end.

{El resto}

procedure modificaciones;

 var

   res, mo, te : char;

   siest : boolean;

   tem, bus, nl : longint;

 begin

    clrscr;

    writeln('**** Modificaciones ****');

    writeln;

    writeln('Menu : 1=Libro  / 2=Socio  / 3=Prestamo  / 4=Nada');

    writeln('   Elija Opcion');

    writeln;

    repeat

        te := readkey;

    until te in['1','2','3','4'];

  case te of

 '1' : begin

         assign(fl,'estantes.dat');

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

     if ioresult <> 0 then

     begin

        writeln('   Error De Archivo Pulse Una Tecla');

        readkey;

     end

  else

     begin

       clrscr;

       write('  Entre Num. Libro : ');

       readln(nl);

       siest := false;

       for bus := 0 to filesize(fl) - 1 do

       begin

         seek(fl, bus);

         read(fl,plibros);

         if plibros.numero = nl then

         begin

            tem := bus;

            siest := true;

            break;

         end;

       end;

  if siest = true then

  begin

  repeat

      with plibros do

        begin

           writeln(' 1 = Titulo    : ',titulo);

           writeln(' 2 = Autor     : ',autor);

           writeln(' 3 = Editorial : ',editorial);

           writeln(' 4 = Edicion   : ',edicion);

           writeln(' 5 = Codigo    : ',codigo);

           writeln(' 6 = Estado    : ',estado);

           writeln(' 7 = Termina');

           writeln;

           writeln('  Elija Modificacion');

         repeat

             mo := readkey;

         until mo in['1','2','3','4','5','6','7'];

    case mo of

  '1' : begin

           write('  Entre Titulo : ');

           readln(plibros.titulo);

        end;

  '2' : begin

           write('  Entre Autor : ');

           readln(plibros.autor);

        end;

  '3' : begin

           write('  Entre Editorial : ');

           readln(plibros.editorial);

        end;

  '4' : begin

           write('  Entre Edicion : ');

           readln(plibros.Edicion);

        end;

  '5' : begin

           write('  Entre Codigo 1..8 : ');

           readln(plibros.codigo);

        end;

  '6' : begin

           write('  Entre Estado 1=si / 2=no : ');

           readln(res);

           if res = '1' then

           plibros.estado := true;

           if res = '2' then

           plibros.estado := false;

        end;

      end;

    end;

     until mo = '7';

   end

 else

    begin

       writeln('  Num. Libro No Encontrado Pulse Una Tecla');

       readkey;

    end;

   end;

       if siest = true then

       begin

       seek(fl,tem);

       write(fl,plibros);

       end;

       close(fl);

     end;

 '2' : begin

         assign(fs,'socios.dat');

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

      if ioresult <> 0 then

      begin

        writeln('   Error De Archivo Pulse Una Tecla');

        readkey;

     end

  else

     begin

        clrscr;

        write('  Entre Num. Socio : ');

        readln(nl);

        siest := false;

       for bus := 0 to filesize(fs) - 1 do

       begin

         seek(fs, bus);

         read(fs,psocios);

         if psocios.numero = nl then

         begin

            tem := bus;

            siest := true;

            break;

         end;

       end;

   if siest = true then

   begin

  repeat

      with psocios do

        begin

           writeln(' 1 = Numero             : ',numero);

           writeln(' 2 = Apellido           : ',apellido);

           writeln(' 3 = Nombre             : ',nombres);

           writeln(' 4 = Domicilio          : ',domicilio);

           writeln(' 5 = Localidad          : ',localidad );

           writeln(' 6 = Codigo Postal      : ',codigo_postal);

           writeln(' 7 = Telefono           : ',telefono);

           writeln(' 8 = Correo Electronico : ',correo_electronico);

           writeln(' 9 = Estado 1=si / 2=no : ',estado);

           writeln(' 0 = Termina');

           writeln;

           writeln('  Elija Modificacion');

         repeat

             mo := readkey;

         until mo in['1','2','3','4','5','6','7','8','9','0'];

    case mo of

  '1' : begin

           write('  Entre Numero : ');

           readln(psocios.numero);

        end;

  '2' : begin

           write('  Entre Apellido : ');

           readln(psocios.apellido);

        end;

  '3' : begin

           write('  Entre Nombre : ');

           readln(psocios.nombres);

        end;

  '4' : begin

           write('  Entre Domicilio : ');

           readln(psocios.domicilio);

        end;

  '5' : begin

           write('  Entre Localidad : ');

           readln(psocios.localidad);

        end;

  '6' : begin

           write('  Entre Codigo Postal : ');

           readln(psocios.codigo_postal);

        end;

  '7' : begin

           write('  Entre Telefono  : ');

           readln(psocios.telefono);

        end;

  '8' : begin

           write('  Entre Correo Electronico : ');

           readln(psocios.correo_electronico);

        end;

  '9' : begin

           write('  Entre Estado 1=si / 2=no : ');

           readln(res);

           if res = '1' then

           psocios.estado := true;

           if res = '2' then

           psocios.estado := false;

        end;

       end;

      end;

     until mo = '0';

   end

 else

    begin

       writeln('  Num. Libro No Encontrado Pulse Una Tecla');

       readkey;

    end;

   end;

       if siest = true then

       begin

     end;

       seek(fs,tem);

       write(fs,psocios);

       close(fs);

       end;

 '3' : begin

       assign(fp,'prestamo.dat');

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

     if ioresult <> 0 then

     begin

        writeln('   Error De Archivo Pulse Una Tecla');

        readkey;

     end

  else

     begin

        clrscr;

        write('  Entre Num. Socio : ');

        readln(nl);

        siest := false;

       for bus := 0 to filesize(fp) - 1 do

       begin

         seek(fp, bus);

         read(fp,pprestamo);

         if pprestamo.numero_socio = nl then

         begin

            tem := bus;

            siest := true;

            break;

         end;

       end;

   if siest = true then

   begin

  repeat

      with pprestamo do

        begin

           writeln(' 1 = Numero Socio       : ',numero_socio);

           writeln(' 2 = Numero Libro       : ',numero_libro);

           writeln(' 3 = Fecha Prestamo     : ',fecha_prestamo);

           writeln(' 4 = Debolucion         : ',devolucion);

           writeln(' 5 = Termina');

           writeln;

           writeln('  Elija Modificacion');

         repeat

             mo := readkey;

         until mo in['1','2','3','4','5'];

    case mo of

  '1' : begin

           write('  Entre Numero Socio : ');

           readln(pprestamo.numero_socio);

        end;

  '2' : begin

           write('  Entre Numero Libro : ');

           readln(pprestamo.numero_libro);

        end;

  '3' : begin

           write('  Entre Fecha Prestamo : ');

           readln(pprestamo.fecha_prestamo);

        end;

  '4' : begin

           write('  Entre Debolucion 1=Si / 2=No : ');

           readln(res);

           if res = '1' then

           pprestamo.devolucion := true;

           if res = '2' then

           pprestamo.devolucion := false;

       end;

     end;

    end;

     until mo = '5';

   end

 else

    begin

       writeln('  Num. Socio No Encontrado Pulse Una Tecla');

       readkey;

    end;

   end;

       if siest = true then

       begin

       seek(fp,tem);

       write(fp,pprestamo);

       end;

       close(fp);

       end;

 '4' :;

    end;

 end;

 procedure busqueda_libro;

 var

   nt, bu : longint;

   si : boolean;

    tempo : ptlibro;

  begin

     clrscr;

     si := false;

     writeln('***** Busqueda De Un Libro *****');

     writeln;

     write('  Entre Num. : ');

     readln(nt);

     carga_a_puntero('L',false);

     tempo := priml;

     while (tempo <> nil) and (si <> true) do

     begin

        if tempo^.numero = nt then

        begin

           si := true;

        end

      else

         tempo := tempo^.sig;

     end;

             clrscr;

             writeln('*** Los Datos Del Libro Son ***');

             writeln;

             with tempo^ do

             begin

                writeln('  Numero               : ',numero);

                writeln('  Titulo               : ',titulo);

                writeln('  Autor                : ',autor);

                writeln('  Editorial            : ',editorial);

                writeln('  Ediccion             : ',edicion);

                writeln('  Serie                : ',codigo);

                writeln('  Estado               : ',estado);

             end;

             writeln;

             writeln('<<<< Pulse Una Tecla >>>>');

             readkey;

            dispose(actul);

     end;

 procedure listado_libros;

 var

   ter : char;

   libr : libro;

   pp, cont : longint;

  begin

      assign(fl,'estantes.dat');

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

     if ioresult <> 0 then

     begin

        writeln('   Error De Archivo Pulse Una Tecla');

        readkey;

     end

  else

    begin

       cont := filesize(fl) - 1;

       pp := 0;

    repeat

        fillchar(libr,sizeof(libro),' ');

        seek(fl, pp);

        read(fl, libr);

        clrscr;

        writeln('***  El Libro ***');

        writeln;

        with libr do

        begin

           writeln('  Numero               : ',numero);

           writeln('  Titulo               : ',titulo);

           writeln('  Autor                : ',autor);

           writeln('  Editorial            : ',editorial);

           writeln('  Ediccion             : ',edicion);

           writeln('  Serie                : ',codigo);

           writeln('  Estado               : ',estado);

        end;

        writeln;

        writeln('   Para Lante [',chr(25),']  Para Tras [',chr(24),

                                                      ']  Salir [ESC]');

        repeat

        ter := readkey;

        until ter in[#72,#80,#27];

        if ter = #72 then

        begin

        pp := pp - 1;

        if pp < 0 then

        pp := 0;

        end;

        if ter = #80 then

        begin

        pp := pp + 1;

        if pp > cont then

        pp := cont;

        end;

    until ter = #27;

    close(fl);

  end;

 end;

 procedure menu;

 var

   rt, tre : char;

   salir : boolean;

 begin

    salir := false;

   repeat

       clrscr;

       writeln('***** Menu Jeneral *****');

       writeln;

       writeln('   1 = altas');

       writeln('   2 = baja');

       writeln('   3 = Modificacion');

       writeln('   4 = Consulta');

       writeln('   5 = Listados');

       writeln('   6 = Salir');

       writeln;

       writeln('   Elija Opcion ');

       repeat

           tre := readkey;

       until tre in['1','2','3','4','5','6'];

       clrscr;

   case tre of

 '1' : begin

         entrada_libros;

         entrada_puntero('L',true);

       end;

 '2' : begin

         writeln('1 = Baja Libro / 2 = Baja socio / 3 = Baja Prestamo / 0 = Nada');

         writeln;

         write('  Elija Opcion');

       repeat

           rt := readkey;

       until rt in['1','2','3','0'];

    case rt of

  '1' : anula_libro;

  '2' : anula_socio;

  '3' : anula_prestamo;

  '0' :;

    end;

  end;

 '3' : modificaciones;

 '4' : busqueda_libro;

 '5' : listado_libros;

 '6' : salir := true;

   end;

   until salir = true;

 end;

  begin

     clrscr;

     priml := nil;

     prims := nil;

     primp := nil;

     menu;

  end.

program biblioteca;

uses crt,dos;

type

    regdatos=record

                   n_libro:longint;

                   titulo:string[50];

                   autor:string[20];

                   editorial:string[15];

                   anioedicion:word;

                   area:word;

                   estado:byte;

                   end;

    archlibros=file of regdatos;

var

   car:char;

   vararchi:archlibros;

   varreg, varregarch:regdatos;

   s:byte;

   opcion:byte;

(*Este Procedure no entra en las Opciones del Programa*)

(*Es Para Asignarles un Valor a las Variables*)

procedure leer_datos(var varreg:regdatos);

begin

     with varreg do

     begin

          gotoxy(5,6);write('Nœmero de Libro: ');readln(n_libro);

          gotoxy(5,8);write('T­tulo: ');readln(titulo);

          gotoxy(5,10);write('Autor: ');readln(autor);

          gotoxy(5,12);write('Editorial: ');readln(editorial);

          gotoxy(5,14);write('AÏo de Edici½n: ');readln(anioedicion);

          textcolor(12);gotoxy(40,16);write('1_ LENGUA Y LITERATURA');

          gotoxy(40,17);write('2_ MATEMATICAS');

          gotoxy(40,18);write('3_ CIENCIAS SOCIALES');

          gotoxy(40,19);write('4_ CIENCIAS NATURALES');

          gotoxy(40,20);write('5_ INFORMATICA');

          gotoxy(40,21);write('6_ LENGUA EXTRANJERA');textcolor(white);

          gotoxy(5,16);write('ærea a la que Pertenece: ');

          repeat

                gotoxy(29,16);readln(area);

                if (area=0)or(area>6)then

                   begin

                   gotoxy(5,18);textcolor(27);write('Error en el ingreso!');

                   delay(3000);

                   gotoxy(5,18);write('                     ');

                   textcolor(white);

                   end;

          until area in[1..6];

          estado:=1;

     end;

end;

(*Este procedure es de el listado general*)

procedure listgral(var vararchi: archlibros);

begin

     clrscr;

     gotoxy(25,1);writeln('Listado de Libros:');

     repeat

           reset(vararchi);

           gotoxy(2,3);

           textcolor(6) ; writeln('Numero            Titulo             Autor   Editorial     Edicion    area');

           textcolor(15);

           s:=0;

           while not eof (vararchi) do

                     begin

                     read(vararchi, varreg);

                     with (varreg) do

                     begin

                            if estado=1 then

                            begin

                            writeln(n_libro:7, titulo:18, autor:18, editorial:12, anioedicion:12, area:8);

                            s:=1;

                            end;

                     end;

                     end;

           if s=0 then

           begin

           gotoxy(13,10); textcolor(30); writeln('El Archivo No Posee Datos!');

           textcolor(white);

           end;

gotoxy(20,24);writeln('Pulse Intro Para Continuar o Cualquier Otra Tecla Para Salir!'); car:=readkey;

until car<>#3;

close(vararchi);

end;

(*Este Procedure es el que da el Alta a los Datos*)

procedure alta(var vararchi:archlibros);

begin

     clrscr;

     repeat

           reset(vararchi);

           clrscr;

           gotoxy(14,2);writeln('Opci½n Agregar Libros');

           gotoxy(5,4);write('Ingrese los Datos del Libro a Continuacion:');

           leer_datos(varreg);

           s:=0;

           while not eof(vararchi)and(s=0)do

                 begin

                 read(vararchi,varregarch);

                 if varreg.n_libro=varregarch.n_libro then

                    begin

                         textcolor(30);

                         gotoxy(20,22);

                         writeln('El Nœmero de Libro Ya Existe!');

                         delay(2000);

                         textcolor(white);

                         s:=1;

                    end;

                 end;

                 if s=0 then

                    begin

                         write(vararchi,varreg);

                         textcolor(yellow);

                         gotoxy(20,22);writeln('Los Datos Se Han Grabado!');

                         textcolor(white);

                         end;

           gotoxy(2,23);writeln('Pulse INTRO Para Continuar o Cualquier Otra Tecla Para Salir!');

           car:=readkey;

     until car<>#13;

     close(vararchi);

end;

(*Este Procedure Crea el Archivo en el Disco 'C'*)

procedure generar(var vararchi:archlibros);

begin

     clrscr;

     gotoxy(20,2);writeln('Programa Para Crear Archivos');

     rewrite(vararchi);

     gotoxy(23,10);writeln('Archivo Creado');

     delay(3000);

end;

(*procedure para mostrar datos*)

procedure mostrardatos(var varreg:regdatos);

begin

     with varreg do

     begin

     gotoxy(4,6);write('titulo: ',titulo);

     gotoxy(4,8);write('autor: ',autor);

     gotoxy(4,10);write('editorial: ',editorial);

     gotoxy(4,12);write('anio de edicion: ',anioedicion);

     gotoxy(4,14);write('area: ');

                               case area of

                                    1:write('lengua y literatura');

                                    2:write('matematicas');

                                    3:write('ciencias sociales');

                                    4:write('ciencias naturales');

                                    5:write('informatica');

                                    6:write('lengua extranjera');

                               else

                                   write('otro');

                               end;

     end;

end;

(*procedure para consultar datos*)

procedure consultar(var vararchi:archlibros);

var

   nu_libro:longint;

begin

     repeat

           CLRSCR;

           reset (vararchi);

           gotoxy (20,2);writeln('opcion consultar datos');

           gotoxy(20,4);writeln('Introdusca el numero de libro:');

           readln(nu_libro);

           s:=0;

           while not eof (vararchi) and (s=0) do

           begin

           read (vararchi,varreg);

           if varreg.n_libro=nu_libro then

              begin

                   s:=1;

                   if varreg.estado=0 then

                      begin

                           textcolor(30); writeln;

                           writeln('los datos han sido dados de baja');

                           textcolor(white);

                      end

                   else

                        mostrardatos(varreg);

              end;

           end;

if s=0 then

begin

     gotoxy(20,12);textcolor(30);

     write('los datos no exiten');textcolor(white);

end;

gotoxy(2,23);writeln('pulse INTRO para continuar o cualquier otra tecla para salir');

car:=readkey;

until car<>#13;

close(vararchi);

end;

(*programa principal*)

begin

     clrscr;

     assign(vararchi,'c:datlibro.dat');

     repeat

           clrscr;

           gotoxy(26,2);writeln('Datos Libros de Biblioteca');

           gotoxy(20,4);writeln('0_ Salir del Programa');

           gotoxy(20,5);writeln('1_ Agregar Libros');

           gotoxy(20,6);writeln('2_ Borrar Datos de Libros');

           gotoxy(20,7);writeln('3_ Modificar Datos del Libro');

           gotoxy(20,8);writeln('4_ Consultar Datos de un Libro');

           gotoxy(20,9);writeln('5_ Listado General de Libros');

           gotoxy(20,10);writeln('6_ Listado por ærea');

           gotoxy(20,11);writeln('7_ Listado de Libros Dados de Baja');

           gotoxy(20,12);writeln('8_ Generar Archivo');

           gotoxy(20,13);writeln('9_ Actualizar Archivo');

           gotoxy(20,23);write('Elija una Opci½n: ');

           repeat

                 gotoxy(38,23);write('      ');gotoxy(38,wherey);

                 readln(opcion);

           until opcion in [0..9];

           clrscr;

           case opcion of

                1:alta(vararchi);

             (* 2:borrar(vararchi);

                3:modificar(vararchi);*)

                4:consultar(vararchi);

                5:listgral(vararchi);

             (* 6:listarea(vararchi);

                7:listbaja(vararchi);*)

                8:generar(vararchi);

             (* 9:actualizar(vararchi);*)

           end;

     until opcion =0;

     gotoxy(12,10);textcolor(20);

     writeln('F I N   D E L   P R O G A M A');

     delay(3000);

end. (*fin del programa principal*)