Mega Code Archive
Readlargetextfile
<![CDATA[
unit LoadUnit;
{Richard Ebbs 1998}
{A small program to illustrate techniques for reading a LARGE file.
Requires suitable large file in same dir (change the filename in the
Const section below as necessary).
This program uses 'blockread' to read a file in 64K chunks. The file is
treated as an 'untyped' file but that's fine if, for instance, we want
to search through a text file}
interface
uses
{use a minimum of library routines to increase speed/compactness}
Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
const
fileName = 'Oxford.';
{fileName = 'Hamlet.txt';}
MaxBufferSize = 1024 * 63; {maximum size of buffer: 63K}
type
{define a buffer as a character array type of length MaxBufferSize...}
TSearchBufferArray = array[1..MaxBufferSize] of char;
{and define a pointer type to point into the buffer}
TSearchBuffer = ^TSearchBufferArray;
type
TForm1 = class(TForm)
LoadButton: TButton;
function CreateBuffer: Boolean;
procedure DestroyBuffer;
function LoadEnormous: longInt;
procedure LoadButtonClick(Sender: TObject);
function GetError(const ErrorCode: Integer): string;
private
{private declarations}
Buffer : TSearchBuffer; {define a (global) buffer variable}
totalBytesRead: LongInt;
public
{public declarations}
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function TForm1.CreateBuffer: Boolean;
{creates a MaxBufferSize buffer, but does nothing with it...}
var
NoMemory: Boolean;
begin
NoMemory := False;
try {to allocate memory}
getmem (Buffer, MaxBufferSize)
except
NoMemory := True;
end;
{return False if there IS enough memory, return True if there isn't...}
Result := NoMemory;
end;
procedure TForm1.DestroyBuffer;
{free the memory that Buffer points to...}
begin
freemem(Buffer,sizeof(Buffer^))
end;
function TForm1.LoadEnormous: longInt;
{read a big source text file in MaxBufferSize chunks...}
var
{declare the source file to be an UNTYPED file so that we
are then able to use Seek() and BlockRead() which we could
not do if we opened it as a text file...}
srcFile: file;
bytesRead: Integer;
numReads: Integer;
begin
bytesRead := 0;
numReads := 0;
totalBytesRead := 0;
AssignFile(srcFile, fileName);
try {to open source file}
reset(srcFile,1);
try {putting source file data into memory ie into the buffer}
repeat
blockread(srcFile, Buffer^, sizeof(Buffer^), bytesRead);
totalBytesRead := totalBytesRead + bytesRead;
{if Buffer is full when we come to read data in, (as code here
iterates in a repeat loop) then skip backwards length(searchString)
bytes in the source file. This would ensure that we don't miss a
searched-for pattern existing on a 'blockread boundary'...}
if BytesRead = sizeof(Buffer^) then
{note the 'minus 10 in line below is a temporary expedient -later
insert code to backtrack the length of the 'search string', OK..?}
seek(srcFile, filepos(srcFile)-10);
Inc(numReads);
until (bytesRead = 0);
finally
closefile(srcFile)
end; {putting source file data into memory}
except
on E: EInOutError do
begin
MessageDlg('Error reading ' + uppercase(fileName) + '.'#13 +
GetError(E.ErrorCode)+'.', mterror,[mbOK], 0);
numReads := -1;
end
end; {trying to open source file}
{if there hasn't been an error reading the source file then return the
total number of blockreads that have been performed.If there has been
an error then return -1...}
Result := numReads;
end;
function TForm1.GetError (const ErrorCode: integer): string;
{Returns a string pertaining to the type of error. If IO-checking was off
we could check for errors by looking at IOResult, but in this program we
use an exception handler (in the file reading routine (above). The
strings listed below are taken from Borland's 'Object Pascal Language Guide'
for Delphi Version 1.0, pages 273-275...}
begin
case ErrorCode of
2: Result := 'File not found';
3: Result := 'Path not found';
4: Result := 'Too many open files';
5: Result := 'File access denied';
6: Result := 'Invalid file handle';
12: Result := 'Invalid file access code';
15: Result := 'Invalid drive';
100: Result := 'Disk read error';
101: Result := 'Disk write error';
102: Result := 'File not assigned';
103: Result := 'File not open';
else
Result := ''
end
end;
procedure TForm1.LoadButtonClick(Sender: TObject);
var
{the 'readsNUM' variable holds EITHER the number of blocks read
OR -1 for a complete failure to read the source file...}
readsNum: longInt;
OutOfMemory: Boolean;
msgString: String;
begin
readsNum := 0;
OutOfMemory := True;
OutOfMemory := CreateBuffer;
if OutOfMemory then
begin
ShowMessage('Not enough memory');
end
else
begin
readsNum := LoadEnormous;
end;
msgString := 'Number of blocks read: ' + IntToStr(readsNum);
ShowMessage(msgString);
msgString := 'Number of bytes read: ' + IntToStr(totalBytesRead);
ShowMessage(msgString);
DestroyBuffer;
end;
end.
]]>