Unit TextStream
Ever wanted to use
Read/ReadLn/Write/WriteLn textfile
functions on a stream? Here's how!
Sample code:
procedure WriteMonths;
var
I: Integer;
T: TextFile;
S: TStream;
begin
S :=
TFileStream.Create(ChangeFileExt(Application.ExeName,
'.TXT'),
fmCreate);
AssignStream(T, S);
Rewrite(T);
for I := 1 to 12 do
WriteLn(T, I:2, '':1,
LongMonthNames[I]);
CloseFile(T);
end;
Now the code of the AssignStream
function. See
this Unit: (TextStream.Pas)
-------------------------------------------------------------------------------
unit TextStream;
{ Author: \/\//\ Wim, W.A. ten Brink,
E-mail :
Wim.tenBrink@Ediport.nl,
phone : +31 655 76 59 18.
Copyright
(C) 1999 by Workshop Alex.
This is Freeware.
This code is created as a
sample
about using TextFile functions with more
complex input/output.
It's kept simple to encourage
other
people to create their own TextFile-based
routines. It's not that
difficult...
;)
I would appreciate bug-reports
for
this piece of code...}
interface
uses
SysUtils, Classes;
procedure AssignStream(var T: TextFile;
AStream:
TStream);
implementation
{ We need to redefine a new
TTextRec-UserData
type. This can be used to store
internal data of our textfile. Use
as
little space as possible. Even better,
add only a pointer to a larger
structure.
}
type
StreamData = record
Stream: TStream;
Filler: array[1..16] of
Char;
end;
{ The function that is called
when the
TextBuffer is flushed or full. }
function StreamWrite(var F: TTextRec):
Integer;
far;
begin
StreamData(Pointer(@F.UserData)^).Stream.WriteBuffer(F.BufPtr^,
F.BufPos);
F.BufPos := 0;
Result := 0;
end;
{ The function that is called when
there's nothing
left to read in the
TextBuffer. }
function StreamRead(var F: TTextRec):
Integer;
far;
begin
F.BufEnd :=
StreamData(Pointer(@F.UserData)^).Stream.Read(F.BufPtr^,
F.BufSize);
F.BufPos := 0;
Result := 0;
end;
{ The Open-function for the TextFile. }
function StreamOpen(var F: TTextRec):
Integer;
far;
begin
if (F.Mode = fmInput) then begin
{ Gonna read. }
F.InOutFunc :=
@StreamRead;
F.FlushFunc := Nil;
StreamData(Pointer(@F.UserData)^).Stream.Position
:= 0;
Result := 0;
end
else if (F.Mode = fmOutput) then
begin
{ Gonna write }
F.Mode := fmOutput;
F.InOutFunc :=
@StreamWrite;
F.FlushFunc :=
@StreamWrite;
StreamData(Pointer(@F.UserData)^).Stream.Position
:= 0;
Result := 0;
end
else begin
{ Gonna complain...
Illegal
function. }
Result := 1;
end;
end;
{ The Close-function for the TextFile. }
function StreamClose(var F: TTextRec):
Integer;
far;
begin
StreamData(Pointer(@F.UserData)^).Stream.Position
:= 0;
F.InOutFunc := Nil;
F.FlushFunc := Nil;
Result := 0;
end;
{ What to do when assigning the stream? }
procedure AssignStream(var T: TextFile;
AStream:
TStream);
begin
with TTextRec(T) do begin
{ Streams have no
handle...
}
Handle := 0;
{ After assigning, the
file
is closed. }
Mode := fmClosed;
{ A TTextRec includes a
Buffer.
Just set it's size... }
BufSize :=
SizeOf(Buffer);
{ Position inside the
buffer:
start & Stop. }
BufPos := 0;
BufEnd := 0;
{ Pointer to the buffer.
(Changes
when we call SetTextBuf procedure...) }
BufPtr := @Buffer;
{ Initialize
function-calls.
}
OpenFunc := @StreamOpen;
InOutFunc :=
Nil;
{ Closed, so no input/Output routine. }
FlushFunc :=
Nil;
{ Closed, so no Flush routine. }
CloseFunc :=
@StreamClose;
{ Also used as Flush-function when writing. }
{ Set the filename: No
name...
}
Name[0] := #0;
{ And finally, our own
data...
Assign the stream to the file... }
StreamData(Pointer(@UserData)^).Stream
:= AStream;
end;
end;
end.
|