Ver Mensaje Individual
  #12  
Antiguo 08-04-2015
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Reputación: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
Jere_84,

Cita:
Empezado por Jere_84
...Necesito hacer un ABM simple de Codigo, Nombre, Domicilio y Localidad de una persona trabajando con ficheros archivos.txt...

Código Delphi [-]
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    edtCodigo: TEdit;
    edtNombre: TEdit;
    edtDomicilio: TEdit;
    edtLocalidad: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button8: TButton;
    ListBox1: TListBox;
    Label5: TLabel;
    Button7: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TData = record
     Codigo : Array[0..9] of Char;
     Nombre : Array[0..29] of Char;
     Domicilio : Array[0..29] of Char;
     Localidad : Array[0..29] of Char;
     CRLF : Array[0..1] of Char;
  end;

var
  Form1: TForm1;
  F : TFileStream;
  RegData : TData;
  FileName : String = 'FileData.txt';
  PosReg : Integer;
  FoundReg : Boolean;

implementation

{$R *.dfm}

// Inicializa App
procedure TForm1.FormCreate(Sender: TObject);
begin
   edtCodigo.MaxLength := 10;
   edtNombre.MaxLength := 30;
   edtDomicilio.MaxLength := 30;
   edtLocalidad.MaxLength := 30;
end;

// Adiciona un Registro
procedure TForm1.Button1Click(Sender: TObject);
begin

   if FileExists(FileName) then
   begin
      F := TFileStream.Create(FileName, fmOpenWrite, fmShareExclusive);
      F.Position := F.Size;
   end
   else
      F := TFileStream.Create(FileName, fmCreate, fmShareExclusive);

   StrPCopy(RegData.Codigo,Format('%-10s',[edtCodigo.Text]));
   StrPCopy(RegData.Nombre,Format('%-30s',[edtNombre.Text]));
   StrPCopy(RegData.Domicilio,Format('%-30s',[edtDomicilio.Text]));
   StrPCopy(RegData.Localidad,Format('%-30s',[edtLocalidad.Text]));
   RegData.CRLF := #13#10;

   F.Write(RegData, SizeOf(RegData));

   F.Free;

end;

// Consulta un Registro
procedure TForm1.Button2Click(Sender: TObject);
var
   Codigo : String;

begin

   if FileExists(FileName) then
   begin

      Codigo := InputBox('Código a Consultar', 'Código', '1');

      F := TFileStream.Create(FileName, fmOpenRead, fmShareDenyNone);

      FoundReg := False;

      while F.Position < F.Size do
      begin
         F.Read(RegData, SizeOf(RegData));
         if Trim(RegData.Codigo) = Trim(Codigo) then
         begin
            edtCodigo.Text := Trim(RegData.Codigo);
            edtNombre.Text := Trim(RegData.Nombre);
            edtDomicilio.Text := Trim(RegData.Domicilio);
            edtLocalidad.Text := Trim(RegData.Localidad);
            PosReg := F.Position - SizeOf(RegData);
            FoundReg := True;
            Break;
         end;
      end;

      if not FoundReg then
         MessageDlg('No Existe el Registro Solicitado',mtInformation,[mbOk],0);

      F.Free;

   end
   else
      MessageDlg('El Archivo de Datos No Existe',mtInformation,[mbOk],0);

end;

// Actualiza un Registro
procedure TForm1.Button3Click(Sender: TObject);
begin

   if FileExists(FileName) then
   begin

      if not FoundReg then
      begin
         MessageDlg('No Se ha Buscado Ningún Registro para Actualizar',mtInformation,[mbOk],0);
         Exit;
      end;

      F := TFileStream.Create(FileName, fmOpenWrite, fmShareExclusive);
      F.Seek(PosReg, soFromBeginning);

      StrPCopy(RegData.Codigo,Format('%-10s',[edtCodigo.Text]));
      StrPCopy(RegData.Nombre,Format('%-30s',[edtNombre.Text]));
      StrPCopy(RegData.Domicilio,Format('%-30s',[edtDomicilio.Text]));
      StrPCopy(RegData.Localidad,Format('%-30s',[edtLocalidad.Text]));
      RegData.CRLF := #13#10;

      F.Write(RegData, SizeOf(RegData));

      F.Free;

      MessageDlg('Registro Actualizado',mtInformation,[mbOk],0);

   end
   else
      MessageDlg('El Archivo de Datos No Existe',mtInformation,[mbOk],0);

   FoundReg := False;

