[Martin2]

Unit2 se llama cliente

Código Delphi [-]

Unit cliente;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm2 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Edit7: TEdit;
    Label9: TLabel;
    Edit8: TEdit;
    Label10: TLabel;
    Edit9: TEdit;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    end;


    //declaracion de la estructura tipo record Socio
    Type
    Socio= Record
    Apellido, nombres: string[20];
    DNI, dn, mn, an : Real;
    end;

    //declaracion de la estructura tipo record SocioPro
    Type
      SocioPro= Record
      Apellido, nombres: string[20];
      edad : Real;
    end;

  //declaracion de la clase TManejoSocios
  TManejoSocios = class


  private
  
    { Declaracion parte privada }
     Archi:File of Socio;

  public
    { Public declarations }

    Lista: array of SocioPro;



    procedure AbrirArchivo(ArchiFisico:string);
    procedure ArchivoNuevo(ArchiFisico:string);
    procedure GrabarSocio(c:Socio ;var cod:byte);
    procedure BuscarSocio(var i:integer; var c:Socio ; var m:string; numDoc:longint);
    procedure EliminarSocio(c:Socio; i:integer; var mensaje : string);
    procedure CerrarArchivo;
    procedure GuardarComo(viejo, nuevo : string);





  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

//---------------------------------------------
procedure TManejoSocios.AbrirArchivo(ArchiFisico:string);
begin
  AssignFile(Archi,ArchiFisico);
  Reset(Archi);
end;

//---------------------------------------------
procedure TManejoSocios.ArchivoNuevo(ArchiFisico:string);
begin
AssignFile(Archi,ArchiFisico);
Rewrite(Archi);
end;

//---------------------------------------------
procedure TManejoSocios.GrabarSocio(c:Socio; var
cod:byte);
begin
{$I-}
Seek(Archi, FileSize(archi));
{$I+};
cod:=IOResult;
If cod=0 then
Write(Archi,c);
end;

//---------------------------------------------
procedure TManejoSocios.BuscarSocio(var i:integer; var c:Socio; var m:string; numDoc:longint);

    var
       Largo:word;
       ii:integer;




    begin
{$I-}
 Largo:=FileSize(archi);
{$I+};

  If (IOResult<>0)
  then
    begin
      m:='Problemas con el archivo. Está creado o abierto ?';
      exit // sale del procedure
    end;

    //con un FOR, vamos a recorrer del primer al ultimo registro
    //y vemos con un IF si el string que mandamos a buscar coincide con
    //el que esta almacenado en el campo.
    for ii:= 0 to Largo - 1 do
    begin
       seek(Archi, ii);

        Read(archi,c);

        if c.DNI = numDoc then
            begin
              i:=ii;
              m:='Ok';
              exit;

            end
        else

    end;

   ShowMessage('No hay coincidencias');

  end;


//----------------------------------------------
procedure TManejoSocios.CerrarArchivo;
begin
CloseFile(Archi)
end;

//----------------------------------------------
procedure TManejoSocios.GuardarComo(viejo, nuevo: string);
var
arch_entrada, arch_salida: file;
buffer: array[1..2048] of char;
numleido, numescrito: longint;
begin
// open files - no error checking you should add that
assign(arch_entrada, viejo);
reset(arch_entrada, 1);
assign(arch_salida, nuevo);
rewrite(arch_salida, 1);

// copy file
repeat
blockread(arch_entrada, buffer, sizeof(buffer), numleido);
blockwrite(arch_salida, buffer, numleido, numescrito);
until (numleido = 0) or (numescrito <> numleido);
close(arch_entrada);
close(arch_salida);
ShowMessage('El archivo fue guardado como: ' + nuevo);
end;



//---------------------------------------------
procedure TManejoSocios.EliminarSocio (c:Socio; i:integer; var mensaje : string);

var cod:byte;

begin
{$I-}
Seek(Archi, i);
{$I+};
cod:=IOResult;

c.Apellido :='';
c.nombres :='';
c.DNI :=0;
c.dn := 0;
c.mn := 0;
c.an := 0;


If cod=0 then

  begin
    Write(Archi,c);
  end

else

  begin
   mensaje := 'Ha ocurrido un error y no pudo realizarce la operacion';
  end



end;


procedure TForm2.Button1Click(Sender: TObject);
begin
Close;
end;

end.