[Back to WIN-OS2 SWAG index] [Back to Main SWAG index] [Original]
Hi,
Below I attach a TPW 1.5 unit which provides a dynamically sized
memory stream with no 64K limit. Enjoy.
Eyal Doron
--------------------------Cut here--------------------------
{===============================================================================}
{ Unit wHugeMem, written by Eyal Doron,
1997. }
{
}
{ This unit implements a memory stream which is allocated from the
global }
{ Windows memory pool. The size of the memory stream grows dynamically,
and }
{ is limited only by the available real and virtual memory. Uses
include: }
{ * A temporary
stream. }
{ * A convenient method to randomly access or write to a memory
handle. }
{
}
{
Variables:
}
{ Handle - The actual memory
handle. }
{ Size - The current size of the
stream. }
{ AllocSize - The amount of currently allocated
memory. }
{ Base - A pointer to the beginning of the allocated
memory. }
{ Owner - A boolean which determines if the stream owns the handle.
If so, }
{ the memory will be de-allocated in the destructor,
otherwise no. }
{ ReallyTruncate - A boolean which determines if Truncate calls
will }
{ also de-allocate memory. The default is no, to
speed up }
{
access. }
{
}
{
Constructors:
}
{
}
{
Init(InitialSize)
}
{ Initialize a new memory stream, and allocate "InitialSize" bytes.
Note }
{ that the size of the stream, in contrast to the allocated memory, is
zero. }
{ InitExt(ExtHandle: THandle; InitialSize: longint; AOwner:
boolean) }
{ Initialize a new memory stream, using an externally provided memory
handle. }
{ Specifying InitialSize=-1 will take it to be given by the allocated
size }
{ of the memory
block. }
{===============================================================================}
{$W-,R+,G+}
Unit WHugeMem;
{ Implements a memory stream }
interface
Uses
WObjects,WinTypes,WinProcs;
type
TLongType = record
case Word of
0: (Ptr: Pchar);
1: (Long: Longint);
2: (Lo: Word; Hi: Word);
end;
PHugeMemStream = ^THugeMemStream;
THugeMemStream = object(TStream)
Size,Current,AllocSize: longint;
Handle: THandle;
Base : TLongType;
Owner,ReallyTruncate: boolean;
constructor Init(InitialSize: longint);
constructor InitExt(ExtHandle: THandle; InitialSize: longint;
AOwner: boolean);
function GetPos : longint; virtual;
function GetSize: longint; virtual;
procedure Seek(Pos: Longint); virtual;
procedure Truncate; virtual;
procedure Read(var Buf; Count: Word); virtual;
procedure Write(var Buf; Count: Word); virtual;
destructor Done; virtual;
end;
implementation
const
K64 = $10000;
procedure AHIncr; far; external 'KERNEL' index 114;
{ THugeMemStream methods }
constructor THugeMemStream.init(InitialSize: longint);
begin
TStream.init;
Size:=0; Current:=0; AllocSize:=0; Base.Ptr:=Nil; Handle:=0;
ReallyTruncate:=false;
if InitialSize>0 then
begin
Handle:=GlobalAlloc(GMEM_Moveable,InitialSize);
AllocSize:=GlobalSize(Handle);
Base.Ptr:=GlobalLock(Handle);
end;
Owner:=true;
end; { THugeMemStream.init }
constructor THugeMemStream.initExt(ExtHandle: THandle; InitialSize:
longint;
AOwner: boolean);
begin
TStream.init;
AllocSize:=GlobalSize(ExtHandle);
if InitialSize=-1 then InitialSize:=AllocSize;
Size:=InitialSize; Current:=0; Base.Ptr:=Nil; Handle:=0;
ReallyTruncate:=false;
if InitialSize>0 then
begin
Handle:=ExtHandle; Base.Ptr:=GlobalLock(Handle);
end;
Owner:=AOwner;
end; { THugeMemStream.init }
function THugeMemStream.GetPos: longint;
begin GetPos:=Current; end;
function THugeMemStream.GetSize: longint;
begin GetSize:=Size; end;
procedure THugeMemStream.Seek(Pos: Longint);
begin
if Status<>stOK then Exit;
if (Pos<0) or (Pos>Size) then Error(stReadError,0)
else Current:=Pos;
end;
procedure THugeMemStream.Truncate;
begin
if Status<>stOK then Exit;
Size:=Current;
if ReallyTruncate then
GlobalRealloc(Handle,Size,GMEM_ZeroInit);
{ Does not currently de-allocate memory }
end; { THugeMemStream.Truncate }
procedure THugeMemStream.Read(var Buf; Count: Word);
var
Start,ToAddr: TLongType;
l: word;
P: PChar;
begin
if Status<>stOK then Exit;
if Current+Count>Size then
begin
Error(stReadError,0); FillChar(Buf,Count,0);
end else
begin
P:=@Buf;
Start.Long:=Base.Lo+Current;
ToAddr.Hi := Base.Hi + (Start.Hi * Ofs(AHIncr));
ToAddr.Lo := Start.Lo;
if ToAddr.Lo>$FFFF-Count then { Crossing a segment boundary }
begin
l:=$FFFF-ToAddr.Lo+1;
Move(ToAddr.Ptr^,Buf,l);
ToAddr.Hi:=ToAddr.Hi+Ofs(AHIncr); ToAddr.Lo:=0;
Move(ToAddr.Ptr^,P[l],Count-l);
end else Move(ToAddr.Ptr^,Buf,Count);
Current:=Current+Count;
end;
end; { THugeMemStream.Read }
procedure THugeMemStream.write(var Buf; Count: Word);
var
Start,ToAddr: TLongType;
l: word;
P: PChar;
ll: longint;
NewHandle: THandle;
begin
if Status<>stOK then Exit;
if Current+Count>AllocSize then
begin
ll:=Current+Count;
ll:=K64*((ll-1) div K64)+K64;
{ message('Re-alloc to '+num2str(ll));}
if Handle=0 then Handle:=GlobalAlloc(GMem_Moveable,ll)
else begin
GlobalUnlock(Handle);
NewHandle:=GlobalReAlloc(Handle,ll,GMEM_Moveable);
if NewHandle=0 then Error(stWriteError,0)
else Handle:=NewHandle;
{ message('New size is '+num2str(GlobalSize(Handle)));}
end;
Base.Ptr:=GlobalLock(Handle);
AllocSize:=GlobalSize(Handle);
end;
P:=@Buf;
Start.Long:=Base.Lo+Current;
ToAddr.Hi := Base.Hi + (Start.Hi * Ofs(AHIncr));
ToAddr.Lo := Start.Lo;
if ToAddr.Lo>$FFFF-Count+1 then { Crossing a segment boundary }
begin
{ message('write '+num2str(count)+' bytes');}
l:=$FFFF-ToAddr.Lo+1;
{ message(num2str(l)+' bytes first');}
Move(Buf,ToAddr.Ptr^,l);
if Count>l then
begin
ToAddr.Hi:=ToAddr.Hi+Ofs(AHIncr); ToAddr.Lo:=0;
{ message(num2str(Count-l)+' bytes second');}
Move(P[l],ToAddr.Ptr^,Count-l);
end;
end else Move(Buf,ToAddr.Ptr^,Count);
Current:=Current+Count; if Current>Size then Size:=Current;
end; { THugeMemStream.write }
destructor THugeMemStream.Done;
begin
if Handle<>0 then
begin
GlobalUnlock(Handle);
if Owner then GlobalFree(Handle);
end;
TStream.Done;
end; { THugeMemStream.Done }
end.
[Back to WIN-OS2 SWAG index] [Back to Main SWAG index] [Original]