"Seek" on a text file
kena...@digital.net
later a bit of code on this forum, to find out later (through
a note to another poster) that I was not getting my message
to the Borland Newsgroup server. So here's a repost.
I had written in Turbo Pascal and just recently in Delphi
some very simple code to allow me to do a FilePos-type
and Seek-type call on a text file. I'll c&p the code below.
Note: It is only written for reading files, not writting. (But
for what I need it for that's sufficient.) I was curious why
this wasn't built-in, as I think it useful and not very hard.
I was also wondering if someone else had already written
the same thing. Thanks.
Walter
======================
unit TextRead;
{
TextRead - a simple Seek access to text files in read mode.
}
{ $define D4 = when Delphi version is 4.0 or greater}
interface
procedure AssignText (var T: text; FName: String);
{$ifdef D4}
function FilePosText (var T: text): cardinal;
procedure SeekText (var T: text; const N: cardinal);
{$else}
function FilePosText (var T: text): longint;
procedure SeekText (var T: text; const N: longint);
{$endif}
implementation
uses Windows, SysUtils;
const
{$ifdef D4}
PosSize = SizeOf(cardinal);
{$else}
PosSize = SizeOf(longint);
{$endif}
lpIndex = 1;
function TextInput (var t: TTextRec): integer;
var
bval : boolean;
{$ifdef D4}
NumToRead : cardinal;
NumRead : cardinal;
{$else}
NumToRead : integer;
NumRead : integer;
{$endif}
pOverlap : POverlapped;
l : cardinal;
begin
with t do
begin
NumToRead := t.BufSize;
pOverlap := nil;
bval := ReadFile (t.handle, t.BufPtr^, NumToRead, NumRead, pOverlap);
if (not bval) then
begin
result := GetLastError;
exit;
end;
result := 0;
BufPos := 0;
move (UserData[lpIndex], l, PosSize);
l := l + BufEnd;
move (l, UserData[lpIndex], PosSize);
BufEnd := NumRead;
end
end;
function TextIgnore (var t: TTextRec): integer;
begin;
result := 0;
end;
function TextClose (var t: TTextRec): integer;
begin
CloseHandle(t.handle);
t.Mode := fmClosed;
result := GetLastError;
end;
function TextOpen (var t: TTextRec): integer;
var
{$ifdef D4}
DAccess : cardinal;
ShareMode : cardinal;
pSecurity : PSecurityAttributes;
CreatDist : cardinal;
FlagsnAttr: cardinal;
HTempl : cardinal;
{$else}
DAccess : integer;
ShareMode : integer;
pSecurity : PSecurityAttributes;
CreatDist : integer;
FlagsnAttr: integer;
HTempl : integer;
{$endif}
begin
result := 1;
with t do
begin
if (t.Mode = fmInput) then
begin
t.InOutFunc := @TextInput;
t.FlushFunc := @TextIgnore;
t.CloseFunc := @TextClose;
DAccess := GENERIC_READ;
ShareMode := FILE_SHARE_READ;
pSecurity := nil;
CreatDist := OPEN_EXISTING;
FlagsnAttr:= FILE_ATTRIBUTE_READONLY;
HTempl := 0;
t.Handle := CreateFile(@t.Name[0], DAccess, ShareMode, pSecurity, CreatDist,
FlagsnATtr, HTempl);
if (t.handle = INVALID_HANDLE_VALUE) then
begin
result := GetLastError;
exit;
end
else
begin
t.BufPos := 0;
t.BufEnd := 0;
FillChar (t.UserData[lpIndex], SizeOf(t.UserData), 0);
result := TextInput (t);
end
end
else if (t.Mode = fmOutput) then
begin;
t.InOutFunc := @TextIgnore;
t.FlushFunc := @TextIgnore;
t.CloseFunc := @TextClose;
end
else if (t.Mode = fmInOut) then
begin;
t.Mode := fmOutput;
t.InOutFunc := @TextIgnore;
t.FlushFunc := @TextIgnore;
t.CloseFunc := @TextClose;
end;
end
end;
procedure AssignText (var T: text; FName: String);
var
len : cardinal;
begin
with TTextRec(T) do
begin
handle := -1;
Mode := fmClosed;
BufSize := sizeof(Buffer);
BufPtr := @Buffer;
FlushFunc:= @TextIgnore;
OpenFunc := @TextOpen;
CloseFunc:= @TextClose;
len := length(FName);
move (Fname[1], Name[0], len);
Name[len]:= #0;
end;
end;
{$ifdef D4}
function FilePosText (var T: text): cardinal;
{$else}
function FilePosText (var T: text): longint;
{$endif}
var
l : cardinal;
begin
move (TTextRec(t).UserData[lpIndex], l, PosSize);
result := l + TTextRec(t).BufPos;
end;
{$ifdef D4}
procedure SeekText (var T: text; const N: cardinal);
{$else}
procedure SeekText (var T: text; const N: longint);
{$endif}
var
l : cardinal;
begin
with TTextRec(t) do
begin
move (UserData[lpIndex], l, PosSize);
if ((N >= l) and (N < l+BufEnd)) then
begin // Desired position within current buffer; readjust current position
BufPos := N - l;
end
else
begin // Desired position outside current buffer; read in different segment
l := BufSize * (N div BufSize);
move (l, UserData[lpIndex], PosSize);
l := SetFilePointer (Handle, l, nil, FILE_BEGIN);
BufEnd := BufSize;
TextInput (TTextRec(t));
BufPos := N mod BufSize;
end;
end;
end;
end.
Chris R. Timmons
>I recently posted (or thought I had) some questions and
>later a bit of code on this forum, to find out later (through
>a note to another poster) that I was not getting my message
>to the Borland Newsgroup server. So here's a repost.
>
>I had written in Turbo Pascal and just recently in Delphi
>some very simple code to allow me to do a FilePos-type
>and Seek-type call on a text file. I'll c&p the code below.
>Note: It is only written for reading files, not writting. (But
>for what I need it for that's sufficient.) I was curious why
>this wasn't built-in, as I think it useful and not very hard.
>I was also wondering if someone else had already written
>the same thing. Thanks.
Walter,
Delphi provides the TFileStream object, as well as several other stream
types. Look in the help file under TStream for a list of stream types.
With TFileStream, you can perform seek operations like this:
// (This is untested, off-the-top-of-my-head code...)
var
FileStream : TFileStream;
Buffer : string;
begin
FileStream := nil;
try
// Open an existing file.
FileStream := TFileStream.Create('MyFile.txt', fmOpenRead);
// If the file has at least 100 characters, get the last ten.
if FileStream.Size >= 100 then
begin
FileStream.Seek(soFromBeginning, 90);
SetLength(Buffer, 10);
FileStream.Read(Buffer, 10);
ShowMessage('The 10 characters are: ' + Buffer);
end; // if
finally
FileStream.Free;
end; // try
HTH,
Chris.
----------
kena...@digital.net
Rudy Velthuis
>Yes, Thanks.
Please Ken, do not quote almost entire messages (35 lines in this case)
just to show your gratitude. Thanks.
--
Rudy Velthuis