怎樣實現連續抓屏(用clientSocket&ServerSocket) 米蝦會帶上全部的家當等你們幫忙!(100分)

  • 主题发起人 主题发起人 SPYSKY
  • 开始时间 开始时间
S

SPYSKY

Unregistered / Unconfirmed
GUEST, unregistred user!
大哥 大姐 大蝦們:
我最近可是真碰到難題了:不知道怎樣實現在局域網內實現動態的抓屏呢,
而且要進行資源Free喲,監控端可以保存.
請你們指點指點!
 
大家应该见过很多网管程序，这类程序其中有一个功能就是监控远程电脑的屏幕。实际上，这也是利用流操作来实现的。下面我们给出一个例子，这个例子分两个程序，一个服务端，一个是客户端。程序编译后可以直接在单机、局部网或者互联网上使用。程序中已经给出相应注释。后面我们再来作具体分析。
新建一个工程，在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); {画上鼠标}
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幅。说这些题外话只想说明一个道理：想问题，特别是写程序，特别是看起来很复杂的程序，千万不要钻牛角尖，有时侯不妨换个角度来想。程序是死的，人才是活的。当然，这些只能靠经验的积累。但是一开始就养成好习惯是终身受益的！

★作者:

陈经韬
 
//转载一帖

我用socket控件进行局域网图象传输.用陈经韬大侠抓屏幕代码时，
server端已经确认图像流已经发出，
可是client端毫无反应，传text就没问题。用我自己的抓图代码就没问题，
不知道我的问题出在那里了，请高手帮忙，谢谢.
代码如下：


////////
不要叫我做大侠啊.我是菜鸟一个.
上面的代码不是我的啊.应该是早年一个用UDP传输的程序改过来的.
因为它指定了抓屏的尺寸.
下面是从我的"圣诞节蜂密"里面取下来的代码.
以前流的应用"里面抓鼠标代码存在重大缺陷,会导致系统资源下降直到耗尽.现已改正
请到我的主页lovejingtao,126.com下载.附送IP电话代码.

五、实际应用之四：利用流实现网络传输屏幕图像

大家应该见过很多网管程序，这类程序其中有一个功能就是监控远程电脑的屏幕。实际上，这也是利用流操作来实现的。下面我们给出一个例子，这个例子分两个程序，一个服务端，一个是客户端。程序编译后可以直接在单机、局部网或者互联网上使用。程序中已经给出相应注释。后面我们再来作具体分析。
新建一个工程，在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的限制，不能一次发送过大的数据，只能分几次发。所以程序中服务端抓屏转换为流后先发送流的大小，通知客户端这个流共有多大，客户端根据这个数字大小来判断是否已经接收完流，如果接收完才转换并显示。
 
首先,小弟在此先謝謝兩位前輩的指導,有一點遺憾的是Client仍不能連續抓屏,
(當然我已經把那句加上),究其原因....所以還是望各位多多灌水!
 
各路高手,如果你們今天不幫我的話,我可能就沒轍了,小弟可是在線等候喲!
幫幫手啊!
 
不可能呀，我做的怎么可以呀。把你的代码帖出来
 
各位老兄:
我這個後輩在此先謝謝你們!(特別是小虫子和卡色)不過我看了一下你的代碼,絕大部份相同
(構思也一樣),但就是不出結果,現在我將代碼貼上,請多多教導.(說明:本程序正在調試之
中,所以有部份代碼可能沒有涉及到我們所談論的主題,其實我的本意是想做一個多屏動態
監控).

unit clientscrUnit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp, Buttons, ExtCtrls,Jpeg, ComCtrls;

type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
Panel1: TPanel;
ClientSocket2: TClientSocket;
Bevel1: TBevel;
Panel3: TPanel;
Image1: TImage;
Panel4: TPanel;
Image2: TImage;
Panel2: TPanel;
BitBtn1: TBitBtn;
Edit1: TEdit;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
Edit3: TEdit;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
Panel5: TPanel;
Panel6: TPanel;
Image3: TImage;
Image4: TImage;
BitBtn7: TBitBtn;
BitBtn8: TBitBtn;
BitBtn9: TBitBtn;
BitBtn10: TBitBtn;
BitBtn11: TBitBtn;
BitBtn12: TBitBtn;
Edit4: TEdit;
Edit5: TEdit;
Memo1: TMemo;
Timer1: TTimer;
Timer2: TTimer;
StatusBar1: TStatusBar;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
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 BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure ClientSocket2Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket2Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocket2Read(Sender: TObject; Socket: TCustomWinSocket);
procedure BitBtn6Click(Sender: TObject);
procedure Image1DblClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Image2DblClick(Sender: TObject);



