如何正常使用TMemoryStream内存流？

无条件为你 2008-03-16 02:54:04
我的程序没有窗体，只有一个dpr格式的工程文件，为了使生成的EXE体积变小，我发现只要Uses classes后，EXE会变大许多。但程序中又必须要用TMemoryStream这种类型，我希望在不包含Classes.pas这个单元的情况下，保证TMemoryStream可用。

谁能从Classes.pas中把TMemoryStream剔出来？

例如：

var f:TMemoryStream;


只要保证下面的几个方法可以用就行了：

f.LoadFromStream();
f.SaveToFile();
f.SaveToStream();
f.SaveToFile();
f.Size
f.Free
f.Position
f.Clear;
f.Write()
f.Read()
f.CopyFrom()
f.Seek()
...全文
793 27 打赏 收藏 转发到动态 举报
写回复
用AI写文章
27 条回复
切换为时间正序
请发表友善的回复…
发表回复
散乱心绪 2008-03-24
  • 打赏
  • 举报
 回复
休息日回家了，没上网看。

代码我就不贴了，你自己去掉 SysUtils的引用

注释掉
{ Exception classes }
EStreamError = class(Exception);
EFilerError = class(EStreamError);
EReadError = class(EFilerError);
EWriteError = class(EFilerError);
EInvalidImage = class(EFilerError);

然后编译，将编译不通过的代码注释掉，不过这样你就需要自己对异常错误进行处理。
当然如果你能确保你的类在使用过程中不会出现异常错误，那不写异常处理也没事。
无条件为你 2008-03-22
  • 打赏
  • 举报
 回复
slxx0712，你的代码我试过了，可以用，但跟我贴出来的代码生成的EXE大小没有什么区别。
我认为是因为uses SysUtils的原因，能不能不包含SysUtils呢？

希望能再次看到你的回复，如果做到不包含SysUtils，贴子我将加到200分后结贴，如果做
不到，明天晚上结贴，尽管你的贴子没有给我什么实际帮助。

感谢你的回复。
无条件为你 2008-03-21
  • 打赏
  • 举报
 回复
楼上的，ASPACK压缩？呵呵，ASPACK的源码我都有，而且我还可以把它的源码加到我的程序中。

但是，我首先要保证程序本身就小，然后再用ASPACK压缩。


谢谢slxx0712 ，我现在在网吧，不方便测试代码，等明天测试通过后结贴！
散乱心绪 2008-03-19
  • 打赏
  • 举报
 回复
功能就保留了你要的那几个，其他的都去掉了，编译是通过的，没测试过，你可以自己试试。
heiyuyun 2008-03-19
  • 打赏
  • 举报
 回复
学习中...
散乱心绪 2008-03-19
  • 打赏
  • 举报
 回复
SaveToFile和LoadFromFile源码里用了TFileStream，你如果不想要TFileStream，那就自己用windows API读取好了，都一样的，这个就不给你写了。


{ TCustomMemoryStream }

procedure TCustomMemoryStream.SetPointer(Ptr: Pointer; Size: Longint);
begin
FMemory := Ptr;
FSize := Size;
end;

function TCustomMemoryStream.Read(var Buffer; Count: Longint): Longint;
begin
if (FPosition >= 0) and (Count >= 0) then
begin
Result := FSize - FPosition;
if Result > 0 then
begin
if Result > Count then Result := Count;
Move(Pointer(Longint(FMemory) + FPosition)^, Buffer, Result);
Inc(FPosition, Result);
Exit;
end;
end;
Result := 0;
end;

function TCustomMemoryStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
case Origin of
soFromBeginning: FPosition := Offset;
soFromCurrent: Inc(FPosition, Offset);
soFromEnd: FPosition := FSize + Offset;
end;
Result := FPosition;
end;

procedure TCustomMemoryStream.SaveToStream(Stream: TStream);
begin
if FSize <> 0 then Stream.WriteBuffer(FMemory^, FSize);
end;

procedure TCustomMemoryStream.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
{ Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end; }
end;

{ TMemoryStream }

const
MemoryDelta = $2000; { Must be a power of 2 }

destructor TMemoryStream.Destroy;
begin
Clear;
inherited Destroy;
end;