end;

// Elimina un Registro
procedure TForm1.Button4Click(Sender: TObject);
begin

   if FileExists(FileName) then
   begin

      if not FoundReg then
      begin
         MessageDlg('No Se ha Buscado Ningún Registro para Eliminar',mtInformation,[mbOk],0);
         Exit;
      end;

      F := TFileStream.Create(FileName, fmOpenWrite, fmShareExclusive);
      F.Seek(PosReg, soFromBeginning);

      StrPCopy(RegData.Codigo,Format('%-10s',[EmptyStr]));
      StrPCopy(RegData.Nombre,Format('%-30s',[EmptyStr]));
      StrPCopy(RegData.Domicilio,Format('%-30s',[EmptyStr]));
      StrPCopy(RegData.Localidad,Format('%-30s',[EmptyStr]));
      RegData.CRLF := #13#10;

      F.Write(RegData, SizeOf(RegData));

      F.Free;

      MessageDlg('Registro Eliminado',mtInformation,[mbOk],0);

   end
   else
      MessageDlg('El Archivo de Datos No Existe',mtInformation,[mbOk],0);

   FoundReg := False;

end;

// Consulta Global de Registros
procedure TForm1.Button5Click(Sender: TObject);
begin

   if FileExists(FileName) then
   begin

      ListBox1.Clear;

      F := TFileStream.Create(FileName, fmOpenRead, fmShareDenyNone);

      while F.Position < F.Size do
      begin
         F.Read(RegData, SizeOf(RegData));
         if Trim(RegData.Codigo) <> EmptyStr then
         begin
            ListBox1.Items.Add(Trim(RegData.Codigo) + ' ' +
                               Trim(RegData.Nombre) + ' ' +
                               Trim(RegData.Domicilio) + ' ' +
                               Trim(RegData.Localidad)
                              );
         end;
      end;

      F.Free;

   end
   else
      MessageDlg('El Archivo de Datos No Existe',mtInformation,[mbOk],0);

end;

// Elimina el Archivo de Disco
procedure TForm1.Button6Click(Sender: TObject);
begin
   if FileExists(FileName) then
      DeleteFile(FileName);
end;

// Elimina los Registros Eliminados (Registros en Blanco)
procedure TForm1.Button7Click(Sender: TObject);
var
   TFileName : String;
   T : TFileStream;

begin

    if not FileExists(FileName) then
       Exit;

    TFileName := 'FileName.tmp';

    F := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
    T := TFileStream.Create(TFileName, fmCreate or fmShareDenyNone);

    while F.Position < F.Size do
    begin
       F.Read(RegData, SizeOf(RegData));
       if Trim(RegData.Codigo) <> EmptyStr then
          T.Write(RegData, SizeOf(RegData));
    end;

    T.Free;
    F.Free;

    DeleteFile(FileName);
    RenameFile(TFileName,FileName);

end;

// Reset Form
procedure TForm1.Button8Click(Sender: TObject);
var
   i : Integer;

begin

   for i := 0 to ComponentCount - 1 do
      if Components[i] is TEdit then
         TEdit(Components[i]).Text := EmptyStr;

end;

end.
El código anterior en Delphi 7 sobre Windows 7 Professional x32, Implementa un ABM rudimentario basado en TextFile, como se muestra en la siguiente imagen:



Nota :

1- La aplicación permite códigos duplicados, los cuales se pueden evitar por medio de una función de chequeo previa a la adición.

2- No se implemento validación de campos, la idea era mostrar el uso de archivos de texto por medio de TFileStream.

3- El código del ejemplo esta disponible en : TextFile ABM.rar

Espero sea útil

Nelson.

Última edición por nlsgarcia fecha: 08-04-2015 a las 15:35:14.
Responder Con Cita