private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
c1,c2:longint;
m1,m2:tmemorystream;
st:string;
implementation

uses ImageUnit;

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
try
clientsocket1.Close;
clientsocket1.Host:=edit1.text;
clientsocket1.Open; //連接服務端
except
st:=edit1.text+#13#10+'未找到客戶机或未安裝服器程序';
Application.MessageBox(pchar(st),'BBS廣播信息',MB_OK+MB_ICONINFORMATION);
end;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
clientsocket1.Socket.SendText('gets');
//Timer1.Enabled:=not Timer1.Enabled;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.Panels[0].Text:='已經連接到'+edit1.text+'...';
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
caption:='連接'+edit1.text+'失敗!';
st:=edit1.text+#13#10+'未找到客戶机或未安裝服器程序';
Application.MessageBox(pchar(st),'BBS廣播信息',MB_OK+MB_ICONINFORMATION);
errorcode:=0;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var buffer:array [0..10000] of byte; //設置置接收字節大小
len:integer;
ll:string;
b:tbitmap;
j:tjpegimage;
begin
WITH Socket do
begin
if c1=0 then
begin
ll:=socket.ReceiveText;
c1:=strtoint(ll);
clientsocket1.Socket.SendText('okok');
end
else
begin
len:=socket.ReceiveLength;
socket.ReceiveBuf(buffer,len);
m1.Write(buffer,len);
if m1.Size>=c1 then
begin
m1.Position:=0;
b:=tbitmap.Create;
j:=tjpegimage.Create;
try
j.LoadFromStream(m1);
b.Assign(j);
Image1.Picture.Bitmap.Assign(b);
Imageform.Image1.Picture:=Image1.Picture;
finally
b.free;
j.free;
clientsocket1.Active:=false;
clientsocket1.Active:=true;
Socket.SendText('Gets');
m1.Clear;
clientsocket1.Socket.SendText('Free');
c1:=0;
//clientsocket1.Socket.SendText('gets');
end;
end;
end;
// clientsocket1.Socket.SendText('gets');
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
m1:=tmemorystream.Create;
m2:=tmemorystream.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
m1.free;
m2.free;
ClientSocket1.Close;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
ClientSocket1.Socket.SendText(Memo1.Text);
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
try
clientsocket2.Close;
clientsocket2.Host:=edit3.text;
clientsocket2.Open; //連接服務端
except
st:=edit3.text+#13#10+'未找到客戶机或未安裝服器程序';
Application.MessageBox(pchar(st),'BBS廣播信息',MB_OK+MB_ICONINFORMATION);
end;
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
begin
clientsocket2.Socket.SendText('gets');
end;

procedure TForm1.ClientSocket2Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
caption:='已經連接到'+edit3.text+'...';
end;

procedure TForm1.ClientSocket2Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
caption:='連接'+edit3.text+'失敗!';
st:=edit3.text+#13#10+'未找到客戶机或未安裝服器程序';
Application.MessageBox(pchar(st),'BBS廣播信息',MB_OK+MB_ICONINFORMATION);
errorcode:=0;
end;

procedure TForm1.ClientSocket2Read(Sender: TObject;
Socket: TCustomWinSocket);
var buffer:array [0..10000] of byte; //設置置接收字節大小
len:integer;
ll:string;
b:tbitmap;
j:tjpegimage;
begin
if c2=0 then
begin
ll:=socket.ReceiveText;
c2:=strtoint(ll);
clientsocket2.Socket.SendText('okok');
end
else
begin
len:=socket.ReceiveLength;
socket.ReceiveBuf(buffer,len);
m2.Write(buffer,len);
if m2.Size>=c2 then
begin
m2.Position:=0;
b:=tbitmap.Create;
j:=tjpegimage.Create;
try
j.LoadFromStream(m2);
b.Assign(j);
Image2.Picture.Bitmap.Assign(b);
Imageform.Image1.Picture:=Image2.Picture;
finally
b.free;
j.free;
clientsocket2.Active:=false;
clientsocket2.Active:=true;
m2.Clear;
c2:=0;
end;
end;
end;

