RESPUESTA A LA PREGUNTA 2572 DE PASCAL/TURBO PASCAL


Os envio un codigo que elimina en Forma Logica registro en PASCAL
Program Luis;
  Uses
    crt;
  Type
    RegEmple = Record
                 Cedula:Longint;
                 Apellidos:String[25];
                 Nombres:String[25];
                 Direccion:String[30];
                 Sueldo:Real;
                 Borrado:Boolean;
               End;
     ArchEmple = File of RegEmple;

     Var
      Existe:Boolean;
      NumRec:Longint;
      Registro:RegEmple;
      Archivo:ArchEmple;
      Regtemp:RegEmple;
      Temp:Longint;
      Op,Resp:Char;
      Archivo2:ArchEmple;

     Procedure Buscar(CedEmple:Longint);
       Begin
         (*Este Procedure Cambia La Variable Existe a FALSE y *)
         (*Solo la hace CIERTA si El registro Esta Presente *)
         (y No Esta    Boorado *)
         Existe:=False;
         Assign(Archivo,'Empleado.dat');
         {$i-}
           Reset(Archivo);
         {$i+}
         If IOResult <> 0 then
           Begin
             Rewrite(Archivo);
             Close(Archivo);
             Reset(Archivo);
           End;
           While Not(Eof(Archivo)) Do
             Begin
                READ(Archivo,Registro);
                (*Aqui se Verifica Que No es Un Registro Eliminado*)
                If NOT(Registro.Borrado) And
                   (CedEmple = Registro.Cedula) Then
                   Begin
                       Existe:=True;
                       NumREc:=Filepos(Archivo)-1;
                   End;
             End;
             Close(Archivo);
       End;

    Procedure Escribir;
       Begin
         Assign(Archivo,'Empleado.dat');
         Reset(Archivo);
         if  NumRec = -1 then
            SEEK(Archivo,FILESIZE(Archivo))
         else
            SEEK(Archivo,NumRec);
          Write(Archivo,Registro);
         Close(Archivo);
       End;

    Procedure Leer;
       Begin
         Assign(Archivo,'Empleado.dat');
         Reset(Archivo);
         SEEK(Archivo,NumRec);
         Read(Archivo,Registro);
         Close(Archivo);
       End;

     Procedure Ver_Titulos;
       Begin
        Gotoxy(15,2);
        Writeln('Datos De Los Empleados');
        Gotoxy(15,7);
        Writeln('Cedula   : ');
        Gotoxy(15,9);
        Writeln('Apellidos: ');
        Gotoxy(15,11);
        Writeln('Nombres  : ');
        Gotoxy(15,13);
        Writeln('Direccion: ');
        Gotoxy(15,15);
        Writeln('Sueldo   : ');
       End;

     Procedure Ver_Campos;
       Begin
        Gotoxy(26,7);
        Writeln(Registro.Cedula);
        Gotoxy(26,9);
        Writeln(Registro.Apellidos);
        Gotoxy(26,11);
        Writeln(Registro.Nombres);
        Gotoxy(26,13);
        Writeln(Registro.Direccion);
        Gotoxy(26,15);
        Writeln(Registro.Sueldo:10:2);
       End;
     Procedure Tomar_Campos;
       Begin
        Registro.Cedula:=Temp;
        Gotoxy(26,7);
        Writeln(Registro.Cedula);
        Gotoxy(26,9);
        Readln(Registro.Apellidos);
        Gotoxy(26,11);
        Readln(Registro.Nombres);
        Gotoxy(26,13);
        Readln(Registro.Direccion);
        Gotoxy(26,15);
        Readln(Registro.Sueldo);
        Registro.Borrado:=False;
       End;


     Procedure Eliminar;
       Begin
          clrscr;
          Gotoxy(20,21);
          Write('Cedula Que Desea Eliminar: ');
          Readln(Temp);
          Buscar(Temp);
          If Not Existe then
            Begin
               Gotoxy(60,21);
               Write('No Esta Agregada ');
            End
          Else
            Begin
               Leer;
               Ver_Titulos;
               Ver_Campos;
               Gotoxy(23,22);
               Writeln('Seguro de Elimiarlo S/N: ');
               Gotoxy(40,22);
               Readln(Resp);
               If Upcase(Resp) = 'S' Then
                  Begin
                    (*Aqui Se Cambia el Campo Borrado a  Cierto*)
                    Registro.Borrado:=True;
                    Escribir;
                  End;
            End;
        End;
  Begin
   TextColor(15);
   TextBackground(9);
   Op:='1';
   While OP <> '5' Do
   Begin
      Clrscr;
      Gotoxy(15,2);
      Writeln('MENU PRINCIPAL');
      Gotoxy(15,9);
      Writeln('3. Eliminar Registros');
      Gotoxy(15,13);
      Writeln('5. Fin Del Programa');
      Gotoxy(35,17);
      Op:=Readkey;
      Case Op OF
         '3': Begin
                 Repeat
                    eliminar;
                    Gotoxy(24,23);
                    Write('Eliminar Otro S/N: ');
                    Gotoxy(44,23);
                    Resp:=Readkey;
                 Until Upcase(Resp) = 'N';
              End;
         '5': Begin
                  Clrscr;
                   Write('End...');
                   Readln;
              End;
      End;
   End;
End.


LUIS CASTRO
cfugiluis@hotmail.com