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. |