end;

procedure TForm1.BitBtn6Click(Sender: TObject);
begin
ClientSocket2.Socket.SendText(Memo1.Text);
end;

procedure TForm1.Image1DblClick(Sender: TObject);
begin

Imageform.showmodal;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
clientsocket1.Socket.SendText('gets');
IF clientsocket1.Socket.ReceiveText='OKOK' THEN
BEGIN
Timer2.Enabled:=True;
Timer1.Enabled:=False;
END;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
clientsocket1.Socket.SendText('okok');
Timer1.Enabled:=True;
Timer2.Enabled:=False;
end;

procedure TForm1.Image2DblClick(Sender: TObject);
begin
Imageform.Showmodal;
end;

end.

Server 端
unit serverscrUnit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp,Jpeg;

type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
m1:tmemorystream;
implementation

{$R *.dfm}

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var s,s1:string;
str:pchar;
Code,V:Integer;
desk:tcanvas;
bitmap:tbitmap;
jpg:tjpegimage;
begin
s:=socket.ReceiveText;

if s='Free' then
try
m1.Free;
except
showmessage('eeee');
end;

if s='gets' then
begin
bitmap:=tbitmap.Create;
jpg:=tjpegimage.Create;
desk:=tcanvas.Create;
desk.Handle:=getdc(hwnd_desktop);
m1:=tmemorystream.Create;
with bitmap do
begin
width:=screen.Width;
height:=screen.Height;
canvas.CopyRect(canvas.cliprect,desk,desk.cliprect);
end;
jpg.Assign(bitmap);
jpg.SaveToStream(m1);
jpg.free;
m1.Position:=0;
s1:=inttostr(m1.size);
Socket.sendtext(s1);
end;

if s='okok' then
begin
m1.Position:=0;
Socket.SendStream(m1);
end;

{if (s<>'okok') and (s<>'gets') then
begin
Str:=PChar(s);
Val(Str,V,Code);

if (Code<>0) then
Application.MessageBox(Str,
'BBS廣播信息',MB_OK+MB_ICONINFORMATION)
else
if (V=0)or(V=1)or(V=2) then
ExitWindowsEx(V,0)
else
Application.MessageBox
(Str,'提示信息',MB_OK+MB_ICONINFORMATION);
end; }


end;
procedure TForm1.FormCreate(Sender: TObject);
begin
form1.Brush.Style:=bsclear;
ServerSocket1.open;
end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
errorcode:=0;
end;

end.

 
不要用timer控件控制抓屏的信号。
还是用剩余的大小来控制比较好。
你的问题我也遇到过，
我也是用的timer定时发送，但是最后还是改成按剩余大小了。
 
呵呵，又是抓屏。。。。。。远程显示。。。。。呵呵

faint。。。为什么大家都玩这个，有什么好玩的？

我讨厌这玩意儿，花费了我两个月时间。。。。学了不少又怎样？

到头来只有一堆测试数据，就是没有商业化。。。。咳
 
你們的答案我已經接受了,不管怎樣我會馬上給分的,但我還是有個疑問:屏幕抓出來會有
閃爍現象,怎樣自動保存這樣圖象呢,只是想向大家請教請教,當然你們不答也可以!
 
有興趣的朋友可以與我一起討論,我的E-mail:weimeng88@sina.com.cn
 
多人接受答案了。
 
您必须登录或注册才可回复。

Similar threads

R
你們的系統怎麼開發？是這樣嗎？(0分)
回复
9
查看
293
Richard3000
R
C
Borland程序員比賽可能是"陷阱",大家小心!!! (20分)
2
回复
26
查看
1K
cloudjava
C
S
转贴:【深度探索】 【李维读者专区】文章 "學 Kylix? 免談!續集:峰迴路轉 "(0分)
回复
4
查看
365
浪里白条
浪
H
一个高级程序员的困惑！（zhu转自CSDN)(0分)
回复
10
查看
252
luyear
L
C
转贴： 一挥间宝兰灰飞烟灭，刹那间微软如日中天。世事如朝之白露，誰与争？　李维与宝兰的故事(1分)
回复
5
查看
338
copy_paste
C
后退
顶部