type
TTestRecord = packed record
AnInt: Integer;
AString: ShortString;
end;
const
Limit: Int64 = MaxLongint;
Filename = 'testfile.dat';
procedure TMainForm.DoTheTest(Sender: TObject);
var
AFile: File of TTestRecord;
ARecord: TTestRecord;
Current, Count, Total: LongInt;
begin
{Make it a one-shot!}
if Sender.InheritsFrom(TButton) then
(Sender as TButton).Enabled := False;
{Some initializations}
Memo.Clear;
ARecord.AString := StringOfChar(' ', SizeOf(ShortString));
{ If there is not already one or it's too small,
create a 2GiB+ file the old-style way }
if not FileExists(Filename) or (FileSize(Filename) < Limit) then begin
AssignFile(AFile, Filename);
Rewrite(AFile);
try
Current := 0;
while FileSize(Filename) < Limit do begin
Inc(Current);
ARecord.AnInt := Current;
ARecord.AString := Current.ToString;
Write(AFile, ARecord);
if Current mod 1000 = 0 then begin { Don't waste much time in UI }
StatusBar.SimpleText := 'Written record #'+Current.ToString;
Application.ProcessMessages;
if Application.Terminated then Exit;
end;
end;
finally
CloseFile(AFile);
end;
end else begin
Total := FileSize(Filename) div SizeOf(ARecord);
StatusBar.SimpleText := Format('Seems to be %d records', [Total]);
end;
Application.ProcessMessages; {Tidy-up UI}
{Now test reading it with a stream}
Current := 0;
FStream := TFileStream.Create(Filename, fmOpenRead);
try
repeat
Inc(Current);
Count := FStream.Read(ARecord, SizeOf(TTestRecord));
if Count > 0 then begin
if Current mod 2000 = 0 then
Memo.Clear; {Let's not waste too much memory ...}
Memo.Lines.Add('Read # %d (%d bytes): %d - %s',
[Current, Count, ARecord.AnInt, ARecord.AString]);
if Current mod 1000 = 0 then begin { Don't waste much updating UI }
Memo.CaretPos := Point(0, Memo.Lines.Count-1);
Application.ProcessMessages;
if Application.Terminated then Exit;
end;
end; {if Count > 0 }
until (FStream.Position >= FStream.Size) or (Count <= 0);
finally
FStream.Free;
end;
Memo.Lines.Add('----- DONE!!!');
Memo.SelStart := Length(Memo.Lines.Text);
end;
Recent