procedure TMemoryStream.Clear;
begin
SetCapacity(0);
FSize := 0;
FPosition := 0;
end;

procedure TMemoryStream.LoadFromStream(Stream: TStream);
var
Count: Longint;
begin
Stream.Position := 0;
Count := Stream.Size;
SetSize(Count);
if Count <> 0 then Stream.ReadBuffer(FMemory^, Count);
end;

procedure TMemoryStream.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
{ Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end; }
end;

procedure TMemoryStream.SetCapacity(NewCapacity: Longint);
begin
SetPointer(Realloc(NewCapacity), FSize);
FCapacity := NewCapacity;
end;

procedure TMemoryStream.SetSize(NewSize: Longint);
var
OldPosition: Longint;
begin
OldPosition := FPosition;
SetCapacity(NewSize);
FSize := NewSize;
if OldPosition > NewSize then Seek(0, soFromEnd);
end;

function TMemoryStream.Realloc(var NewCapacity: Longint): Pointer;
begin
if (NewCapacity > 0) and (NewCapacity <> FSize) then
NewCapacity := (NewCapacity + (MemoryDelta - 1)) and not (MemoryDelta - 1);
Result := Memory;
if NewCapacity <> FCapacity then
begin
if NewCapacity = 0 then
begin
{$IFDEF MSWINDOWS}
GlobalFreePtr(Memory);
{$ELSE}
FreeMem(Memory);
{$ENDIF}
Result := nil;
end else
begin
{$IFDEF MSWINDOWS}
if Capacity = 0 then
Result := GlobalAllocPtr(HeapAllocFlags, NewCapacity)
else
Result := GlobalReallocPtr(Memory, NewCapacity, HeapAllocFlags);
{$ELSE}
if Capacity = 0 then
GetMem(Result, NewCapacity)
else
ReallocMem(Result, NewCapacity);
{$ENDIF}
if Result = nil then raise EStreamError.CreateRes(@SMemoryStreamError);
end;
end;
end;

function TMemoryStream.Write(const Buffer; Count: Longint): Longint;
var
Pos: Longint;
begin
if (FPosition >= 0) and (Count >= 0) then
begin
Pos := FPosition + Count;
if Pos > 0 then
begin
if Pos > FSize then
begin
if Pos > FCapacity then
SetCapacity(Pos);
FSize := Pos;
end;
System.Move(Buffer, Pointer(Longint(FMemory) + FPosition)^, Count);
FPosition := Pos;
Result := Count;
Exit;
end;
end;
Result := 0;
end;

end.
散乱心绪 2008-03-19
  • 打赏
  • 举报
 回复
{ TStream }

function TStream.GetPosition: Int64;
begin
Result := Seek(0, soCurrent);
end;

procedure TStream.SetPosition(const Pos: Int64);
begin
Seek(Pos, soBeginning);
end;

function TStream.GetSize: Int64;
var
Pos: Int64;
begin
Pos := Seek(0, soCurrent);
Result := Seek(0, soEnd);
Seek(Pos, soBeginning);
end;

procedure TStream.SetSize(NewSize: Longint);
begin
// default = do nothing (read-only streams, etc)
// descendents should implement this method to call the Int64 sibling
end;

procedure TStream.SetSize64(const NewSize: Int64);
begin
SetSize(NewSize);
end;

procedure TStream.SetSize(const NewSize: Int64);
begin
{ For compatibility with old stream implementations, this new 64 bit SetSize
calls the old 32 bit SetSize. Descendent classes that override this
64 bit SetSize MUST NOT call inherited. Descendent classes that implement
64 bit SetSize should reimplement their 32 bit SetSize to call their 64 bit
version.}
if (NewSize < Low(Longint)) or (NewSize > High(Longint)) then
raise ERangeError.CreateRes(@SRangeError);
SetSize(Longint(NewSize));
end;

function TStream.Seek(Offset: Longint; Origin: Word): Longint;

procedure RaiseException;
begin
raise EStreamError.CreateResFmt(@sSeekNotImplemented, [Classname]);
end;

