|
|
|
谈Delphi编程中“流”的应用--陈经韬 |
热 ★★★★ |
|
谈Delphi编程中“流”的应用--陈经韬 |
|
作者:闵涛 文章来源:闵涛的学习笔记 点击数:1886 更新时间:2009/4/23 18:39:34 |
|
ementation {$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幅。说这些题外话只想说明一个道理:想问题,特别是写程序,特别是看起来很复杂的程序,千万不要钻牛角尖,有时侯不妨换个角度来想。程序是死的,人才是活的。当然,这些只能靠经验的积累。但是一开始就养成好习惯是终身受益的!
★作者:
陈经韬 Http:Lovejingtao.126.com E-Mail: Lovejingtao@21.cn.com
©CopyRight 2000-2001
上一页 [1] [2] [3] [Delphi程序]谈Delphi编程中“流”的利用(一) [Delphi程序]谈Delphi编程中“流”的应用--可读写信息在文件中 [Web开发]ADO编程中ATL所遇到的定义问题
|
|
教程录入:mintao 责任编辑:mintao |
|
|
上一篇教程: Delphi精英 下一篇教程: 谈Delphi编程中“流”的应用--可读写信息在文件中 |
|
|
【字体:小 大】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口】 |
|
注:本站部分文章源于互联网,版权归原作者所有!如有侵权,请原作者与本站联系,本站将立即删除! 本站文章除特别注明外均可转载,但需注明出处! [MinTao学以致用网] |
网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!) |
|
|
|
|
|
|
|
同类栏目 |
|
|
赞助链接 |
|
|
500 - 内部服务器错误。
|
|
|
|
|
|