客服电话
APP下载
迪恩网络APP
随时随地掌握行业动态
官方微信
扫描二维码
关注迪恩网络微信公众号
谈Delphi编程中“流”的应用
陈经韬
什么是流？流,简单来说就是建立在面向对象基础上的一种抽象的处理数据的工具。在流中，定
义了一些处理数据的基本操作，如读取数据，写入数据等，程序员是对流进行所有操作的，而不用
关心流的另一头数据的真正流向。流不但可以处理文件，还可以处理动态内存、网络数据等多种数
据形式。如果你对流的操作非常熟练，在程序中利用流的方便性，写起程序会大大提高效率的。
下面，笔者通过四个实例:EXE 文件加密器、电子贺卡、自制 OICQ 和网络屏幕传输来说明 Delphi
编程中“流”的利用。这些例子中的一些技巧曾经是很多软件的秘密而不公开的，现在大家可以无
偿的直接引用其中的代码了。
“万丈高楼平地起”，在分析实例之前，我们先来了解一下流的基本概念和函数，只有在理解了
这些基本的东西后我们才能进行下一步。请务必认真领会这些基本方法。当然，如果你对它们已经
很熟悉了，则可以跳过这一步。
一、Delphi 中流的基本概念及函数声明
在 Delphi 中，所有流对象的基类为 TStream 类，其中定义了所有流的共同属性和方法。
TStream 类中定义的属性介绍如下：
1、Size: 此属性以字节返回流中数据大小。
2、Position: 此属性控制流中存取指针的位置。
Tstream 中定义的虚方法有四个：
1、Read: 此方法实现将数据从流中读出。函数原形为：
Function Read(var Buffer;Count:Longint):Longint;virtual;abstract;
参数 Buffer 为数据读出时放置的缓冲区，Count 为需要读出的数据的字节数，该方法返回值
为实际读出的字节数，它可以小于或等于 Count 中指定的值。
2、Write: 此方法实现将数据写入流中。函数原形为：
Function Write(var Buffer;Count:Longint):Longint;virtual;abstract;
参数 Buffer 为将要写入流中的数据的缓冲区，Count 为数据的长度字节数，该方法返回值为
实际写入流中的字节数。
3、Seek: 此方法实现流中读取指针的移动。函数原形为：
Function Seek(Offset:Longint;Origint:Word):Longint;virtual;abstract;
参数 Offset 为偏移字节数,参数 Origint 指出 Offset 的实际意义，其可能的取值如下：
soFromBeginning:Offset 为移动后指针距离数据开始的位置。此时 Offset 必须大于或者等于
零。
soFromCurrent:Offset 为移动后指针与当前指针的相对位置。
soFromEnd:Offset 为移动后指针距离数据结束的位置。此时 Offset 必须小于或者等于零。该
方法返回值为移动后指针的位置。
4、Setsize: 此方法实现改变数据的大小。函数原形为：
Function Setsize(NewSize:Longint);virtual;
另外，TStream 类中还定义了几个静态方法：
1、ReadBuffer: 此方法的作用是从流中当前位置读取数据。函数原形为：
Procedure ReadBuffer(var Buffer;Count:Longint); 参数的定义跟上面的 Read 相同。
注意：当读取的数据字节数与需要读取的字节数不相同时，将产生 EReadError 异常。
2、WriteBuffer: 此方法的作用是在当前位置向流写入数据。函数原形为：Procedure
WriteBuffer(var Buffer;Count:Longint);
参数的定义跟上面的 Write 相同。
注意：当写入的数据字节数与需要写入的字节数不相同时，将产生 EWriteError 异常。
3、CopyFrom: 此方法的作用是从其它流中拷贝数据流。函数原形为：
Function CopyFrom(Source:TStream;Count:Longint):Longint;
参数 Source 为提供数据的流，Count 为拷贝的数据字节数。当 Count 大于 0 时，CopyFrom 从
Source 参数的当前位置拷贝 Count 个字节的数据；当 Count 等于 0 时，CopyFrom 设置 Source
参数的 Position 属性为 0,然后拷贝 Source 的所有数据；
TStream 还有其它派生类，其中最常用的是 TFileStream 类。使用 TFileStream 类来存取文件，
首先要建立一个实例。声明如下：
constructor Create(const Filename:string;Mode:Word);
Filename 为文件名（包括路径）,参数 Mode 为打开文件的方式，它包括文件的打开模式和共
享模式，其可能的取值和意义如下：
打开模式：
fmCreate : 用指定的文件名建立文件，如果文件已经存在则打开它。
fmOpenRead : 以只读方式打开指定文件
fmOpenWrite : 以只写方式打开指定文件
fmOpenReadWrite: 以写写方式打开指定文件
共享模式：
fmShareCompat : 共享模式与 FCBs 兼容
fmShareExclusive: 不允许别的程序以任何方式打开该文件
fmShareDenyWrite: 不允许别的程序以写方式打开该文件
fmShareDenyRead : 不允许别的程序以读方式打开该文件
fmShareDenyNone : 别的程序可以以任何方式打开该文件
TStream 还有一个派生类 TMemoryStream ，实际应用中用的次数也非常频繁。它叫内存流，就
是说在内存中建立一个流对象。它的基本方法和函数跟上面是一样的。好了，有了上面的基础后，
我们就可以开始我们的编程之行了。
二、实际应用之一：利用流制作 EXE 文件加密器、捆绑、自解压文件及安装程序
我们先来说一下如何制作一个 EXE 文件加密器吧。
EXE 文件加密器的原理：建立两个文件，一个用来添加资源到另外一个 EXE 文件里面，称为添
加程序。另外一个被添加的 EXE 文件称为头文件。该程序的功能是把添加到自己里面的文件读出来。
Windows 下的 EXE 文件结构比较复杂，有的程序还有校验和，当发现自己被改变后会认为自己被病
毒感染而拒绝执行。所以我们把文件添加到自己的程序里面，这样就不会改变原来的文件结构了。
我们先写一个添加函数，该函数的功能是把一个文件当作一个流添加到另外一个文件的尾部。函数
如下：
Function Cjt_AddtoFile(SourceFile,TargetFile:string):Boolean;
var Target,Source:TFileStream;
MyFileSize:integer;
begin
try
Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareExclusive);
Target:=TFileStream.Create(TargetFile,fmOpenWrite or fmShareExclusive);
Try
Target.Seek(0,soFromEnd);//往尾部添加资源
Target.CopyFrom(Source,0);
MyFileSize:=Source.Size+Sizeof(MyFileSize);
//计算资源大小，并写入辅程尾部
Target.WriteBuffer(MyFileSize,sizeof(MyFileSize));
finally
Target.Free;
Source.Free;
end;
except
Result:=False;
Exit;
end;
Result:=True;
end;
有了上面的基础，我们应该很容易看得懂这个函数。其中参数 SourceFile 是要添加的文件,参
数 TargetFile 是被添加到的目标文件。 比如说把 a.exe 添加到 b.exe 里面可以：
Cjt_AddtoFile('a.exe',b.exe');如果添加成功就返回 True 否则返回假。根据上面的函数我们可
以写出相反的读出函数：
Function Cjt_LoadFromFile(SourceFile,TargetFile :string):Boolean;
var Source:TFileStream;
Target:TMemoryStream;
MyFileSize:integer;
begin
try
Target:=TMemoryStream.Create;
Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);
try
Source.Seek(sizeof(MyFileSize),soFromEnd);
Source.ReadBuffer(MyFileSize,sizeof(MyFileSize)); //读出资源大小
Source.Seek(MyFileSize,soFromEnd);//定位到资源位置
Target.CopyFrom(Source,MyFileSize-sizeof(MyFileSize));//取出资源
Target.SaveToFile(TargetFile);//存放到文件
finally
Target.Free;
Source.Free;
end;
except
Result:=false;
Exit;
end;
Result:=true;
end;
其中参数 SourceFile 是已经添加了文件的文件名称,参数 TargetFile 是取出文件后保存的目
标文件名。比如说 Cjt_LoadFromFile('b.exe','a.txt');在 b.exe 中取出文件保存为 a.txt 。如
果取出成功就返回 True 否则返回假。打开 Delphi ，新建一个工程，在窗口上放上一个 Edit 控件
Edit1 和两个 Button:Button1 和 Button2 。Button 的 Caption 属性分别设置为“确定”和“取
消”。
在 Button1 的 Click 事件中写代码:
var S:string;
begin
S:=ChangeFileExt(Application.ExeName,'.Cjt');
if Edit1.Text='790617' then
begin
Cjt_LoadFromFile(Application.ExeName,S);
{取出文件保存在当前路径下并命名"原文件.Cjt"}
Winexec(pchar(S),SW_Show);{ 运行"原文件.Cjt"}
Application.Terminate;{ 退出程序}
end
else
Application.MessageBox(' 密码不对,请重新输入！',
' 密码错误',MB_ICONERROR+MB_OK);
end;
编译这个程序，并把 EXE 文件改名为 head.exe 。新建一个文本文件 head.rc, 内容为:head
exefile head.exe, 然后把它们拷贝到 Delphi 的 BIN 目录下，执行 Dos 命令 Brcc32.exe head.rc,
将产生一个 head.res 的文件，这个文件就是我们要的资源文件，先留着。
我们的头文件已经建立了，下面我们来建立添加程序。
新建一个工程，放上以下控件：一个 Edit, 一个 Opendialog, 两个 Button1 的 Caption 属性
分别设置为"选择文件"和"加密"。在源程序中添加一句:{$R head.res} 并把 head.res 文件拷贝到
程序当前目录下。这样一来就把刚才的 head.exe 跟程序一起编译了。
在 Button1 的 Cilck 事 件 里 面 写 下 代 码 ： if OpenDialog1.Execute then
Edit1.Text:=OpenDialog1.FileName;
在 Button2 的 Cilck 事件里面写下代码：
Function ExtractRes(ResType, ResName, ResNewName : String):boolean;
var
Res : TResourceStream;
begin
try
Res :=TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
try
Res.SavetoFile(ResNewName);
Result:=true;
finally
Res.Free;
end;
except
Result:=false;
end;
end;
//其中 ExtractRes 为自定义函数，它的作用是把 head.exe 从资源文件中取出来。
procedure TForm1.Button2Click(Sender: TObject);
var
S:String;
begin
S:=ExtractFilePath(Edit1.Text);
if ExtractRes('exefile','head',S+'head.exe')then
if Cjt_AddtoFile(Edit1.Text,S+'head.exe')then
if DeleteFile(Edit1.Text)then
if RenameFile(S+'head.exe',Edit1.Text)then
Application.MessageBox(' 文件加密成功!'
,' 信息',MB_ICONINFORMATION+MB_OK)
else
begin
if FileExists(S+'head.exe')then
DeleteFile(S+'head.exe');
Application.MessageBox(' 文件加密失败!'
,' 信息',MB_ICONINFORMATION+MB_OK);
end;
end;
注意：我们上面的函数只不过是简单的把一个文件添加到另一个文件的尾部。实际应用中可以
改成可以添加多个文件，只要根据实际大小和个数定义好偏移地址就可以了。比如说文件捆绑机就
是把两个或者多个程序添加到一个头文件里面。那些自解压程序和安装程序的原理也是一样的，不
过多了压缩而已。比如说我们可以引用一个 LAH 单元，把流压缩后再添加，这样文件就会变的很小。
读出来时先解压就可以了。另外，文中 EXE 加密器的例子还有很多不完善的地方，比如说密码固定
为"790617" ，取出 EXE 运行后应该等它运行完毕后删除等等，读者可以自行修改。
三、实际应用之二：利用流制作可执行电子贺卡
我们经常看到一些电子贺卡之类的制作软件，可以让你自己选择图片，然后它会生成一个 EXE 可
执行文件给你。打开贺卡时就会一边放音乐一边显示出图片来。现在学了流操作之后， 我们也可以
做一个了。
添加图片过程我们可以直接用前面的 Cjt_AddtoFile ，而现在要做的是如何把图像读出并显示。
我们用前面的 Cjt_LoadFromFile 先把图片读出来保存为文件再调入也是可以的，但是还有更简单
的方法，就是直接把文件流读出来显示，有了流这个利器，一切都变的简单了。
现在的图片比较流行的是 BMP 格式和 JPG 格式。我们现在就针对这两种图片写出读取并显示函
数。
Function Cjt_BmpLoad(ImgBmp:TImage;SourceFile:String):Boolean;
var
Source:TFileStream;
MyFileSize:integer;
begin
Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);
try
try
Source.Seek(sizeof(MyFileSize),soFromEnd);
Source.ReadBuffer(MyFileSize,sizeof(MyFileSize));
//读出资源
Source.Seek(MyFileSize,soFromEnd);
//定位到资源开始位置
ImgBmp.Picture.Bitmap.LoadFromStream(Source);
finally
Source.Free;
end;
except
Result:=False;
Exit;
end;
Result:=True;
end;
上面是读出 BMP 图片的，下面的是读出 JPG 图片的函数，因为要用到 JPG 单元，所以要在程
序中添加一句:usesjpeg 。
Function Cjt_JpgLoad(JpgImg:Timage;SourceFile:String):Boolean;
var
Source:TFileStream;
MyFileSize:integer;
Myjpg: TJpegImage;
begin
try
Myjpg:=TJpegImage.Create;
Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);
try
Source.Seek(sizeof(MyFileSize),soFromEnd);
Source.ReadBuffer(MyFileSize,sizeof(MyFileSize));
Source.Seek(MyFileSize,soFromEnd);
Myjpg.LoadFromStream(Source);
JpgImg.Picture.Bitmap.Assign(Myjpg);
finally
Source.Free;
Myjpg.free;
end;
except
Result:=false;
Exit;
end;
Result:=true;
end;
有了这两个函数，我们就可以制作读出程序了。下面我们以 BMP 图片为例：运行 Delphi ，新
建一个工程，放上一个显示图像控件 Image1 。在窗口的 Create 事件中写上一句就可以了：
Cjt_BmpLoad(Image1,Application.ExeName); 这个就是头文件了，然后我们用前面的方法生成
一个 head.res 资源文件。下面就可以开始制作我们的添加程序了。全部代码如下：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ExtDlgs;
type
TForm1=class(TForm)
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
OpenPictureDialog1: TOpenPictureDialog;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
Function ExtractRes(ResType, ResName, ResNewName : String):boolean;
Function Cjt_AddtoFile(SourceFile,TargetFile:string):Boolean;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
Function TForm1.ExtractRes(ResType, ResName, ResNewName : String):boolean;
var
Res : TResourceStream;
begin
try
Res :=TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
try
Res.SavetoFile(ResNewName);
Result:=true;
finally
Res.Free;
end;
except
Result:=false;
end;
end;
Function TForm1.Cjt_AddtoFile(SourceFile,TargetFile:string):Boolean;
var
Target,Source:TFileStream;
MyFileSize:integer;
begin
try
Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareExclusive);
Target:=TFileStream.Create(TargetFile,fmOpenWrite or fmShareExclusive);
try
Target.Seek(0,soFromEnd);//往尾部添加资源
Target.CopyFrom(Source,0);
MyFileSize:=Source.Size+Sizeof(MyFileSize);
//计算资源大小，并写入辅程尾部
Target.WriteBuffer(MyFileSize,sizeof(MyFileSize));
finally
Target.Free;
Source.Free;
end;
except
Result:=False;
Exit;
end;
Result:=True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Caption:='Bmp2Exe 演示程序.作者:陈经韬';
Edit1.Text:='';
OpenPictureDialog1.DefaultExt :=GraphicExtension(TBitmap);
OpenPictureDialog
Button1.Caption:=' 选择 BMP 图片';
Button2.Caption:=' 生成 EXE';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
Edit1.Text:=OpenPictureDialog1.FileName;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
HeadTemp:String;
begin
if Not FileExists(Edit1.Text)then
begin
Application.MessageBox('BMP 图片文件不存在，请重新选择!',
' 信息',MB_ICONINFORMATION+MB_OK)
Exit;
end;
HeadTemp:=ChangeFileExt(Edit1.Text,'.exe');
if ExtractRes('exefile','head',HeadTemp)then
if Cjt_AddtoFile(Edit1.Text,HeadTemp)then
Application.MessageBox('EXE 文件生成成功!',
' 信息',MB_ICONINFORMATION+MB_OK)
else
begin
if FileExists(HeadTemp)then
DeleteFile(HeadTemp);
Application.MessageBox('EXE 文件生成失败!',
' 信息',MB_ICONINFORMATION+MB_OK)
end;
end;
end.
怎么样？很神奇吧:)把程序界面弄的漂亮点，再添加一些功能，你会发现比起那些要注册的软
件来也不会逊多少吧。
实际应用之三：利用流制作自己的 OICQ
OICQ 是深圳腾讯公司的一个网络实时通讯软件，在国内拥有大量的用户群。但 OICQ 必须连接
上互联网登陆到腾讯的服务器才能使用。所以我们可以自己写一个在局部网里面使用。
OICQ 使用的是 UDP 协议，这是一种无连接协议，即通信双方不用建立连接就可以发送信息，
所以效率比较高。Delphi 本身自带的 FastNEt 公司的 NMUDP 控件就是一个 UDP 协议的用户数据报
控件。不过要注意的是如果你使用了这个控件必须退出程序才能关闭计算机，因为 TNMXXX 控件有
BUG 。所有 nm 控件的基础 PowerSocket 用到的 ThreadTimer ，用到一个隐藏的窗口（类为
TmrWindowClass ）处理有硬伤。出问题的地方：
Psock::TThreadTimer::WndProc(var msg:TMessage)
if msg.message=WM_TIMER then
他自己处理
msg.result:=0 else msg.result:=DefWindowProc(0,....) end
问题就出在调用 DefWindowProc 时，传输的 HWND 参数居然是常数 0，这样实际上 DefWindowProc
是不能工作的，对任何输入的消息的调用均返回 0，包括 WM_QUERYENDSESSION ，所以不能退出
windows 。由于 DefWindowProc 的不正常调用，实际上除 WM_TIMER ，其他消息由 DefWindowProc 处
理都是无效的。解决的办法是在PSock.pas 在TThreadTimer.Wndproc 内Result :=DefWindowProc(0,
Msg, WPARAM, LPARAM); 改为：
Result :=DefWindowProc(FWindowHandle, Msg, WPARAM, LPARAM); 早期低版本的 OICQ 也有
这个问题，如果不关闭 OICQ 的话，关闭计算机时屏幕闪了一下又
返回了。好了，废话少说，让我们编写我们的 OICQ 吧,这个实际上是 Delphi 自带的例子而已:)
新建一个工程，在 FASTNET 面版拖一个 NMUDP 控件到窗口，然后依次放上三个 EDIT, 名字
分别为 EditIP 、EditPort 、EditMyTxt ，三个按钮 BtSend 、BtClear 、BtSave ，一个
MEMOMemoReceive ，一个 SaveDialog 和一个状态条 StatusBar1 。当用户点击 BtSend 时，建立一
个内存流对象，把要发送的文字信息写进内存流，然后 NMUDP 把流发送出去。当 NMUDP 有数据接收
时，触发它的 DataReceived 事件，我们在这里再把接收到的流转换为字符信息，然后显示出来。
注意：所有的流对象建立后使用完毕后要记得释放(Free)，其实它的释构函数应该为 Destroy ，
但如果建立流失败的话，用 Destroy 会产生异常，而用 Free 的话程序会先检查有没有成功建立了
流，如果建立了才释放，所以用 Free 比较安全。
在这个程序中我们用到了 NMUDP 控件，它有几个重要的属性。RemoteHost 表示远程电脑的 IP 或
者计算机名，LocalPort 是本地端口，主要监听有没有数据传入。而 RemotePort 是远程端口，发
送数据时通过这个端口把数据发送出去。理解这些已经可以看懂我们的程序了。
全部代码如下：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls,
ComCtrls,NMUDP;
type
TForm1=class(TForm)
NMUDP1: TNMUDP;
EditIP: TEdit;
EditPort: TEdit;
EditMyTxt: TEdit;
MemoReceive: TMemo;
BtSend: TButton;
BtClear: TButton;
BtSave: TButton;
StatusBar1: TStatusBar;
SaveDialog1: TSaveDialog;
procedure BtSendClick(Sender: TObject);
procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);
procedure NMUDP1InvalidHost(var handled: Boolean);
procedure NMUDP1DataSend(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BtClearClick(Sender: TObject);
procedure BtSaveClick(Sender: TObject);
procedure EditMyTxtKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations } end;
var Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.BtSendClick(Sender: TObject)
var
MyStream: TMemoryStream;
MySendTxt: String;
Iport,icode:integer;
Begin
Val(EditPort.Text,Iport,icode);
if icode<>0 then
begin
Application.MessageBox(' 端口必须为数字，请重新输入!',
' 信息',MB_ICONINFORMATION+MB_OK);
Exit;
end;
NMUDP1.RemoteHost :=EditIP.Text; { 远程主机}
NMUDP1.LocalPort:=Iport; { 本地端口}
NMUDP1.RemotePort :=Iport; { 远程端口}
MySendTxt :=EditMyTxt.Text;
MyStream :=TMemoryStream.Create; { 建立流}
try
MyStream.Write(MySendTxt[1], Length(EditMyTxt.Text)); { 写数据}
NMUDP1.SendStream(MyStream); { 发送流}
finally
MyStream.Free; { 释放流}
end;
end;
procedure TForm1.NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer; FromIP:
String; Port: Integer);
var
MyStream: TMemoryStream;
MyReciveTxt: String;
begin
MyStream :=TMemoryStream.Create; { 建立流}
try
NMUDP1.ReadStream(MyStream);{ 接收流}
SetLength(MyReciveTxt,NumberBytes);{NumberBytes 为接收到的字节数}
MyStream.Read(MyReciveTxt[1],NumberBytes);{ 读数据}
MemoReceive.Lines.Add(' 接收到来自主机'+FromIP+' 的信息:'+MyReciveTxt);
finally
MyStream.Free; { 释放流}
end;
end;
procedure TForm1.NMUDP1InvalidHost(var handled: Boolean);
begin
Application.MessageBox(' 对方 IP 地址不正确，请重新输入!',
' 信息',MB_ICONINFORMATION+MB_OK);
end;
procedure TForm1.NMUDP1DataSend(Sender: TObject);
begin
StatusBar1.SimpleText:=' 信息成功发出!';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
EditIP.Text:='127.0.0.1';
EditPort.Text:='8868';
BtSend.Caption:=' 发送';
BtClear.Caption:=' 清除聊天记录';
BtSave.Caption:=' 保存聊天记录';
MemoReceive.ScrollBars:=ssBoth;
MemoReceive.Clear;
EditMyTxt.Text:=' 在这里输入信息,然后点击发送.';
StatusBar1.SimplePanel:=true;
end;
procedure TForm1.BtClearClick(Sender: TObject);
begin
MemoReceive.Clear;
end;
procedure TForm1.BtSaveClick(Sender: TObject);
begin
if SaveDialog1.Execute then
MemoReceive.Lines.SaveToFile(SaveDialog1.FileName);
end;
procedure TForm1.EditMyTxtKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then
BtSend.Click;
end;
上面的程序跟 OICQ 相比当然差之甚远，因为 OICQ 利用的是 Socket5 通信方式。它上线时先
从服务器取回好友信息和在线状态，发送超时还会将信息先保存在服务器，等对方下次上线后再发
送然后把服务器的备份删除。你可以根据前面学的概念来完善这个程序，比如说再添加一个 NMUDP 控
件来管理在线状态，发送的信息先转换成 ASCII 码进行与或运行并加上一个头信息，接收方接收信
息后先判断信息头正确与否，如果正确才把信息解密显示出来，这样就提高了安全保密性。
另外，UDP 协议还有一个很大的好处就是可以广播，就是说处于一个网段的都可以接收到信息
而不必指定具体的 IP 地址。网段一般分 A、B、C 三类,
1~126.XXX.XXX.XXX(A 类网):广播地址为 XXX.255.255.255
128~191.XXX.XXX.XXX(B 类网):广播地址为 XXX.XXX.255.255
192~254.XXX.XXX.XXX(C 类网):广播地址为 XXX.XXX.XXX.255
比如说三台计算机 192.168.0.1、192.168.0.10、192.168.0.18，发送信息时只要指定 IP 地址
为 192.168.0.255 就可以实现广播了。下面给出一个转换 IP 为广播 IP 的函数，快拿去完善自己
的 OICQ 吧^^.
Function Trun_ip(S:string):string;
var
s1,s2,s3,ss,sss,Head:string;
n,m:integer;
begin
sss:=S;
n:=pos('.',s);
s1:=copy(s,1,n);
m:=length(s1);
delete(s,1,m);
Head:=copy(s1,1,(length(s1)1));
n:=pos('.',s);
s2:=copy(s,1,n);
m:=length(s2);
delete(s,1,m);
n:=pos('.',s);
s3:=copy(s,1,n);
m:=length(s3);
delete(s,1,m);
ss:=sss;
if strtoint(Head) in[1..126] then
ss:=s1+'255.255.255';//1~126.255.255.255(A 类网)
if strtoint(Head) in[128..191] then
ss:=s1+s2+'255.255';//128~191.XXX.255.255(B 类网)
if strtoint(Head) in[192..254] then
ss:=s1+s2+s3+'255';//192~254.XXX.XXX.255(C 类网)
Result:=ss;
end;
五、实际应用之四：利用流实现网络传输屏幕图像
大家应该见过很多网管程序，这类程序其中有一个功能就是监控远程电脑的屏幕。实际上，这
也是利用流操作来实现的。下面我们给出一个例子，这个例子分两个程序，一个服务端，一个是客
户端。程序编译后可以直接在单机、局部网或者互联网上使用。程序中已经给出相应注释。后面我
们再来作具体分析。
新建一个工程，在 Internet 面版上拖一个 ServerSocket 控件到窗口，该控件主要用于监听客
户端，用来与客户端建立连接和通讯。设置好监听端口后调用方法 Open 或者 Active:=True 即开始
工作。注意：跟前面的 NMUDP 不同，当 Socket 开始监听后就不能再改变它的端口，要改变的话必
须先调用 Close 或设置 Active 为 False ，否则将会产生异常。另外，如果该端口已经打开的话，
就不能再用这个端口了。所以程序运行尚未退出就不能再运行这个程序，否则也会产生异常，即弹
出出错窗口。实际应用中可以通过判断程序是否已经运行，如果已经运行就退出的方法来避免出错。
当客户端有数据传入，将触发 ServerSocket1ClientRead 事件，我们可以在这里对接收的数据
进行处理。在本程序中，主要是接收客户端发送过来的字符信息并根据事先的约定来进行相应操作。
程序全部代码如下：
unit Unit1;{ 服务端程序}
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
JPEG,ExtCtrls, ScktComp;
type
TForm1=class(TForm)
ServerSocket1: TServerSocket;
procedure ServerSocket1ClientRead(Sender: TObject;Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
procedure Cjt_GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
{自定义抓屏函数,DrawCur 表示抓鼠标图像与否}
{ Private declarations }
public { Public declarations }
end;
var Form1: TForm1;
MyStream: TMemorystream;{ 内存流对象}
implementation {$R *.DFM}
procedure TForm1.Cjt_GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
var
Cursorx, Cursory: integer;
dc: hdc;
Mycan: Tcanvas;
R: TRect;
DrawPos: TPoint;
MyCursor: TIcon;
hld: hwnd;
Threadld: dword;
mp: tpoint;
pIconInfo: TIconInfo;
begin
Mybmp :=Tbitmap.Create; { 建立 BMPMAP }
Mycan :=TCanvas.Create; { 屏幕截取}
dc :=GetWindowDC(0);
try
Mycan.Handle :=dc;
R :=Rect(0, 0, screen.Width, screen.Height);
Mybmp.Width :=R.Right;
Mybmp.Height :=R.Bottom;
Mybmp.Canvas.CopyRect(R, Mycan, R);
finally
releaseDC(0, DC);
end;
Mycan.Handle :=0; Mycan.Free;
if DrawCur then { 画上鼠标图象}
begin
GetCursorPos(DrawPos);
MyCursor :=TIcon.Create; getcursorpos(mp);
hld :=WindowFromPoint(mp);
Threadld :=GetWindowThreadProcessId(hld, nil);
AttachThreadInput(GetCurrentThreadId, Threadld, True);
MyCursor.Handle :=Getcursor();
AttachThreadInput(GetCurrentThreadId, threadld, False);
GetIconInfo(Mycursor.Handle, pIconInfo);
cursorx :=DrawPos.xround(pIconInfo.xHotspot);
cursory :=DrawPos.yround(pIconInfo.yHotspot);
Mybmp.Canvas.Draw(cursorx, cursory, MyCursor); { 画上鼠标}
DeleteObject(pIconInfo.hbmColor);
{GetIconInfo 使用时创建了两个 bitmap 对象. 需要手工释放这两个对象}
DeleteObject(pIconInfo.hbmMask);
{ 否则,调用他后,他会创建一个 bitmap, 多次调用会产生多个,直至资源耗尽}
Mycursor.ReleaseHandle; { 释放数组内存}
MyCursor.Free; { 释放鼠标指针}
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Port :=3000; { 端口}
ServerSocket1.Open; {Socket 开始侦听}
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ServerSocket1.Active then
ServerSocket1.Close; { 关闭 Socket}
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
S, S1: string;
MyBmp: TBitmap;
Myjpg: TJpegimage;
begin
S :=Socket.ReceiveText;
if S='cap' then { 客户端发出抓屏幕指令}
begin
try
MyStream :=TMemorystream.Create;{ 建立内存流}
MyBmp :=TBitmap.Create;
Myjpg :=TJpegimage.Create;
Cjt_GetScreen(MyBmp, True); {True 表示抓鼠标图像}
Myjpg.Assign(MyBmp); { 将 BMP 图象转成 JPG 格式,便于在互联网上传输}
Myjpg.CompressionQuality :=10;
{JPG 文件压缩百分比设置,数字越大图像越清晰,但数据也越大}
Myjpg.SaveToStream(MyStream); { 将 JPG 图象写入流中}
Myjpg.free; MyStream.Position :=0;{ 注意:必须添加此句}
s1 :=inttostr(MyStream.size);{ 流的大小}
Socket.sendtext(s1); { 发送流大小}
finally
MyBmp.free;
end;
end;
if s='ready' then { 客户端已准备好接收图象}
begin
MyStream.Position :=0;
Socket.SendStream(MyStream); { 将流发送出去}
end;
end;
end.
上面是服务端，下面我们来写客户端程序。新建一个工程，添加 Socket 控件 ClientSocket 、
图像显示控件 Image 、一个 Panel 、一个 Edit 、两个 Button 和一个状态栏控件 StatusBar1 。
注意：把 Edit1 和两个 Button 放在 Panel1 上面。ClientSocket 的属性跟 ServerSocket 差不多，
不过多了一个 Address 属性，表示要连接的服务端 IP 地址。填上 IP 地址后点“连接”将与服务
端程序建立连接，如果成功就可以进行通讯了。点击“抓屏”将发送字符给服务端。因为程序用到
了 JPEG 图像单元，所以要在 Uses 中添加 Jpeg. 全部代码如下：unit Unit2{ 客户端};
interface
uses Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,
Dialogs,StdCtrls,ScktComp,ExtCtrls,J peg, ComCtrls;
type
TForm1=class(TForm)
ClientSocket1: TClientSocket;
Image1: TImage;
StatusBar1: TStatusBar;
Panel1: TPanel;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
procedure Button2Click(Sender: TObject);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent:
TErrorEvent; var ErrorCode: Integer);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket); procedure
FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
public { Public declarations }
end;
var Form1: TForm1;
MySize: Longint;
MyStream: TMemorystream;{ 内存流对象}
implementation {$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
{下面为设置窗口控件的外观属性}
{注意:把 Button1 、Button2 和 Edit1 放在 Panel1 上面}
Edit1.Text :='127.0.0.1';
Button1.Caption :='连接主机';
Button2.Caption :='抓屏幕';
Button2.Enabled :=false;
Panel1.Align :=alTop;
Image1.Align :=alClient;
Image1.Stretch :=True;
StatusBar1.Align:=alBottom;
StatusBar1.SimplePanel :=True; {}
MyStream :=TMemorystream.Create; { 建立内存流对象}
MySize :=0; { 初始化}
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not ClientSocket1.Active then
begin
ClientSocket1.Address :=Edit1.Text; { 远程 IP 地址}
ClientSocket1.Port :=3000; {Socket 端口}
ClientSocket1.Open; { 建立连接}
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Clientsocket1.Socket.SendText('cap');
{ 发送指令通知服务端抓取屏幕图象}
Button2.Enabled :=False;
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText :='与主机'+ ClientSocket1.Address +'成功建立连接!';
Button2.Enabled :=True;
end;
procedure TForm1.ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
Errorcode :=0; { 不弹出出错窗口}
StatusBar1.SimpleText :='无法与主机'+ ClientSocket1.Address +'建立连接!';
end;
procedure TForm1.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText :='与主机'+ ClientSocket1.Address +'断开连接!';
Button2.Enabled :=False;
end;
procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
var
MyBuffer: array[0..10000] of byte; { 设置接收缓冲区}
MyReceviceLength: integer;
S: string;
MyBmp: TBitmap;
MyJpg: TJpegimage;
begin
StatusBar1.SimpleText :='正在接收数据......';
{MySize 为服务端发送的字节数，如果为 0 表示为尚未开始图象接收}
if MySize=0 then
begin
S :=Socket.ReceiveText;
MySize :=Strtoint(S); { 设置需接收的字节数}
Clientsocket1.Socket.SendText('ready'); { 发指令通知服务端开始发送图象}
end else begin { 以下为图象数据接收部分}
MyReceviceLength :=socket.ReceiveLength; { 读出包长度}
StatusBar1.SimpleText :='正在接收数据,数据大小为:'+ inttostr(MySize);
Socket.ReceiveBuf(MyBuffer, MyReceviceLength);{ 接收数据包并读入缓冲区内}
MyStream.Write(MyBuffer, MyReceviceLength); { 将数据写入流中}
if MyStream.Size >=MySize then { 如果流长度大于需接收的字节数，则接收完毕}
begin
MyStream.Position :=0;
MyBmp :=tbitmap.Create;
MyJpg :=tjpegimage.Create;
try
MyJpg.LoadFromStream(MyStream); { 将流中的数据读至 JPG 图像对象中}
MyBmp.Assign(MyJpg); { 将 JPG 转为 BMP}
StatusBar1.SimpleText :='正在显示图像';
Image1.Picture.Bitmap.Assign(MyBmp); { 分配给 image1 元件}
finally { 以下为清除工作}
MyBmp.free;
MyJpg.free;
Button2.Enabled :=true;
{ Socket.SendText('cap');添加此句即可连续抓屏}
MyStream.Clear; MySize :=0;
end;
end;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
MyStream.Free; { 释放内存流对象}
if ClientSocket1.Active then
ClientSocket1.Close; { 关闭 Socket 连接}
end;
程序原理：运行服务端开始侦听，再运行客户端，输入服务端 IP 地址建立连接，然后发一个
字符通知服务端抓屏幕。服务端调用自定义函数 Cjt_GetScreen 抓取屏幕存为 BMP ，把 BMP 转换
成 JPG ，把 JPG 写入内存流中，然后把流发送给客户端。客户端接收到流后做相反操作，将流转换
为 JPG 再转换为 BMP 然后显示出来。
注意：因为 Socket 的限制，不能一次发送过大的数据，只能分几次发。所以程序中服务端抓
屏转换为流后先发送流的大小，通知客户端这个流共有多大，客户端根据这个数字大小来判断是否
已经接收完流，如果接收完才转换并显示。
这个程序跟前面的自制 OICQ 都是利用了内存流对象 TMemoryStream 。其实，这个流对象是程
序设计中用得最普遍的，它可以提高 I/O 的读写能力，而且如果你要同时操作几个不同类型的流，
互相交换数据的话，用它作“中间人”是最好不过的了。比如说你把一个流压缩或者解压缩，就先
建立一个 TMemoryStream 对象，然后把别的数据拷贝进去，再执行相应操作就可以了。因为它是直
接在内存中工作，所以效率是非常高的。有时侯甚至你感觉不到有任何的延迟。
程序有待改进的地方：
当然可以加一个压缩单元，发送前先压缩再发送。注意：这里也是有技巧的，就是直接把 BMP 压
缩而不要转换成 JPG 再压。实验证明：上面程序一幅图像大小大概为 4050KB ，如果用 LAH 压缩算
法处理一下便只有 812KB ，这样传输起来就比较快。如果想更快的话，可以采用这样的方法：先抓
第一幅图像发送，然后从第二幅开始只发跟前一幅不同区域的图像。外国有一个程序叫 Remote
Administrator ，就是采用这样的方法。他们测试的数据如下：局部网一秒钟 100500 幅，互联网
上，在网速极低的情况下，一秒钟传输 510 幅。说这些题外话只想说明一个道理：想问题，特别是
写程序，特别是看起来很复杂的程序，千万不要钻牛角尖，有时侯不妨换个角度来想。程序是死的，
人才是活的。当然，这些只能靠经验的积累。但是一开始就养成好习惯是终身受益的！
Delphi_ 流操作的语法
Delphi 在这两方面都做的相当出色。在 Delphi 的早期版本 Turbo Pascal 中就曾有流(Stream)、
群(Collection) 和资源(Resource)等专门用于对象式数据管理的类。在 Delphi 中，这些功能得到
了大大的加强。Delphi 将对象式数据管理类归结为 Stream 对象(Stream)和 Filer 对象(Filer)， 并
将它们应用于可视部件类库（VCL） 的方方面面。它们不仅提供了在内存、外存和 Windows 资源中
管理对象的功能，还提供了在数据库 BLOB 字段中对象的功能。
在本章中将介绍 Stream 对象和 Filer 对象的实现原理、应用方法以及在超媒体系统中的应用。
这对于运用 Delphi 开发高级应用是很重要的。
20.1 流式对象的实现原理和应用
Stream 对象， 又称流式对象， 是 TStream 、THandleStream 、TFileStream 、TMemoryStream 、
TResourceStream 和 TBlobStream 等的统称。它们分别代表了在各种媒介上存储数据的能力， 它
们将各种数据类型(包括对象和部件) 在内存、外存和数据库字段中的管理操作抽象为对象方法，并
且充分利用了面向对象技术的优点，应用程序可以相当容易地在各种 Stream 对象中拷贝数据。
下面介绍各种对象的数据和方法及使用方法。
20.1.1 TStream 对象
TStream 对象是能在各种媒介中存储二进制数据的对象的抽象对象。从 TStream 对象继承的对
象用于在内存、Windows 资源文件、磁盘文件和数据库字段等媒介中存储数据。
TStream 中定义了两个属性：Size 和 Position 。它们分别以字节为单位表示的流的大小和当
前指针位置。TStream 中定义的方法用于在各种流中读、写和相互拷贝二进制数据。因为所有的
Stream 对象都是从 TStream 中继承来的，所以在 TStream 中定义的域和方法都能被 Stream 对象
调用和访问。此外，又由于面向对象技术的动态联编功能，TStream 为各种流的应用提供了统一的
接口，简化了流的使用；不同 Stream 对象是抽象了对不同存储媒介的数据上的操作，因此，TStream
的需方法为在不同媒介间的数据拷贝提供了最简捷的手段。
20.1.1.1 TStream 的属性和方法
1. Position 属性
声明：property Position: Longint;
Position 属性指明流中读写的当前偏移量。
2. Size 属性
声明：property Size: Longint; Size 属性指明了以字节为单位的流的的大小，它是只读的。
3. CopyFrom 方法
声明：function CopyFrom(Source: TStream; Count: Longint): Longint;
CopyFrom 从 Source 所指定的流中拷贝 Count 个字节到当前流中， 并将指针从当前位置移动
Count 个字节数，函数返回值是实际拷贝的字节数。
4. Read 方法
声明：function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
Read 方法从当前流中的当前位置起将 Count 个字节的内容复制到 Buffer 中，并把当前指针向
后移动 Count 个字节数， 函数返回值是实际读的字节数。如果返回值小于 Count， 这意味着读操
作在读满所需字节数前指针已经到达了流的尾部。
Read 方法是抽象方法。每个后继 Stream 对象都要根据自己特有的有关特定存储媒介的读操作
覆盖该方法。而且流的所有其它的读数据的方法（ 如：ReadBuffer，ReadComponent 等） 在完成
实际的读操作时都调用了 Read 方法。面向对象的动态联编的优点就体现在这儿。因为后继 Stream 对
象只需覆盖 Read 方法，而其它读操作(如 ReadBuffer 、ReadComponent 等)都不需要重新定义，而
且 TStream 还提供了统一的接口。
5. ReadBuffer 方法
声明：procedure ReadBuffer(var Buffer; Count: Longint); ReadBuffer 方法从流中将 Count
个字节复制到 Buffer 中， 并将流的当前指针向后移动
Count 个字节。如读操作超过流的尾部，ReadBuffer 方法引起EReadError 异常事件。
6. ReadComponent 方法
声明：function ReadComponent(Instance: TComponent): TComponent;
ReadComponent 方法从当前流中读取由 Instance 所指定的部件， 函数返回所读的部件。
ReadComponent 在读 Instance 及其拥有的所有对象时创建了一个 Reader 对象并调用它的
ReadRootComponent 方法。
如果 Instance 为 nil，ReadComponent 的方法基于流中描述的部件类型信息创建部件，并返回
新创建的部件。
7. ReadComponentRes 方法
声明：function ReadComponentRes(Instance: TComponent): TComponent;
ReadComponentRes 方法从流中读取 Instance 指定的部件， 但是流的当前位置必须是由
WriteComponentRes 方法所写入的部件的位置。
ReadComponentRes 首先调用 ReadResHeader 方法从流中读取资源头， 然后调用 ReadComponent
方法读取 Instance 。如果流的当前位置不包含一个资源头。ReadResHeader 将引发一个
EInvalidImage 异常事件。在 Classes 库单元中也包含一个名为 ReadComponentRes 的函数，该函
数执行相同的操作，只不过它基于应用程序包含的资源建立自己的流。
8. ReadResHeader 方法
声明：procedure ReadResHeader;
ReadResHeader 方法从流的当前位置读取 Windows 资源文件头，并将流的当前位置指针移到该
文件头的尾部。如果流不包含一个有效的资源文件头， ReadResHeader 将引发一个 EInvalidImage
异常事件。
流的 ReadComponentRes 方法在从资源文件中读取部件之前， 会自动调用 ReadResHeader 方法，
因此，通常程序员通常不需要自己调用它。
9. Seek 方法
声明：function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;
Seek 方法将流的当前指针移动 Offset 个字节，字节移动的起点由 Origin 指定。如果 Offset
是负数，Seek 方法将从所描述的起点往流的头部移动。下表中列出了 Origin 的不同取值和它们的
含义：
表 20.1 函数 Seek 的参数的取值
常量 值 Seek 的起点 Offset 的取值
SoFromBeginning 0 流的开头 正数
SoFromCurrent 1 流的当前位置 正数或负数
SoFromEnd 2 流的结尾 负数
10. Write 方法
在 Delphi 对象式管理的对象中有两类对象的方法都有称为 Write 的：Stream 对象和 Filer 对
象。Stream 对象的 Write 方法将数据写进流中。Filer 对象通过相关的流传递数据，在后文中会
介绍这类方法。
Stream 对象的 Write 方法声明如下：
function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
Write 方法将 Buffer 中的 Count 个字节写入流中，并将当前位置指针向流的尾部移动 Count 个
字节，函数返回写入的字节数。
TStream 的 Write 方法是抽象的，每个继承的 Stream 对象都要通过覆盖该方法来提供向特定
存储媒介(内存、磁盘文件等)写数据的特定方法。流的其它所有写数据的方法(如 WriteBuffer 、
WriteComponent)都调用 Write 担当实际的写操作。
11. WriteBuffer 方法
声明：procedure WriteBuffer(const Buffer; Count: Longint); WriteBuffer 的功能与 Write
相似。WriteBuffer 方法调用 Write 来执行实际的写操作，如果流
没能写所有字节，WriteBuffer 会触发一个 EWriteError 异常事件。
12. WriteComponent 方法
在 Stream 对象和 Filer 对象都有被称为 WriteComponent 的方法。Stream 对象的
WriteComponent 方法将 Instance 所指定的部件和它所包含的所有部件都写入流中；Writer 对象
的 WriteComponent 将指定部件的属性值写入 Writer 对象的流中。
Stream 对象的 WriteComponent 方法声明是这样的：
procedure WriteComponent(Instance: Tcomponent);
WriteComponent 创建一个 Writer 对象， 并调用 Writer 的 WriteRootComponent 方法将
Instance 及其拥有的对象写入流。
13. WriteComponentRes 方法
声 明 ： WriteComponentRes(const ResName: String; Instance: TComponent);
WriteComponentRes 方法首先往流中写入标准 Windows 资源文件头，然后将 Instance 指定
的部件写入流中。要读由 WriteComponentRes 写入的部件，必须调用 ReadComponentRes 方法。
WriteComponentRes 使用 ResName 传入的字符串作为资源文件头的资源名， 然后调用
WriteComponent 方法将 Instance 和它拥有的部件写入流。
14. WriteDescendant 方法
声明：procedure WriteDescendant(Instance Ancestor: TComponent);
Stream 对象的 WriteDescendant 方法创建一个 Writer 对象， 然后调入该对象的
WriteDescendant 方法将 Instance 部件写入流中。Instance 可以是从 Ancestor 部件继承的窗体，
也可以是在从祖先窗体中继承的窗体中相应于祖先窗体中 Ancestor 部件的部件。
15. WriteDescendantRes 方法
声 明 ： procedure WriteDescendantRes(const ResName: String; Instance, Ancestor:
TComponent);
WriteDescendantRes 方法将 Windows 资源文件头写入流，并使用 ResName 作用资源名，然后
调用 WriteDescendant 方法，将 Instance 写入流。
20.1.1.2 TStream 的实现原理
TStream 对象是 Stream 对象的基础类，这是 Stream 对象的基础。为了能在不同媒介上的存储
数据对象， 后继的 Stream 对象主要是在 Read 和 Write 方法上做了改进， 。因此， 了解 TStream
是掌握 Stream 对象管理的核心。Borland 公司虽然提供了 Stream 对象的接口说明文档， 但对于
其实现和应用方法却没有提及， 笔者是从 Borland Delphi 2.0 Client/Server Suite 提供的源代
码和部分例子程序中掌握了流式对象技术。
下面就从 TStream 的属性和方法的实现开始。
1. TStream 属性的实现
前面介绍过，TStream 具有 Position 和 Size 两个属性， 作为抽象数据类型， 它抽象了在各
种存储媒介中读写数据所需要经常访问的域。那么它们是怎样实现的呢？
在自定义部件编写这一章中介绍过部件属性定义中的读写控制。Position 和 Size 也作了读写
控制。定义如下：
property Position: Longint read GetPosition write SetPosition;
property Size: Longint read GetSize;
由上可知，Position 是可读写属性，而 Size 是只读的。
Position 属性的实现就体现在 GetPosition 和 SetPosition 。当在程序运行过程中，任何读
取 Position 的值和给 Position 赋值的操作都会自动触发私有方法 GetPosition 和 SetPosition 。
两个方法的声明如下：
function TStream.GetPosition: Longint;
begin
Result :=Seek(0, 1);
end;
procedure TStream.SetPosition(Pos: Longint);
begin
Seek(Pos, 0);
end;
在设置位置时，Delphi 编译机制会自动将Position 传为 Pos 。前面介绍过 Seek 的使用方法，
第一参数是移动偏移量， 第二个参数是移动的起点， 返回值是移动后的指针位置。Size 属性的实
现只有读控制，完全屏蔽了写操作。读控制方法 GetSize 实现如下：
function TStream.GetSize: Longint;
var Pos: Longint;
begin
Pos :=Seek(0, 1);
Result :=Seek(0, 2);
Seek(Pos, 0);
end;
2. TStream 方法的实现
⑴ CopyFrom 方法 CopyFrom 是 Stream 对象中很有用的方法，它用于在不同存储媒介中拷贝数
据。例如，内存与外部文件之间、内存与数据库字段之间等。它简化了许多内存分配、文件打开和
读写等的细节，将所有拷贝操作都统一到 Stream 对象上。
前面曾介绍：CopyFrom 方法带 Source 和 Count 两个参数并返回长整型。该方法将 Count 个字
节的内容从 Source 拷贝到当前流中，如果 Count 值为 0 则拷贝所有数据。
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;
ReadResHeader 在资源文件中的读取部件时调用， 通常程序员不需自己调用。如果读取的不是
资源文件，ReadResHeader将触发异常事件。
procedure TStream.ReadResHeader;
var ReadCount: Longint;
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) + 10ReadCount, 1)
else
raise EInvalidImage.CreateRes(SInvalidImage);
end;
ReadComponentRes 在 Windows 资源文件中读取部件， 为了判断是否是资源文件， 它首先调
用 ReadResHeader 方法，然后调用 ReadComponent 方法读取 Instance 指定的部件。下面是它的实
现：
function TStream.ReadComponentRes(Instance: TComponent): TComponent;
begin
ReadResHeader;
Result :=ReadComponent(Instance);
end;
与 ReadComponentRes 相应的写方法是 WriteComponentRes，Delphi 调用这两个方法读写窗体
文件(DFM 文件)，在后面书中会举用这两个方法读取 DFM 文件的例子。
⑷ WriteComponent 和 WriteDescendant 方法
Stream 对象的WriteDescendant 方法在实现过程中，创建了 TWriter 对象，然后利用 TWriter
的 WriteDescendant 方法将 Instance 写入流。而 WriteComponent 方法只是简单地调用
WriteDescendant 方法将 Instance 写入流。它们的实现如下：
procedure TStream.WriteComponent(Instance: TComponent);
begin
WriteDescendent(Instance, nil);
end;
procedure TStream.WriteDescendent(Instance, Ancestor: TComponent);
var Writer: TWriter;
begin
Writer :=TWriter.Create(Self, 4096);
try
Writer.WriteDescendent(Instance, Ancestor);
finally
Writer.Free;
end;
end;
⑸ WriteDescendantRes 和 WriteComponentRes 方法
WriteDescendantRes 方法用于将部件写入 Windows 资源文件；而 WriteComponentRes 方法只
是简单地调用 WriteDescendantRes 方法，它们的实现如下：
procedure TStream.WriteComponentRes(const ResName: string; Instance: TComponent);
begin
WriteDescendentRes(ResName, Instance, nil);
end;
procedure TStream.WriteDescendentRes(const ResName: string; Instance, Ancestor:
TComponent);
var
HeaderSize: Integer;
Origin, ImageSize: Longint;
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[HeaderSize6])^):=$1030;
Longint((@Header[HeaderSize4])^):=0;
WriteBuffer(Header, HeaderSize);
Origin :=Position;
WriteDescendent(Instance, Ancestor);
ImageSize :=PositionOrigin;
Position :=Origin4;
WriteBuffer(ImageSize, SizeOf(Longint));
Position :=Origin + ImageSize;
end;
WriteCompnentRes 是与 ReadComponentRes 相应的对象写方法，这两个方法相互配合可读取
Delphi 的 DFM 文件，从而利用 Delphi 系统的功能。
20.1.2 THandleStream 对象
THandleStream 对象的行为特别象 FileStream 对象，所不同的是它通过已创建的文件句柄而
不是文件名来存储流中的数据。
THandleStream 对象定义了 Handle 属性， 该属性提供了对文件句柄的只读访问， 并且 Handle
属性可以作为 Delphi 的 RTL 文件管理函数的参数， 利用文件类函数来读写数据。THandleStream 覆
盖了构造函数 Create ，该函数带有 Handle 参数，该参数指定与 THandleStream 对象相关的文件
句柄。
20.1.2.1 THandleStream 的属性和方法：
1. Handle 属性
声明：property Handle: Integer;
Handle 属性提供了对文件句柄的只读访问，该句柄由 THandleStream 的构造方法 Create 传入。
因此除了用 THandleStream 提供的方法外，也可以用文件管理函数对句柄进行操作。实际上，
THandleStream 的方法在实现上也是运用文件管理函数进行实际的读写操作。
2. Create 方法
声明：constructor Create(AHandle: Integer); Create 方法使用传入的 Handle 参数创建一
个与特定文件句柄相联的 THandleStream 对象，
并且将 AHandle 赋给流的 Handle 属性。
3. Read 、Write 和 Seek 方法
这三个方法是 TStream 的虚方法，只是在 THandleStream 中覆盖了这三个方法，以实现特定媒
介── 文件的数据存取。后面会详细介绍这三个方法的实现。
20.1.2.2 THandleStream 的实现原理
THandleStream 是从 TStream 继承来的， 因此可以共用 TStream 中的属性和大多数方法。
THandleStream 在实现上主要是增加了一个属性Handle 和覆盖了 Create 、Read 、Write 和 Seek
四个方法。
1. 属性的实现
Handle 属性的实现正如 Delphi 大多数属性的实现那样，先在对象定义的 private 部分声明一
个存放数据的变量 FHandle ，然后在定义的 public 部分声明属性 Handle ，其中属性定义的读写
控制部分加上只读控制，读控制只是直接读取 FHandle 变量的值，其实现如下：
THandleStream=class(TStream)
private
FHandle: Integer;
public …
property Handle: Integer read FHandle;
end;
2. 方法的实现
THandleStream 的 Create 方法， 以 AHandle 作为参数， 在方法里面只是简单的将 AHandle 的
值赋给 FHandle ，其实现如下：
constructor THandleStream.Create(AHandle: Integer);
begin
FHandle :=AHandle;
end;
为实现针对文件的数据对象存储， THandleStream 的 Read 、Write 和 Seek 方法覆盖了 TStream
中的相应方法。它们的实现都调用了 Windows 的文件管理函数。
Read 方法调用 FileRead 函数实现文件读操作，其实现如下：
function THandleStream.Read(var Buffer; Count: Longint): Longint;
begin
Result :=FileRead(FHandle, Buffer, Count);
if Result=1 then
Result :=0;
end;
Write 方法调用 FileWrite 函数实现文件写操作，其实现如下：
function THandleStream.Write(const Buffer; Count: Longint): Longint;
begin
Result :=FileWrite(FHandle, Buffer, Count);
if Result=1 then
Result :=0;
end;
Seek 方法调用 FileSeek 函数实现文件指针的移动，其实现如下：
function THandleStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
Result :=FileSeek(FHandle, Offset, Origin);
end;
20.1.3 TFileStream 对象
TFileStream 对象是在磁盘文件上存储数据的 Stream 对象。TFileStream 是从 THandleStream
继承下来的，它和 THandleStream 一样都是实现文件的存取操作。不同之处在于 THandleStream 用
句柄访问文件， 而 TFileStream 用文件名访问文件。实际上 TFileStream 是 THandleStream 上的
一层包装，其内核是 THandleStream 的属性和方法。
TFileStream 中没有增加新的属性和方法。它只是覆盖了的构造方法 Create 和析构方法
Destory 。在 Create 方法中带两个参数 FileName 和 Mode 。FileName 描述要创建或打开的文件
名，而 Mode 描述文件模式如 fmCreate 、fmOpenRead 和 fmOpenWrite 等。Create 方法首先使用
FileCreate 或 FileOpen 函数创建或打开名为 FileName 的文件， 再将得到的文件句柄赋给
FHandle 。TFileStream 的文件读写操作都是由从 THandleStream 继承的 Read
var Stream: TStream;
begin
Stream :=TFileStream.Create(FileName, fmCreate);
try SaveToStream(Stream); finally Stream.Free; end;
end;
在 Delphi 的许多对象的 SaveToStream 和SaveToFile 、Lo |
2023-10-27
2022-08-15
2022-08-17
2022-09-23
2022-08-13
六六分期app的软件客服如何联系？不知道吗？加qq群【895510560】即可！标题：六六分期
今天小编告诉大家如何处理win10系统火狐flash插件总是崩溃的问题，可能很多用户都不知
今天小编告诉大家如何对win10系统删除桌面回收站图标进行设置，可能很多用户都不知道
今天小编告诉大家如何对win10系统电脑设置节能降温的设置方法，想必大家都遇到过需要
我们在使用xp系统的过程中,经常需要对xp系统无线网络安装向导设置进行设置，可能很多
今天小编告诉大家如何处理win7系统玩cf老是与主机连接不稳定的问题，可能很多用户都不
电脑对日常生活的重要性小编就不多说了，可是一旦碰到win7系统设置cf烟雾头的问题，很
我们在日常使用电脑的时候，有的小伙伴们可能在打开应用的时候会遇见提示应用程序无法
今天小编告诉大家如何对win7系统打开vcf文件进行设置，可能很多用户都不知道怎么对win
今天小编告诉大家如何对win10系统s4开启USB调试模式进行设置，可能很多用户都不知道怎
请发表评论