-----------------------------------------------------------------------
实际应用之三:利用流制作自己的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幅。说这些题外话只想说明一个道理:想问题,特别是写程序,特别是看起来很复杂的程序,千万不要钻牛角尖,有时侯不妨换个角度来想。程序是死的,人才是活的。当然,这些只能靠经验的积累。但是一开始就养成好习惯是终身受益的!