type
TSeek64 = function (const Offset: Int64; Origin: TSeekOrigin): Int64 of object;
var
Impl: TSeek64;
Base: TSeek64;
ClassTStream: TClass;
begin
{ Deflect 32 seek requests to the 64 bit seek, if 64 bit is implemented.
No existing TStream classes should call this method, since it was originally
abstract. Descendent classes MUST implement at least one of either
the 32 bit or the 64 bit version, and must not call the inherited
default implementation. }
Impl := Seek;
ClassTStream := Self.ClassType;
while (ClassTStream <> nil) and (ClassTStream <> TStream) do
ClassTStream := ClassTStream.ClassParent;
if ClassTStream = nil then RaiseException;
Base := TStream(@ClassTStream).Seek;
if TMethod(Impl).Code = TMethod(Base).Code then
RaiseException;
Result := Seek(Int64(Offset), TSeekOrigin(Origin));
end;

function TStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
{ Default implementation of 64 bit seek is to deflect to existing 32 bit seek.
Descendents that override 64 bit seek must not call this default implementation. }
if (Offset < Low(Longint)) or (Offset > High(Longint)) then
raise ERangeError.CreateRes(@SRangeError);
Result := Seek(Longint(Offset), Ord(Origin));
end;

procedure TStream.ReadBuffer(var Buffer; Count: Longint);
begin
if (Count <> 0) and (Read(Buffer, Count) <> Count) then
raise EReadError.CreateRes(@SReadError);
end;

procedure TStream.WriteBuffer(const Buffer; Count: Longint);
begin
if (Count <> 0) and (Write(Buffer, Count) <> Count) then
raise EWriteError.CreateRes(@SWriteError);
end;

function TStream.CopyFrom(Source: TStream; Count: Int64): Int64;
const
MaxBufSize = $F000;
var
BufSize, N: Integer;
Buffer: PChar;
begin
if Count = 0 then
begin
Source.Position := 0;
Count := Source.Size;
end;
Result := Count;
if Count > MaxBufSize then BufSize := MaxBufSize else BufSize := Count;
GetMem(Buffer, BufSize);
try
while Count <> 0 do
begin
if Count > BufSize then N := BufSize else N := Count;
Source.ReadBuffer(Buffer^, N);
WriteBuffer(Buffer^, N);
Dec(Count, N);
end;
finally
FreeMem(Buffer, BufSize);
end;
end;
散乱心绪 2008-03-19
  • 打赏
  • 举报
 回复
我给你提了下，没测试过，你可以试下。


unit Unit2;
interface
uses
Windows, SysUtils;

type
{ TStream seek origins }
TSeekOrigin = (soBeginning, soCurrent, soEnd);
{ Exception classes }
EStreamError = class(Exception);
EFilerError = class(EStreamError);
EReadError = class(EFilerError);
EWriteError = class(EFilerError);
EInvalidImage = class(EFilerError);

{ TStream abstract class }

TStream = class(TObject)
private
function GetPosition: Int64;
procedure SetPosition(const Pos: Int64);
function GetSize: Int64;
procedure SetSize64(const NewSize: Int64);
protected
procedure SetSize(NewSize: Longint); overload; virtual;
procedure SetSize(const NewSize: Int64); overload; virtual;
public
function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
function Seek(Offset: Longint; Origin: Word): Longint; overload; virtual;
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; virtual;
procedure ReadBuffer(var Buffer; Count: Longint);
procedure WriteBuffer(const Buffer; Count: Longint);
function CopyFrom(Source: TStream; Count: Int64): Int64;
property Position: Int64 read GetPosition write SetPosition;
property Size: Int64 read GetSize write SetSize64;
end;

{ TCustomMemoryStream abstract class }

TCustomMemoryStream = class(TStream)
private
FMemory: Pointer;
FSize, FPosition: Longint;
protected
procedure SetPointer(Ptr: Pointer; Size: Longint);
public
function Read(var Buffer; Count: Longint): Longint; override;
function Seek(Offset: Longint; Origin: Word): Longint; override;
procedure SaveToStream(Stream: TStream);
procedure SaveToFile(const FileName: string);
property Memory: Pointer read FMemory;
end;

{ TMemoryStream }

