谈Delphi编程中"流"的应用
作者: 陈经韬 发表日期: 2003-9-19 9:04:13 访问次数: 1896
谈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);
编译这个程序,并把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事件里面写下代码:
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;
其中ExtractRes为自定义函数,它的作用是把head.exe从资源文件中取出来。
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;
注意:我们上面的函数只不过是简单的把一个文件添加到另一个文件的尾部。实际应用中可以改成可以添加多个文件,只要根据实际大小和个数定义好偏移地址就可以了。比如说文件捆绑机就是把两个或者多个程序添加到一个头文件里面。那些自解压程序和安装程序的原理也是一样的,不过多了压缩而已。比如说我们可以引用一个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单元,所以要在程序中添加一句:uses jpeg。
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);
OpenPictureDialog1.Filter := GraphicFilter(Tbitmap);
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;
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.x - round(pIconInfo.xHotspot);
cursory := DrawPos.y - round(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,Jpeg, 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 := '正在接收数据……';
if MySize = 0 then {MySize为服务端发送的字节数,如果为0表示为尚未开始图象接收}
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;
end.
程序原理:运行服务端开始侦听,再运行客户端,输入服务端IP地址建立连接,然后发一个字符通知服务端抓屏幕。服务端调用自定义函数Cjt_GetScreen抓取屏幕存为BMP,把BMP转换成JPG,把JPG写入内存流中,然后把流发送给客户端。客户端接收到流后做相反操作,将流转换为JPG再转换为BMP然后显示出来。
注意:因为Socket的限制,不能一次发送过大的数据,只能分几次发。所以程序中服务端抓屏转换为流后先发送流的大小,通知客户端这个流共有多大,客户端根据这个数字大小来判断是否已经接收完流,如果接收完才转换并显示。
这个程序跟前面的自制OICQ都是利用了内存流对象TMemoryStream。其实,这个流对象是程序设计中用得最普遍的,它可以提高I/O的读写能力,而且如果你要同时操作几个不同类型的流,互相交换数据的话,用它作"中间人"是最好不过的了。比如说你把一个流压缩或者解压缩,就先建立一个TMemoryStream对象,然后把别的数据拷贝进去,再执行相应操作就可以了。因为它是直接在内存中工作,所以效率是非常高的。有时侯甚至你感觉不到有任何的延迟。
程序有待改进的地方:当然可以加一个压缩单元,发送前先压缩再发送。注意:这里也是有技巧的,就是直接把BMP压缩而不要转换成JPG再压。实验证明:上面程序一幅图像大小大概为40-50KB,如果用LAH压缩算法处理一下便只有8-12KB,这样传输起来就比较快。如果想更快的话,可以采用这样的方法:先抓第一幅图像发送,然后从第二幅开始只发跟前一幅不同区域的图像。外国有一个程序叫Remote Administrator,就是采用这样的方法。他们测试的数据如下:局部网一秒钟100-500幅,互联网上,在网速极低的情况下,一秒钟传输5-10幅。说这些题外话只想说明一个道理:想问题,特别是写程序,特别是看起来很复杂的程序,千万不要钻牛角尖,有时侯不妨换个角度来想。程序是死的,人才是活的。当然,这些只能靠经验的积累。但是一开始就养成好习惯是终身受益的!
作者:陈经韬
mycur cursor move.cur //加入光标
mypic Bitmap Water.BMP //加入位图
mywav WAVE happy.wav //加入声音
myAVI AVI EPOEN.AVI //加入视频
myIco ICON CJT.ICO //加入图标
格式分别为在资源文件中的名称->类型->实际文件名称,例如上面第一行定义一个名为mycur的光标,实际名称为加入光标move.cur.
2.将rc文件编译成res资源文件
将脚本文件和实际文件拷到Brcc32.EXE所在目录,执行DOS命令。格式为:Brcc32 脚本文件(回车),例如有一名为myfirst.rc的脚本文件,则执行 Brcc32 myfirst.rc(回车)即可。如果你是懒人,也可新建一批处理文件,内容只有一行:Brcc32 mufist.rc.(因为Delphi安装后一般会在自动批处理文件中指明搜索路径的。)如果编译成功,则会生成一个结尾为res的文件,这个文件就是我们需要的资源文件。
3.在Delphi单元中加入资源文件
将生成的res资源文件拷贝到你所编程序的路径下,在单元文件{$R *DFM}后加上一句{$R mufirst.res},则将res文件加入去,编译后资 源文件即已包含在可执行文件中了。若你有多个资源文件,也按上法依次加入。
4.在Delphi程序中调用资源文件
资源文件在Delphi中的关键字为hinstance.下面给出具体用法.
<1>光标的调用
首先在程序中定义一个值大于0的常量,因为Delphi本身用0-负16来索引默认的光标,所以我们制定的光标应从表面上1开始索引。然后在窗口的Oncreat事件中添加以下代码:
screen.cursor[35]:=Loadcursor (hinstance,'mycur');
其中35为大于1的常量,mycur为光标在资源文件中的名字。如果希望在其他控件上使用定制光标,例如Panel控件,只需在程序的适当处加入以下代码:
Panel1.cursor:=35;
<2>位图的调用
新建一项工程,添加一Timage控件,在需要显示的地方写以下代码:
Var mymap:Hbitmap;
begin
mymap:=LoadBitmap(hinstance,'mypic');
Image1.picture.Bitmap.Handle:=mymap;
end;
其中"mypic"为位图资源文件中的名称。
〈3〉AVI文件的调用
新建一工程,添加一Animate控件,在需要的地方加入:
animater1.resname:='myAVI';
animater1.Active:=true;
其中myAVI为视频文件在资源文件中的名称。
〈4〉调用WAV文件
在uses中加入mmsystm单元,以便在程序中播放WAV文件。播放时Playsound(pchar('mywav'),hinstance,sndsync or snd_resource);其中mywav为声音文件在资源中的名称。
〈5〉加入光标
加入光标比较容易,只要将res文件加入单元文件中即可。但需注意,名称最好取"W"."WW"等,使第一个字母尽量靠后,以免与主程序的图标顺序颠倒。这样一来,别人在使用你的程序时如果想选择其它图标就有很多选择了。
补充:
1.资源类型除上述类型外,还可以字体文件,字符串文件等。
2.资源文件不但可以在标准图形界面下使用还可在控制台下使用。
下面我们来试验一下:
新建一工程,将唯一的一个Form删除,然后修改工程文件。增加一句{$Apptype console},在uses子句中加入mmsystem,并将其它引用单元删掉。将Begin和end之间语句删掉。至此,我们就可和Turbo PASCAL下编程序一样,且还可以调用windows的API和资源。将资源文件----{$R myfist.res}加入。在Begin和end之间写下:
writeln('演示程序,按任意键开始!');
readln;
playsound(pchar('mywav'),hinstance,snd_sync or snd_resource);
writeln('演示结束!');
运行程序,将弹出一个标准DOS窗口,按任意键播放声音文件。是不是很COOL呢!我曾下载过一个播放器,在其安装目录下我发现有一"DOS程序",用鼠标双击它便弹出一个DOS窗口,显示DOS时代特有的画图,并有背景音乐!可能就是用这个方法做的。
3.Delphi本身自带了一个叫Image Editor的工具,同样可以编辑资源文本,但和本文的方法比较,可得出下表:
**************************************
Image Editor Brcc32
BMP 只支持16位色 任意色
光标 黑白两色 任意色
ICO 只支持16位色 任意色
AVI 不支持 支持
WAV 不支持 支持
字体
字符串 不支持 支持
其他
****************************************
上面说的是直接在程序本身的调用。其实资源文件还有其它用法。比如说在你的程序携带其它文件,要用的时候释放出来。
例如: myexe exefile 'ha1.exe'//脚本文件
下面是自定义释放函数ExtractRes,本例中使用如下:
ExtractRes('exefile','myexe','c:\new.exe');
就把ha1.exe以new.exe为名字保存到C盘根目录下了.
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;
end;
----------------------------------------------------------------------
(二)中级应用篇:
上面我们已经知道如何把一副BMP图像从资源文件里面读出来,但是BMP文件太大了,JPG文件应用的相对较多.那么如何把JPG图像读出来呢?用资源文件加流方式即可。具体方法如下:
(1)MyJpg JPEG My.JPG
(2)Var
Stream:Tstream;
MyJpg:TJpegImage;
Begin
Stream:=TResourceStream.Cceat(HINSTANCE,'MyJpg','JPEG');
Try
MyJpg:=TJpegImage.Create;
Try
MyJpg.LoadfromStream(Stream);
Image1.Picture.Assignc(MyJpg);
Finally
MyJpg.Free;
end;
Finally
Stream.Free;
end;
end;
读取其它图片文件也是一样的.比如说gif动画文件,当然前提是你有一个gif.pas,这个单元很多站点都有的,可以自己去找找。实际应用中我还发现用上面的代码可以直接显示资源文件中的ICON和BMP.
说到图形处理,实际上还可以用Delphi创建、调用纯图标资源的DLL.比如说你可以看看超级解霸目录下的Dll,很多就是纯图标资源而已。具体方法如下:
(1):创建一个Hicon.RES文件,这里不再重复.
(2):新建一文本文件Icon.dpr,内容如下:
library Icon;
{$R Icon.RES}
begin
end.
用Delphi打开编译即可得到Icon.dll.
(3):实际调用方法如下:
……
Private
Hinst:THANDLE;
……
Var Hicon:THANDLE;
begin
Hinst:=Loadlibrary('Icon.dll');
If Hinst=0 Then Exit;
Hicon:=Loadicon(Hinst,Pchar(Edit1.Text));
If Hicon<>0 Then Image1.Picture.Icon.Handle:=Hicon;
FreeLibrary(Hinst);
end;
如果你的程序想在国际上供使用不同语言的人使用的话,用Dll来存放字符资源将是一个好方法.因为Dll不象ini文件那样可以被人随便修改,特别是有时侯如果想保存一些版权信息的话用Dll就再好不过了。比如说你准备开发一个"汉字简繁体翻译器"软件,准备提供Gb32,Big5码和英文三种语言菜单给用户,那么你可以试试用Dll来保存字符资源.
我们需要建立三个Dll.第一步当然是写Rc文件,举Gb32码为例,内容如下:
/*MySc.rc*/
#define IDS_MainForm_Caption 1
#define IDS_BtnOpen_Caption 2
#define IDS_BtnSave_Caption 3
#define IDS_BtnBig5_Caption 4
#define IDS_BtnGb32_Caption 5
#define IDS_BtnHelp_Caption 6
#define IDS_Help_Shelp 7
Stringtable
{
IDS_MainForm_Caption,"汉字简繁体翻译器"
IDS_BtnOpen_Caption,"打开文件"
IDS_BtnSave_Caption,"保存文件"
IDS_BtnBig5_Caption,"转换成Big5"
IDS_BtnGb32_Caption,"转换成Gb32"
IDS_BtnHelp_Caption,"帮助"
IDS_Help_Shelp,"输入文字或打开文件后按需要点击按钮即可转换!"
}
第二步是Brcc32编译为Res文件后用上面的方法得到Dll文件,另外两个Dll用同样的方法生成.下面来应用一下:
新建一个工程,放上五个Button:BtnOpen,BtnSave,BtnBig5,BtnGb32和BtnHelp.还有一个TComboBox:CbSelect用来选择语言种类的.
具体代码如下:
unit Unit1;
interface
……
private
Shelp: string;
function SearchLanguagePack: Tstrings;
procedure SetActiveLanguage(LanguageName: string);
{ Private declarations }
……
implementation
procedure TForm1.CbSelectChange(Sender: Tobject);
begin
SetActiveLanguage(CbSelect.Text);//调用相应Dll文件读取相应字符.
end;
procedure TForm1.FormCreate(Sender: Tobject);
begin
CbSelect.Items.AddStrings(SearchLanguagePack);//搜索当前目录下所有的Dll文件名称
end;
function TForm1.SearchLanguagePack: Tstrings;
var
ResultStrings: Tstrings;
DosError: integer;
SearchRec: TsearchRec;
begin
ResultStrings := TStringList.Create;
DosError := FindFirst(ExtractFilePath(ParamStr(0)) + '*.dll', faAnyFile, SearchRec);
while DosError = 0 do
begin
ResultStrings.Add(ChangeFileExt(SearchRec.Name, ''));
DosError := FindNext(SearchRec);
end;
FindClose(SearchRec);
Result := ResultStrings;
end;
procedure TForm1.SetActiveLanguage(LanguageName: string);
var
Hdll: Hmodule;
MyChar: array[0..254] of char;
DllFileName: string;
begin
DllFileName := ExtractFilePath(ParamStr(0)) + LanguageName + '.dll';
if not FileExists(DllFileName) then Exit;
Hdll := loadlibrary(Pchar(DllFileName));
Loadstring(hdll, 1, MyChar, 254);
Self.Caption := MyChar;
//读取字符资源,1表示资源文件中定义的1
Loadstring(hdll, 1, MyChar, 254);
Self.Caption := MyChar;
Loadstring(hdll, 2, MyChar, 254);
BtnOpen.Caption := MyChar;
Loadstring(hdll, 3, MyChar, 254);
BtnSave.Caption := MyChar;
Loadstring(hdll, 4, MyChar, 254);
BtnBig5.Caption := MyChar;
Loadstring(hdll, 5, MyChar, 254);
BtnGb32.Caption := MyChar;
Loadstring(hdll, 6, MyChar, 254);
BtnHelp.Caption := MyChar;
Loadstring(hdll, 7, MyChar, 254);
Shelp := MyChar;
Freelibrary(hdll);
Application.Title := Self.Caption;
//------------------------
BtnOpen.Visible := True;
BtnSave.Visible := True;
BtnBig5.Visible := True;
BtnGb32.Visible := True;
BtnHelp.Visible := True;
//------------------------
end;
procedure TForm1.BtnHelpClick(Sender: Tobject);
begin
Application.MessageBox(Pchar(Shelp), 'Http://lovejingtao.126.com', MB_ICONINFORMATION);
end;
end.
可能你会说,这种方法还不如我自己在程序中直接定义三种具体的值来的方便.甚至我自己自定义一个结构好了,用不着用DLL那么麻烦的。但是如果你的程序要用的字符很多呢?比如说Windows操作系统,本身就有简体中文,繁体中文,英文等等版本,用Dll的话只要直接替换DLL即可,而不用每发行一个版本就打开代码来修改一次。这样一来可以大大减少工作量和出错的机会.说到这里,再多说一句:Windows系统本身很多Dll带有了图片等资源,我们可以在程序中直接调用,这样一来我们的EXE也可以减少不少!当然最小的方法是实时生成技术.老外曾经写了一个67KB的程序就是利用了这个方法.感兴趣的朋友可以到http://go4.163.com/lovejingtao/ha1.exe下载.
----------------------------------------------------------------------
(三)高级应用篇:
Delphi是个很有效率的开发工具,但是它有一个缺点就是生成的EXE文件太大.一个程序就算只有一个空窗口体积也有286KB.如果直接用API来写的话程序体积是小了,但是又太繁琐,无法立即看到界面效果,根本谈不上是可视化开发.其实并非"鱼与熊掌不可兼得",利用资源文件我们就可以轻松达到这个目的.
在开始之前,我们需要一个可以编辑资源文件的工具.这类工具很多,比如说Resource WorkShop就是非常好的一个.如果一时找不到,利用VC的编辑器来也是可以的.下面我们就以VC的为例示范如何创建一个窗口资源文件.运行VC,打开菜单File-->New,将出现一个多项选择页.我们选择Files-->ResourceTemplate,在右边的File填上Demo,Location选择保存路径,然后点击按钮OK返回VC开发环境.
选择菜单Insert-->Resource,将出现一个资源类型选择框.我们把鼠标移到Dialog上面.不用展开,点击右边的New即可,这时候返回VC开发环境并出现一个只有关闭按钮和两个Button的窗体.将鼠标选定窗体,击右键选择最后一项Properties,将出现一个设置窗口,将ID改为"MAINFORM"(注意:跟下面添加的其它控件的属性设置方法不同,主窗口的ID必须把双引号写上去,而且名称必须为大写.否则程序将找不到资源.程序会一运行就退出了.)Caption改为"安装程序",这时候可以立刻看到窗口的标题变成了"安装程序",把Styles的Minimize box选上,More Styles的Center勾上使程序运行时的位置居中.当然你也可以设置它的坐标.其它保留默认值即可.回到开发环境,在控件框里面分别选择一个Static Text,一个Edit Box,一个Button和一个Group Box添加到窗体上面.把它们按照自己的爱好排列整齐.然后逐个修改它们的属性.方法就是按照上面说的选定控件后击右键选择最后一项Properties,在出现的属性框里面修改.其中属性如下:Group Box的Caption属性清空,Static Text的Caption属性改为"请选择安装目录:",Edit Box的ID改为10001.第一个Button的ID为10002,Caption属性为"选择",第二个Button的ID为10003,Caption属性为"安装",第三个Button的ID为10004,Caption属性为"退出".为了使程序更加完美,我们为它再添加一个菜单IDR_MENU1.选择Insert-->Resource-->Menu,我们这里只简单添加一项"文件-->退出",其中"退出"的ID为10005.然后在主窗口的属性Menu设定为IDR_MENU1即可.
为了使程序更加美观,我们再添加一个小图标,同时这也将是我们程序的图标.选择Insert-->Resource-->Icon-->Import,选择一个图标文件.并将它的ID设置为"MAINICON"(注意:必须把双引号写上而且字母为大写),为窗口添加一个Picture控件并设置它的属性Type:Icon,Image下拉选择刚才的图标MainIcon即可.
如果你想为程序在鼠标添加一些信息也是可以的.选择Insert-->Resource-->Version即可.
到这里我们已经完成了一个简单的"安装程序"的窗体设计.实际上我们现在就可以在Delphi中调用它了.我们先把"劳动成果"保存起来.选择File-->Save As,在文件类型里选择"32-bit Resource File(.res)"保存为"Demo.res",文件大小大约为2.65KB.
新建一个扩展名为dpr的文本文件MyDemo.Dpr,键入如下代码:
Uses Windows,Messages;
{$R Demo.Res}
function MainDialogProc(DlgWin:hWnd;DlgMessage:UINT;DlgWParam:WPARAM;DlgLParam:LPARAM):integer;stdcall;
begin
Result := 0;
case DlgMessage of
WM_Close:
begin
PostQuitMessage(0);
Exit;
end;
end;
end;
begin
DialogBox(hInstance, 'MAINFORM', 0, @MainDialogProc);
end.
用Delphi打开它编译一次即可产生一个大小为19KB的EXE.是不是很小!实际上,你甚至只用一行代码就把它Show出来,不过程序无法关闭而已.
Uses Windows;
{$R Demo.Res}
function MainDialogProc: integer;
begin
Result := 0;
end;
begin
DialogBox(hInstance, 'MAINFORM', 0, @MainDialogProc);
end.
上面的程序只不过是一个空窗口而已,现在我们来写代码响应按下相应按钮响应的事件.完整代码如下:
program MyDemo;
uses Windows, Messages, shlobj;
const
ID_Edit = 10001;
ID_Selet = 10002;
ID_Setup = 10003;
ID_Quit = 10004;
ID_Exit = 10005;
{$R Demo.Res}
var
MainWin: HWND;
function My_Gettext: string;
var
Textlength: Integer;
Text: Pchar;
s: string;
begin
TextLength := GetWindowTextLength(GetDlgItem(MainWin, ID_Edit));
GetMem(Text, TextLength + 1);
GetWindowText(GetDlgItem(MainWin, ID_Edit), Text, TextLength + 1);
s := text;
FreeMem(Text, TextLength + 1);
Result := s;
end;
function Getmyname: string;
var
I, j: integer;
begin
J := 3;
for I := 1 to length(ParamStr(0)) do
if ParamStr(0)[I] = '\' then J := I;
Result := copy(ParamStr(0), J + 1, length(ParamStr(0)) - J);
end;
function SelectDirectory(handle: hwnd; const Caption: string; const Root:WideString;outDirectory:string): Boolean;
var
lpbi: _browseinfo;
buf: array[0..MAX_PATH] of char;
id: ishellfolder;
eaten, att: cardinal;
rt: pitemidlist;
initdir: pwidechar;
begin
result := false;
lpbi.hwndOwner := handle;
lpbi.lpfn := nil;
lpbi.lpszTitle := pchar(caption);
lpbi.ulFlags := BIF_RETURNONLYFSDIRS + BIF_EDITBOX;
SHGetDesktopFolder(id);
initdir := pwchar(root);
id.ParseDisplayName(0, nil, initdir, eaten, rt, att);
lpbi.pidlRoot := rt;
getmem(lpbi.pszDisplayName, MAX_PATH);
try
result := shgetpathfromidlist(shbrowseforfolder(lpbi), buf);
except
freemem(lpbi.pszDisplayName);
end;
if result then
begin
directory := buf;
if length(directory) <> 3 then directory := directory + '\';
end;
end;
function MainDialogProc(
DlgWin: hWnd;
DlgMessage: UINT;
DlgWParam: WPARAM;
DlgLParam: LPARAM
)
: integer; stdcall;
var
MyIcon: HICON;
Sdir: string;
begin
Result := 0;
case DlgMessage of
WM_INITDIALOG:
begin
MyIcon := LoadIcon(hInstance, 'MainIcon');
SetClassLONG(DlgWin, GCL_HICON, MyIcon);
MainWin := DlgWin;
end;
WM_Close:
begin
PostQuitMessage(0);
Exit;
end;
WM_COMMAND:
case LOWORD(DlgWParam) of
ID_Selet:
begin
if SelectDirectory(DlgWin, '请选择安装目录', '', Sdir)
then SendMessage(GetDlgItem(DlgWin, ID_Edit), WM_SETTEXT, 0, lParam(pChar(Sdir)));
end;
ID_Setup:
begin
if My_Gettext = '' then
begin
MessageBox(DlgWin, '请先选择安装文件夹!', '信息', MB_ICONINFORMATION + MB_OK);
Exit;
end;
CopyFile(pchar(ParamStr(0)), pchar(My_Gettext + Getmyname), false);
MessageBox(DlgWin, '安装完毕!', '信息', MB_ICONINFORMATION + MB_OK);
PostQuitMessage(0);
Exit;
end;
ID_Quit:
begin
PostQuitMessage(0);
EXIT;
end;
ID_Exit:
begin
if MessageBox(DlgWin, '你点击了菜单“退出”,你确定退出程序吗?', '信息', MB_ICONQUESTION + MB_OKCANCEL) = IDOK then
PostQuitMessage(0);
Exit;
end;
end;
end;
end;
begin
DialogBox(hInstance, 'MAINFORM', 0, @MainDialogProc);
end.
其中SelectDirectory函数的作用是返回一个选择的文件路径.然后把自己拷贝到选择的目录下,当然很多处理没有写,读者可以自行添加.文件编译后大小为22KB,如果直接用Delphi的VCL来写的话,将为338KB!完整代码可以在我的主页上下载:http://go4.163.com/lovejingtao/setup2.zip.代码中的消息处理相信大家看的懂.如果不用资源文件而直接用API来写将对它更加理解深刻,.限于篇幅这里不做详细介绍,感兴趣的读者可以自行下载代码来看:
http://go4.163.com/lovejingtao/setup1.zip.全部代码在Delphi+Pwin2000下通过.
------------------------------------------------------------------------
★作者:
陈经韬
Http:Lovejingtao.126.com
E-Mail: Lovejingtao@21.cn.com