delphi7中如何实现远程抓屏?

phide 2004-06-15 11:15:26
delphi7中如何实现远程屏幕抓取?
...全文
161 7 打赏 收藏 转发到动态 举报
写回复
用AI写文章
7 条回复
切换为时间正序
请发表友善的回复…
发表回复
2312 2004-06-21
  • 打赏
  • 举报
回复
特别容易,我的程序里面就有,你要是要,我有时间给你写一个
Rex_love_Burger 2004-06-16
  • 打赏
  • 举报
回复
http://www.tiantiansoft.com/Article_Show.asp?ArticleID=104
或http://tech.sina.com.cn/soft/2000-08-28/677.html
一、软硬件要求。

  Windows对等网,用来监视的计算机(以下简称主控机)和被监视的计算机(以下简称受控机)都必须装有TCP/IP 协议,并正确配置。如没有网络,也可以在一台计算机上进行调试。

  二、实现方法。

  编制两个应用程序,一个为VClient.exe,装在受控机上,另一个为VServer.exe,装在主控机上。VServer.exe指定要监视的受控机的IP地址和将要在受控机屏幕上抓取区域的大小和位置,并发出屏幕抓取指令给VClient.exe,VClient.exe得到指令后,在受控机屏幕上选取指定区域,生成数据流,将其发回主控机,并在主控机上显示出抓取区域的BMP图象。由以上过程可以看出,该方法的关键有二:一是如何在受控机上进行屏幕抓取,二是如何通过TCP/IP协议在两台计算机中传输数据。

  UDP(User Datagram Protocol,意为用户报文协议)是Internet上广泛采用的通信协议之一。与TCP协议不同,它是一种非连接的传输协议,没有确认机制,可靠性不如TCP,但它的效率却比TCP高,用于远程屏幕监视还是比较适合的。同时,UDP控件不区分服务器端和客户端,只区分发送端和接收端,编程上较为简单,故选用UDP协议,使用Delphi 4.0提供的TNMUDP控件。
三、创建演示程序。
…………………………自己去看吧
taoxianxue 2004-06-16
  • 打赏
  • 举报
回复
偶不晓得
帮你顶顶
Rex_love_Burger 2004-06-16
  • 打赏
  • 举报
回复
遍地都是例程,自己用google去找吧
insert2003 2004-06-16
  • 打赏
  • 举报
回复
客户端程序。



新建一个工程,添加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然后显示出来。

insert2003 2004-06-16
  • 打赏
  • 举报
回复
socket


服务端程序



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.
ghtghtmalone 2004-06-16
  • 打赏
  • 举报
回复
对,用UDP,我这有个例子,要的话给你拷过去。

1,593

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 网络通信/分布式开发
社区管理员
  • 网络通信/分布式开发社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