TMemoryStream = class(TCustomMemoryStream)
private
FCapacity: Longint;
procedure SetCapacity(NewCapacity: Longint);
protected
function Realloc(var NewCapacity: Longint): Pointer; virtual;
property Capacity: Longint read FCapacity write SetCapacity;
public
destructor Destroy; override;
procedure Clear;
procedure LoadFromStream(Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SetSize(NewSize: Longint); override;
function Write(const Buffer; Count: Longint): Longint; override;
end;

implementation

const
{ TStream seek origins }

soFromBeginning = 0;
soFromCurrent = 1;
soFromEnd = 2;

resourcestring
SRangeError = 'Range check error';
SSeekNotImplemented = '%s.Seek not implemented';
SReadError = 'Stream read error';
SWriteError = 'Stream write error';
SInvalidImage = 'Invalid stream format';
SMemoryStreamError = 'Out of memory while expanding memory stream';
zzlingaaa 2008-03-19
  • 打赏
  • 举报
 回复
用ASPACK压缩下,省多少麻烦啊
无条件为你 2008-03-17
  • 打赏
  • 举报
 回复

procedure TMemoryStream.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;

procedure TMemoryStream.SetCapacity(NewCapacity: Longint);
begin
SetPointer(Realloc(NewCapacity), FSize);
FCapacity := NewCapacity;
end;

procedure TMemoryStream.SetSize(NewSize: Longint);
var
OldPosition: Longint;
begin
OldPosition := FPosition;
SetCapacity(NewSize);
FSize := NewSize;
if OldPosition > NewSize then Seek(0, soFromEnd);
end;

function TMemoryStream.Realloc(var NewCapacity: Longint): Pointer;
begin
if (NewCapacity > 0) and (NewCapacity <> FSize) then
NewCapacity := (NewCapacity + (MemoryDelta - 1)) and not (MemoryDelta - 1);
Result := Memory;
if NewCapacity <> FCapacity then
begin
if NewCapacity = 0 then
begin
{$IFDEF MSWINDOWS}
GlobalFreePtr(Memory);
{$ELSE}
FreeMem(Memory);
{$ENDIF}
Result := nil;
end else
begin
{$IFDEF MSWINDOWS}
if Capacity = 0 then
Result := GlobalAllocPtr(HeapAllocFlags, NewCapacity)
else
Result := GlobalReallocPtr(Memory, NewCapacity, HeapAllocFlags);
{$ELSE}
if Capacity = 0 then
GetMem(Result, NewCapacity)
else
ReallocMem(Result, NewCapacity);
{$ENDIF}
if Result = nil then raise EStreamError.CreateRes(@SMemoryStreamError);
end;
end;
end;

function TMemoryStream.Write(const Buffer; Count: Longint): Longint;
var
Pos: Longint;
begin
if (FPosition >= 0) and (Count >= 0) then
begin
Pos := FPosition + Count;
if Pos > 0 then
begin
if Pos > FSize then
begin
if Pos > FCapacity then
SetCapacity(Pos);
FSize := Pos;
end;
System.Move(Buffer, Pointer(Longint(FMemory) + FPosition)^, Count);
FPosition := Pos;
Result := Count;
Exit;
end;
end;
Result := 0;
end;




{ TFileStream }

constructor TFileStream.Create(const FileName: string; Mode: Word);
begin
{$IFDEF MSWINDOWS}
Create(Filename, Mode, 0);
{$ELSE}
Create(Filename, Mode, FileAccessRights);
{$ENDIF}
end;

constructor TFileStream.Create(const FileName: string; Mode: Word; Rights: Cardinal);
begin
if Mode = fmCreate then
begin
inherited Create(FileCreate(FileName, Rights));
if FHandle < 0 then
raise EFCreateError.CreateResFmt(@SFCreateError, [FileName]);
end
else
begin
inherited Create(FileOpen(FileName, Mode));
if FHandle < 0 then
raise EFOpenError.CreateResFmt(@SFOpenError, [FileName]);
end;
end;

destructor TFileStream.Destroy;
begin
if FHandle >= 0 then FileClose(FHandle);
inherited Destroy;
end;

{ THandleStream }

constructor THandleStream.Create(AHandle: Integer);
begin
inherited Create;
FHandle := AHandle;
end;

function THandleStream.Read(var Buffer; Count: Longint): Longint;
begin
Result := FileRead(FHandle, Buffer, Count);
if Result = -1 then Result := 0;
end;

function THandleStream.Write(const Buffer; Count: Longint): Longint;
begin
Result := FileWrite(FHandle, Buffer, Count);
if Result = -1 then Result := 0;
end;

function THandleStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
Result := FileSeek(FHandle, Offset, Ord(Origin));
end;

procedure THandleStream.SetSize(NewSize: Longint);
begin
SetSize(Int64(NewSize));
end;

procedure THandleStream.SetSize(const NewSize: Int64);
begin
Seek(NewSize, soBeginning);
{$IFDEF MSWINDOWS}
Win32Check(SetEndOfFile(FHandle));
{$ELSE}
if ftruncate(FHandle, Position) = -1 then
raise EStreamError(sStreamSetSize);
{$ENDIF}
end;



end.
无条件为你 2008-03-17
  • 打赏
  • 举报
 回复
{$IFDEF MSWINDOWS}
uses RTLConsts, SysConst, Types,windows;
{$ENDIF}
{$IFDEF LINUX}
uses RTLConsts, SysConst, classes;
{$ENDIF}

function TStream.GetPosition: Int64;
begin
Result := Seek(0, soCurrent);
end;

procedure TStream.SetPosition(const Pos: Int64);
begin
Seek(Pos, soBeginning);
end;

function TStream.GetSize: Int64;
var
Pos: Int64;
begin
Pos := Seek(0, soCurrent);
Result := Seek(0, soEnd);
Seek(Pos, soBeginning);
end;

procedure TStream.SetSize(NewSize: Longint);
begin
end;

procedure TStream.SetSize64(const NewSize: Int64);
begin
SetSize(NewSize);
end;

procedure TStream.SetSize(const NewSize: Int64);
begin

if (NewSize < Low(Longint)) or (NewSize > High(Longint)) then
raise ERangeError.CreateRes(@SRangeError);
SetSize(Longint(NewSize));
end;

function TStream.Seek(Offset: Longint; Origin: Word): Longint;

procedure RaiseException;
begin
raise EStreamError.CreateResFmt(@sSeekNotImplemented, [Classname]);
end;

type
TSeek64 = function (const Offset: Int64; Origin: TSeekOrigin): Int64 of object;
var
Impl: TSeek64;
Base: TSeek64;
ClassTStream: TClass;
begin

Impl := Seek;
ClassTStream := Self.ClassType;
while (ClassTStream <> nil) and (ClassTStream <> TStream) do
ClassTStream := ClassTStream.ClassParent;
if ClassTStream = nil then RaiseException;
Base := TStream(@ClassTStream).Seek;
if TMethod(Impl).Code = TMethod(Base).Code then
RaiseException;
Result := Seek(Int64(Offset), TSeekOrigin(Origin));
end;

function TStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
{ Default implementation of 64 bit seek is to deflect to existing 32 bit seek.
Descendents that override 64 bit seek must not call this default implementation. }
if (Offset < Low(Longint)) or (Offset > High(Longint)) then
raise ERangeError.CreateRes(@SRangeError);
Result := Seek(Longint(Offset), Ord(Origin));
end;

procedure TStream.ReadBuffer(var Buffer; Count: Longint);
begin
if (Count <> 0) and (Read(Buffer, Count) <> Count) then
raise EReadError.CreateRes(@SReadError);
end;

procedure TStream.WriteBuffer(const Buffer; Count: Longint);
begin
if (Count <> 0) and (Write(Buffer, Count) <> Count) then
raise EWriteError.CreateRes(@SWriteError);
end;

function TStream.CopyFrom(Source: TStream; Count: Int64): Int64;
const
MaxBufSize = $F000;
var
BufSize, N: Integer;
Buffer: PChar;
begin
if Count = 0 then
begin
Source.Position := 0;
Count := Source.Size;
end;
Result := Count;
if Count > MaxBufSize then BufSize := MaxBufSize else BufSize := Count;
GetMem(Buffer, BufSize);
try
while Count <> 0 do
begin
if Count > BufSize then N := BufSize else N := Count;
Source.ReadBuffer(Buffer^, N);
WriteBuffer(Buffer^, N);
Dec(Count, N);
end;
finally
FreeMem(Buffer, BufSize);
end;
end;

procedure TStream.WriteResourceHeader(const ResName: string; out FixupInfo: Integer);
var
HeaderSize: Integer;
Header: array[0..79] of Char;
begin
Byte((@Header[0])^) := $FF;
Word((@Header[1])^) := 10;
HeaderSize := StrLen(StrUpper(StrPLCopy(@Header[3], ResName, 63))) + 10;
Word((@Header[HeaderSize - 6])^) := $1030;
Longint((@Header[HeaderSize - 4])^) := 0;
WriteBuffer(Header, HeaderSize);
FixupInfo := Position;
end;

procedure TStream.FixupResourceHeader(FixupInfo: Integer);
var
ImageSize: Integer;
begin
ImageSize := Position - FixupInfo;
Position := FixupInfo - 4;
WriteBuffer(ImageSize, SizeOf(Longint));
Position := FixupInfo + ImageSize;
end;

procedure TStream.ReadResHeader;
var
ReadCount: Cardinal;
Header: array[0..79] of Char;
begin
FillChar(Header, SizeOf(Header), 0);
ReadCount := Read(Header, SizeOf(Header) - 1);
if (Byte((@Header[0])^) = $FF) and (Word((@Header[1])^) = 10) then
Seek(StrLen(Header + 3) + 10 - ReadCount, 1)
else
raise EInvalidImage.CreateRes(@SInvalidImage);
end;

{ TCustomMemoryStream }

procedure TCustomMemoryStream.SetPointer(Ptr: Pointer; Size: Longint);
begin
FMemory := Ptr;
FSize := Size;
end;

function TCustomMemoryStream.Read(var Buffer; Count: Longint): Longint;
begin
if (FPosition >= 0) and (Count >= 0) then
begin
Result := FSize - FPosition;
if Result > 0 then
begin
if Result > Count then Result := Count;
Move(Pointer(Longint(FMemory) + FPosition)^, Buffer, Result);
Inc(FPosition, Result);
Exit;
end;
end;
Result := 0;
end;

function TCustomMemoryStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
case Origin of
soFromBeginning: FPosition := Offset;
soFromCurrent: Inc(FPosition, Offset);
soFromEnd: FPosition := FSize + Offset;
end;
Result := FPosition;
end;

procedure TCustomMemoryStream.SaveToStream(Stream: TStream);
begin
if FSize <> 0 then Stream.WriteBuffer(FMemory^, FSize);
end;

procedure TCustomMemoryStream.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;

{ TMemoryStream }

const
MemoryDelta = $2000; { Must be a power of 2 }

destructor TMemoryStream.Destroy;
begin
Clear;
inherited Destroy;
end;

procedure TMemoryStream.Clear;
begin
SetCapacity(0);
FSize := 0;
FPosition := 0;
end;

procedure TMemoryStream.LoadFromStream(Stream: TStream);
var
Count: Longint;
begin
Stream.Position := 0;
Count := Stream.Size;
SetSize(Count);
if Count <> 0 then Stream.ReadBuffer(FMemory^, Count);
end;
无条件为你 2008-03-17
  • 打赏
  • 举报
 回复
有人已经帮我剔出来了，包含下面的这个myStream.pas单元比直接包含Classes.pas要小40K，差不多小一半。不过我希望最好能使程序在20K以内，不知道有没有办法实现？

myStream.pas内容如下，希望能得到高人的进一步剔除：


unit myStream;

interface
uses SysUtils;

const

{ Maximum TList size }

MaxListSize = Maxint div 16;

{ TStream seek origins }

soFromBeginning = 0;
soFromCurrent = 1;
soFromEnd = 2;

const
{ TFileStream create mode }

fmCreate = $FFFF;

{ TParser special tokens }

toEOF = Char(0);
toSymbol = Char(1);
toString = Char(2);
toInteger = Char(3);
toFloat = Char(4);
toWString = Char(5);

{!! Moved here from menus.pas !!}
{ TShortCut special values }

scShift = $2000;
scCtrl = $4000;
scAlt = $8000;
scNone = 0;

type
EStreamError = class(Exception);
EFCreateError = class(EStreamError);
EFOpenError = class(EStreamError);
EFilerError = class(EStreamError);
EReadError = class(EFilerError);
EWriteError = class(EFilerError);
EClassNotFound = class(EFilerError);
EMethodNotFound = class(EFilerError);
EInvalidImage = class(EFilerError);
EResNotFound = class(Exception);
EListError = class(Exception);
EBitsError = class(Exception);
EStringListError = class(Exception);
EComponentError = class(Exception);
EParserError = class(Exception);
EOutOfResources = class(EOutOfMemory);
EInvalidOperation = class(Exception);
{ TStream seek origins }
TSeekOrigin = (soBeginning, soCurrent, soEnd);
TStream = class(TObject)
private
function GetPosition: Int64;
procedure SetPosition(const Pos: Int64);
function GetSize: Int64;
procedure SetSize64(const NewSize: Int64);
protected
procedure SetSize(NewSize: Longint); overload; virtual;
procedure SetSize(const NewSize: Int64); overload; virtual;
public
function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
function Seek(Offset: Longint; Origin: Word): Longint; overload; virtual;
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; virtual;
procedure ReadBuffer(var Buffer; Count: Longint);
procedure WriteBuffer(const Buffer; Count: Longint);
function CopyFrom(Source: TStream; Count: Int64): Int64;
//function ReadComponent(Instance: TComponent): TComponent;
//function ReadComponentRes(Instance: TComponent): TComponent;
//procedure WriteComponent(Instance: TComponent);
//procedure WriteComponentRes(const ResName: string; Instance: TComponent);
//procedure WriteDescendent(Instance, Ancestor: TComponent); virtual;
//procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
procedure WriteResourceHeader(const ResName: string; out FixupInfo: Integer);
procedure FixupResourceHeader(FixupInfo: Integer);
procedure ReadResHeader;
property Position: Int64 read GetPosition write SetPosition;
property Size: Int64 read GetSize write SetSize64;
end;

IStreamPersist = interface
['{B8CD12A3-267A-11D4-83DA-00C04F60B2DD}']
procedure LoadFromStream(Stream: TStream);
procedure SaveToStream(Stream: TStream);
end;

TCustomMemoryStream = class(TStream)
private
FMemory: Pointer;
FSize, FPosition: Longint;
protected
procedure SetPointer(Ptr: Pointer; Size: Longint);
public
function Read(var Buffer; Count: Longint): Longint; override;
function Seek(Offset: Longint; Origin: Word): Longint; override;
procedure SaveToStream(Stream: TStream);
procedure SaveToFile(const FileName: string);
property Memory: Pointer read FMemory;
end;

{ TMemoryStream }

TMemoryStream = class(TCustomMemoryStream)
private
FCapacity: Longint;
procedure SetCapacity(NewCapacity: Longint);
protected
function Realloc(var NewCapacity: Longint): Pointer; virtual;
property Capacity: Longint read FCapacity write SetCapacity;
public
destructor Destroy; override;
procedure Clear;
procedure LoadFromStream(Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SetSize(NewSize: Longint); override;
function Write(const Buffer; Count: Longint): Longint; override;
end;


{ THandleStream class }

THandleStream = class(TStream)
protected
FHandle: Integer;
procedure SetSize(NewSize: Longint); override;
procedure SetSize(const NewSize: Int64); override;
public
constructor Create(AHandle: Integer);
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
property Handle: Integer read FHandle;
end;
{ TFileStream class }

TFileStream = class(THandleStream)
public
constructor Create(const FileName: string; Mode: Word); overload;
constructor Create(const FileName: string; Mode: Word; Rights: Cardinal); overload;
destructor Destroy; override;
end;

implementation
无条件为你 2008-03-17
  • 打赏
  • 举报
 回复
14楼的朋友，你能帮我贴出来吗？我剔不出来。
散乱心绪 2008-03-17
  • 打赏
  • 举报
 回复
其实stream本身就已经挺独立了的啊，你把TStream和TMemoryStream Copy出来后试试看就知道了，直接建个Unit，然后粘贴TStream和TMemoryStream相关的代码
ERR0RC0DE 2008-03-17
  • 打赏
  • 举报
 回复
TMemoryStream就是操作一块内存的封装，很简单的吧。自己写一个，或者直接从Classes将那类Copy出来，这样简单吧。

操作内存块，我想写程序的应该要学会这点吧，有时间研究研究
huzhangyou 2008-03-17
  • 打赏
  • 举报
 回复
那么考虑大小 直接C写
肯定很好
hongqi162 2008-03-17
  • 打赏
  • 举报
 回复
新建一个unit
无条件为你 2008-03-17
  • 打赏
  • 举报
 回复
把TMemoryStream得代码粘贴出来编译，如何做？新建个空工程后如何做？能再说详细点吗？
散乱心绪 2008-03-17
  • 打赏
  • 举报
 回复
其实通过参考TMemoryStream的源码就能很容易的了解到，所谓的MemoryStream也是一个被分配了一定空间大小的Pointer
hongqi162 2008-03-17
  • 打赏
  • 举报
 回复
把TMemoryStream得代码粘贴出来编译，需要引用那个单元你就引用那个，需要补充那个声明你就补上
加载更多回复（7）
如何显示内存流中多个图片delphi
2010-04-08 14:48 什么是流？流,简单来说就是建立在面向对象基础上的一种抽象的处理数据的工具。在流中，定义了一些处理数据的基本操作，如读取数据，写入数据等，程序员是对流进行所有操作的，而不用关心流的另一头数据的真正流向。流不但可以处理文件，还可以处理动态内存、网络数据等多种数据形式。如果你对流的操作非常熟练，在程序中利用流的方便性，写起程序会大大提高效率的...
谈Delphi编程中“流”的应用
====================================================== 注：本文源代码点此下载 ====================================================== 谈delphi编程中“流”的应用 陈经韬 什么是流?流,简单来说就是建立在面向对象基础上的一种抽象的处理数据的工具。在流中,定 义了一些处理
Delphi编程中“流”的应用
什么是流？流,简单来说就是建立在面向对象基础上的一种抽象的处理数据的工具。在流中，定义了一些处理数据的基本操作，如读取数据，写入数据等，程序员是对流进行所有操作的，而不用关心流的另一头数据的真正流向。流不但可以处理文件，还可以处理动态内存、网络数据等多种数据形式。如果你对流的操作非常熟练，在程序中利用流的方便性，写起程序会大大提高效率的。下面，笔者通过四个实例:EXE文件加密器、电子贺卡、自制...
Delphi“流”实现文件加密器

数据流是面向对象程序设计语言中面向对象思想的典型体现，它彻底地取代了早期的利用函数实现输入输出的功能，克服了用函数实现输入输出功能的诸多弊端。简单来说，流就是建立在面向对象基础上的一种抽象的处理数据的工具。在流中，可定义一些处理数据的基本操作，如读取数据、写入数据等，程序员是对流进行操作，而不用关心流的另一头数据的真正流向。流不但可以处理文件，还可以处理动态内存、网络数据等多种数据形式。掌握好对流的操作在并程序中充分利用流的方便性，不仅能使在编写面向过程的程序时效率大大提高。本文以文件加密为例说
Delphi中“流”的操作
[转载]  作者不详 什么是流？流,简单来说就是建立在面向对象基础上的一种抽象的处理数据的工具。在流中，定义了一些处理数据的基本操作，如读取数据，写入数据等，程序员是对流进行所有操作的，而不用关心流的另一头数据的真正流向。流不但可以处理文件，还可以处理动态内存、网络数据等多种数据形式。如果你对流的操作非常熟练，在程序中利用流的方便性，写起程序会大大提高效率的。  下面，笔者通过四个实例:EXE文件
语言基础/算法/系统设计

16,748

社区成员

33,247

社区内容

发帖
与我相关
我的任务
社区描述
Delphi 语言基础/算法/系统设计
社区管理员
  • 语言基础/算法/系统设计社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章