Programación General > Pascal

 elminacion de registros en archivo

(1/1)

twipsy:
tengo un problema con un programa que tengo que hacer. el programa trata sobre una agenda de amigos en el que los datos se guardan en un archivo y la parte que me da problemas consiste en lo siguiente

-compactar los datos de forma que eliminemos los marcados como borrados (o sea, que si teníamos 23 ocupados y 5 estaban marcados como borrados, al final he de tener 18 ocupados, 0 marcados como borrados y han de ocupar las 18 primeras posiciones en el vector).

como podreis observar en el codigo, todo el programa esta bien excepto el procedure en el que se eliminan esos datos borrados

--- Código: Pascal ---program registres; uses crt;{type vector = array [1..100] of integer;type matriz = array [1..10,1..5] of integer;type mezcla = array [1..10] of matriz;} type persona = record                 nombre    : string[15];                 ap1,ap2   : string[12];                 varon     : boolean;                 direccion : string[30];                 any_nac   : integer;                 mes_nac   : byte;                 dia_nac   : byte;                 borrado   : boolean;               end;type vecpersonas = array [1..100] of persona;              type agenda = record                num_ocupados : byte;                num_borrados : byte;                personas     : vecpersonas;              end;Type fichero = file of agenda;              procedure pulsa_tecla;  begin    gotoxy(1,24); write('Pulsa una tecla para continuar...');    readkey;    clrscr;    end;    procedure presenta;  begin    clrscr;    gotoxy(5,10);    write('Programa de mantenimiento de una agenda');    gotoxy(5,11);    write('=======================================');    pulsa_tecla;  end;   procedure ficha;  begin    clrscr;    gotoxy(10,5);  write('Persona num :');    gotoxy(10,7);  write('Nombre      :');    gotoxy(10,8);  write('Apellido 1  :');    gotoxy(10,9);  write('Apellido 2  :');    gotoxy(10,10); write('Varón (s/n)?:');    gotoxy(10,11); write('Dia nacim.  :');    gotoxy(10,12); write('Mes nacim.  :');    gotoxy(10,13); write('Any nacim.  :');  end;  procedure muestra(i:byte; p:persona);  begin    ficha;    gotoxy(24,5);  write(i);    gotoxy(24,7);  write(p.nombre);    gotoxy(24,8);  write(p.Ap1);    gotoxy(24,9);  write(p.Ap2);    gotoxy(24,10); if p.varon then write('Sí') else write('No');    gotoxy(24,11); write(p.dia_nac);    gotoxy(24,12); write(p.mes_nac);    gotoxy(24,13); write(p.any_nac);    pulsa_tecla;  end;    procedure lee(i:byte; var p:persona);var op : char;  begin    ficha;    gotoxy(24,5);  write(i);    gotoxy(24,7);  readln(p.nombre);    gotoxy(24,8);  readln(p.Ap1);    gotoxy(24,9);  readln(p.Ap2);    gotoxy(24,10); repeat op := readkey until op in ['s','S','n','N'];         write(op);        if op in ['s','S'] then p.varon := true                           else p.varon := false;    gotoxy(24,11); readln(p.dia_nac);    gotoxy(24,12); readln(p.mes_nac);    gotoxy(24,13); readln(p.any_nac);    p.borrado := false;    pulsa_tecla;  end;   procedure nuevo(var a:agenda); var p : persona;  begin    inc(a.num_ocupados);    lee(a.num_ocupados,p);    a.personas[a.num_ocupados] := p;  end; procedure modifica(var a:agenda);var num : byte;    p   : persona;  begin    clrscr;    gotoxy(10,5); write('Dime el número de persona que quieres modificar: ');     readln(num);     lee(num,p);    a.personas[num] := p;  end; procedure lista(var a:agenda);var i : byte;  begin    clrscr;    if (a.num_ocupados - a.num_borrados) = 0        then begin              gotoxy(10,5); write('La agenda está vacía');               end       else for i := 1 to a.num_ocupados do                            if not (a.personas[i].borrado)                                  then muestra(i,a.personas[i]);    pulsa_tecla;                   end; procedure borra(var a:agenda);var num : byte;  begin    clrscr;    gotoxy(10,5); write('Dime el número de persona que quieres borrar: ');     readln(num);     a.personas[num].borrado := true;    inc(a.num_borrados);  end;  procedure recupera(var a:agenda);var num : byte;  begin    clrscr;    gotoxy(10,5); write('Dime el número de registro que quieres recuperar: ');     readln(num);     a.personas[num].borrado := false;    dec(a.num_borrados);  end;  procedure elimina(var a:agenda); {este es la parte que no me funciona} var num: byte; var i: byte;  begin  for num:= 1 to a.num_ocupados do    begin        if not a.personas[num].borrado then            begin                inc (i);                    a.personas[i] := a.personas[num];            end;    end; a.num_ocupados := num;a.num_borrados := 0;  end; procedure menu(var a:agenda);var op : char;  begin    repeat      clrscr;      gotoxy(10,5);  write('M E N U');      gotoxy(10,6);  write('=======');      gotoxy(10,8);  write('1 - Nuev@ amig@');      gotoxy(10,9);  write('2 - Modifica amig@');      gotoxy(10,10); write('3 - Lista amig@s');      gotoxy(10,11); write('4 - Elimina amig@s');      gotoxy(10,12); write('5 - Recupera amig@s');      gotoxy(10,13); write('6 - Compacta amig@s');      gotoxy(10,14); write('7 - Salir del programa');      gotoxy(10,17); write('Pulsa el número de tu elección: ');      repeat op := readkey until op IN ['1'..'7'];      case op of        '1' : nuevo(a);        '2' : modifica(a);        '3' : lista(a);        '4' : borra(a);        '5' : recupera(a);        '6' : elimina(a);      end;          until op = '7';    end;   procedure lee_del_fichero(var f:fichero; var a:agenda);  begin    assign(f,'agenda.dat');    {$I-} reset(f); {$I+}    if IOresult > 0 then begin                           a.num_ocupados := 0;                           a.num_borrados := 0;                                             end                    else read(f,a);     end;        procedure guarda_al_fichero(var f:fichero; a:agenda);  begin    rewrite(f);    write(f,a);    close(f);  end;        var a:agenda;       f:fichero;begin  presenta;  lee_del_fichero(f,a);  menu(a);  guarda_al_fichero(f,a);end.             como puedo solucionarlo?
gracias y disculpen las molestias, pero empiezo a creer que soy un negado en la programacion

epayan:
aqui un code con los que requieres de archivos y registros y su tratamiento: alta, modificaciones, bajas fisicas, consultas y listados.


--- Código: Pascal ---  program ejemplo_archivos;uses crt,dos,sysutils;{en este ejemplo se refleja  el uso de registros con archivoshaciendo el uso de insercion, modificacion , y borrado fisico de losregistros} 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.   

Navegación

[0] Índice de Mensajes