Ver Mensaje Individual
  #13  
Antiguo 07-09-2014
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
tarco35,

Cita:
Empezado por ecfisa
...Es un resabio del viejo Turbo Pascal... , con Delphi ya podemos hacer...con el mismo resultado...


Revisa este código:
Código Delphi [-]
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ListBox1: TListBox;
    Button4: TButton;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TData = record
     Name : Array[0..29] of Char;
     PIN : Integer;
     DateData : TDateTime;
  end;

const
  CountReg = 1000;

var
  Form1: TForm1;
  ArrayData : Array[0..CountReg-1] of TData;
  RegData : TData;
  FileName : String;
  F : TFileStream;

implementation

{$R *.dfm}

// Inicializa la Aplicación
procedure TForm1.FormCreate(Sender: TObject);
begin
   Randomize;
   FileName := ExtractFilePath(Application.ExeName) + 'Data.txt';
end;

// Genera un Arreglo de Registros de 1000 Elementos
procedure TForm1.Button1Click(Sender: TObject);
var
   i : Integer;

begin

   FillChar(ArrayData,SizeOf(ArrayData),0);

   for i := 0 to CountReg - 1 do
   begin
      StrPCopy(ArrayData[i].Name,'Name-' + IntToStr(i));
      ArrayData[i].PIN := Random(1000);
      ArrayData[i].DateData := Now + Random(365);
   end;

end;

// Graba 1000 Registros en una Sola Operación de Acceso a Disco
procedure TForm1.Button2Click(Sender: TObject);
begin

   F := TFileStream.Create(FileName, fmCreate, fmShareExclusive);
   F.Write(ArrayData, SizeOf(ArrayData));
   F.Free;

end;

// Lee 1000 Registros en una Sola Operación de Acceso a Disco y los Muestra en un ListBox
procedure TForm1.Button3Click(Sender: TObject);
var
   i : Integer;

begin

   FillChar(ArrayData,SizeOf(ArrayData),0);

   F := TFileStream.Create(FileName, fmOpenRead, fmShareDenyNone);
   F.Read(ArrayData, SizeOf(ArrayData));
   F.Free;

   for i := 0 to CountReg - 1 do
   begin
      ListBox1.Items.Add(ArrayData[i].Name
                         + ' '
                         + IntToStr(ArrayData[i].PIN)
                         + ' '
                         + DateTimeToStr(ArrayData[i].DateData));
   end;

end;

// Clear el ListBox de Registros
procedure TForm1.Button4Click(Sender: TObject);
begin
   ListBox1.Clear;
end;

// Muestra la data de un registro n 
procedure TForm1.Button5Click(Sender: TObject);
var
   NumReg : String;
   DataReg : string;
   PosReg : Integer;
   MsgApp : String;

begin

   NumReg := InputBox('Número de Registro a Consultar', 'NumReg', '1');

   F := TFileStream.Create(FileName, fmOpenRead, fmShareDenyNone);
   
   if StrToIntDef(NumReg,1) > F.Size div SizeOf(RegData) then
   begin
      MsgApp := Format('Número de Reg Invalido, El Archivo tiene %d Reg',[F.Size div SizeOf(RegData)]);
      MessageDlg(MsgAPP,mtInformation,[mbOK],0);
      F.Free;
      Exit;
   end;

   PosReg := (StrToIntDef(NumReg,1) - 1) * SizeOf(RegData);

   F.Seek(PosReg, soFromBeginning);
   F.Read(RegData, SizeOf(RegData));
   DataReg := RegData.Name
              + ' '
              + IntToStr(RegData.PIN)
              + ' '
              + DateTimeToStr(RegData.DateData);

   ShowMessage(DataReg);

   F.Free;

end;

end.
El código anterior en Delphi 7 bajo Windows 7 Professional x32, permite leer y grabar bloques de registros de un archivo en una sola operación de acceso a disco con TFileStream y consultar registros individuales de forma aleatoria.

Espero sea útil

Nelson.

Última edición por nlsgarcia fecha: 07-09-2014 a las 16:59:15.
Responder Con Cita