xstreams.pas

我自己用的Delphi函数单元 具体说明见打包文件的HELP目录下面

unit xStreams;

interface

uses Windows, SysUtils, Classes, Forms, TypInfo;

//------------------------------------------------------------------//
procedure SavePropertyToStream(Stream: TStream; Instance: TPersistent; PropName: string);
procedure LoadPropertyFromStream(Stream: TStream; Instance: TPersistent);

//------------------------------------------------------------------//
procedure ReadFormAsText(AExeName, AClassName: string; Strings: TStrings);
procedure WriteFormAsBinary(AExeName, AClassName: string; Strings: TStrings);

//------------------------------------------------------------------//
function VisualizeForm(Strings: TStrings): TForm;
procedure TextizeForm(AForm: TForm; Strings: TStrings);

implementation

//------------------------------------------------------------------//
//TStream.ReadComponent、TStream.WriteComponent及相关函数可读写VCL组件。

type
  TMyWriter = class(TWriter)
  public
    procedure WriteProperty(Instance: TPersistent; PropInfo: Pointer);
  end;

  TMyReader = class(TReader)
  public
    procedure ReadProperty(Instance: TPersistent);
  end;

  { TMyWriter }

procedure TMyWriter.WriteProperty(Instance: TPersistent; PropInfo: Pointer);
begin
  inherited WriteProperty(Instance, PropInfo);
end;

  { TMyReader }

procedure TMyReader.ReadProperty(Instance: TPersistent);
begin
  inherited ReadProperty(Instance);
end;

//------------------------------------------------------------------//
//根据VCL提供的组件继承机制，SavePropertyToStream、LoadPropertyFromStream
//以类似DFM文件格式记录组件属性数据，十分适合担任字体信息，节点数据或
//组件特性的管理存储方法。例：
{
var
	Stream: TStream;
begin
	Stream:= TStream.Create('TreeView.Dat', fmCreate or fmOpenWrite);
	with Stream do
	try
		SavePropertyToStream(Stream,TreeView1,'Font');
		SavePropertyToStream(Stream,TreeView1,'Nodes');
	finally
		Free;
	end;
end;		
}
//这两个函数可与任何数据流使用，不会干扰数据流中其它数据处理。


//------------------------------------------------------------------//
//将Instance对象的PropName属性写入Stream流中，此属性必须是公开属性；
procedure SavePropertyToStream(Stream: TStream; Instance: TPersistent; PropName: string);
begin
  with TMyWriter.Create(Stream, 4096) do
    try
      WriteListBegin;
      WriteProperty(Instance, GetPropInfo(Instance.ClassInfo, PropName));
      WriteListEnd;
    finally
      Free;
    end;
end;

//------------------------------------------------------------------//
//将Instance对象的PropName属性从Stream流读出，此属性必须是公开属性；
procedure LoadPropertyFromStream(Stream: TStream; Instance: TPersistent);
begin
  with TMyReader.Create(Stream, 4096) do
    try
      ReadListBegin;
      while not EndOfList do ReadProperty(Instance);
      ReadListEnd;
    finally
      Free;
    end;
end;

//------------------------------------------------------------------//
//链接VCL应用程序时，会将可能使用的DFM数据放入执行文件的RC_DATA资源区段
//资源名称为Form的类名称。ReadFormAsText由AExeName执行文件读出类名称为
//AClassName的Form，并将其文字表示写入Strings对象。
// 将 form 以 text 形式从 executable 的 resource table 读出
procedure ReadFormAsText(AExeName, AClassName: string; Strings: TStrings);
var
  hLib: THandle;        
  RS  : TResourceStream;
  ms  : TMemoryStream;  
begin
  hLib := LoadLibrary(PChar(AExeName));
  try
    RS := TResourceStream.Create(hLib, AClassName, RT_RCDATA);
    ms := TMemoryStream.Create;
    try
      ObjectBinaryToText(RS, ms);
      ms.Position := 0;
      Strings.LoadFromStream(ms);
    finally
      RS.Free;
      ms.Free;
    end;
  finally
    FreeLibrary(hLib);
  end;
end;

function CheckFormTextValidity(Strings: TStrings): Boolean;
var
  ms1, ms2: TMemoryStream;
begin
  Result := False;
  
  ms1 := TMemoryStream.Create;
  ms2 := TMemoryStream.Create;
  try
    Strings.SaveToStream(ms1);
    ms1.Position := 0;
    try
      ObjectTextToBinary(ms1, ms2);
      Result := True;
    except
    end;
  finally
    ms1.Free;
    ms2.Free;
  end;
end;

//------------------------------------------------------------------//
//WriteFormAsBinary 将 form 以 text 形式写入 executable 的 resource table
//本函数仅适用于NT系统。
procedure WriteFormAsBinary(AExeName, AClassName: string; Strings: TStrings);
var
  hLib: THandle;        
  RS  : TResourceStream;
  ms  : TMemoryStream;  
begin
  CheckFormTextValidity(Strings);
  
  hLib := LoadLibrary(PChar(AExeName));
  try
    RS := TResourceStream.Create(hLib, AClassName, RT_RCDATA);
    ms := TMemoryStream.Create;
    try
      Strings.SaveToStream(ms);
      ms.Position := 0;
      ObjectTextToBinary(ms, RS);
    finally
      RS.Free;
      ms.Free;
    end;
  finally
    FreeLibrary(hLib);
  end;
end;

//------------------------------------------------------------------//
//将Form文字表示转换为Form对象。
function VisualizeForm(Strings: TStrings): TForm;
var
  ms1, ms2: TMemoryStream;
begin
  ms1 := TMemoryStream.Create;
  ms2 := TMemoryStream.Create;
  try
    Strings.SaveToStream(ms1);
    ms1.Position := 0;
    ObjectTextToBinary(ms1, ms2);
    ms2.Position := 0;
    TComponent(Result) := ms2.ReadComponent(nil);
  finally
    ms1.Free;
    ms2.Free;
  end;
end;

//------------------------------------------------------------------//
//将Form对象转换为Form文字表示。
procedure TextizeForm(AForm: TForm; Strings: TStrings);
var
  ms1, ms2: TMemoryStream;
begin
  ms1 := TMemoryStream.Create;
  ms2 := TMemoryStream.Create;
  try
    ms1.WriteComponent(AForm);
    ms1.Position := 0;
    ObjectBinaryToText(ms1, ms2);
    ms2.Position := 0;
    Strings.LoadFromStream(ms2);
  finally
    ms1.Free;
    ms2.Free;
  end;
end;

end.