delphi7中如何实现远程抓屏？

2004-06-15 11:15:26 194 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

Vivado 2018.3 SDK烧写bin文件避坑指南：如何解决QSPI模式下的常见错误本文深入解析了在Vivado 2018.3 SDK中为Zynq FPGA烧写QSPI Flash时遇到的常见问题，特别是启动模式为QSPI时出现的警告与失败。文章从Zynq启动机制入手，提供了修改FSBL代码以强制使用JTAG模式、调整硬件配置等核心解决方案，并分享了实战案例与最佳实践，帮助开发者高效避坑，确保bin文件烧写成功。阅读详情

delphi7中如何实现远程屏幕抓取？

...全文

R语言环境下Bibliometrix与Biblioshiny的安装与配置指南本文提供了在R语言环境下安装与配置Bibliometrix和Biblioshiny的详细指南。内容涵盖R与RStudio的安装、Bibliometrix包的安装避坑方法，以及如何启动Biblioshiny图形界面进行文献计量分析。重点解决了安装过程中的常见网络与依赖问题，帮助科研人员快速搭建高效的文献分析环境。阅读详情

phide

网络通信/分布式开发 1,594 成员 32,944 内容

+ 关注 + 加入社区

切换为时间正序

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,我这有个例子，要的话给你拷过去。

delphi7中如何实现远程抓屏？

相关推荐