请帮忙看看我的代码 关于屏幕监控的 ( 积分: 100 )

  • 主题发起人 主题发起人 blender
  • 开始时间 开始时间
B

blender

Unregistered / Unconfirmed
GUEST, unregistred user!
我的屏幕监控在第一次截图的时候还是很正常的
但是不知道为什么第二次截图的时候就开始报错并且不图象清晰
代码如下：请高手指点

客户端：
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp,jpeg, ExtCtrls;

type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Edit1: TEdit;
Panel1: TPanel;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ClientSocket1read(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button3Click(Sender: TObject);

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

var
Form1: TForm1;
c:longint;
m:tmemorystream;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
try
ClientSocket1.Close;
ClientSocket1.Host:=edit1.Text;
ClientSocket1.Open;
except
showmessage(edit1.text+'未开机或未安装服务程序');
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
clientsocket1.Socket.SendText('gets'); //发送申请，通知服务端需要屏幕图象
end;


procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
buffer:array [0..10000] of byte;
len:integer;
ll:string;
b:tbitmap;
j:TJPEGImage;
begin
Image1.Repaint;
if c=0 then //C为服务端发送的字节数，如果为0表示为尚未开始图象接收
begin
ll:=socket.ReceiveText;
c:=strtoint(ll); //设置需接收的字节数
clientsocket1.Socket.SendText('okok'); //通知服务端开始发送图象
end else
begin
len:=socket.ReceiveLength;
socket.ReceiveBuf(buffer,len);
m.Write(buffer,len);
if m.Size>=c then
begin
m.Position:=0;
b:=tbitmap.Create;
j:=tjpegimage.Create;
try
j.LoadFromStream(m);
b.Assign(j);
Image1.Picture.Bitmap:=b;
finally
b.free;
j.free;
m.Clear;
c:=0;
end;
end;
end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
m:=tmemorystream.Create;

end;

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

procedure TForm1.Button3Click(Sender: TObject);
begin
application.Terminate;
end;

end.


服务器端：
unit Unit1;

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);
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;
desk:tcanvas;
bitmap:tbitmap;
jpg:tjpegimage;

begin
s:=socket.ReceiveText;
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;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Open;
end;

end.
我想服务器端应该没什么问题
应该每次我关掉客户端后从新连接服务器端（服务器端不重起程序）
截图都很正常。
我想问题主要是出在客户端上。请高手指点
谢谢！
 
我的屏幕监控在第一次截图的时候还是很正常的
但是不知道为什么第二次截图的时候就开始报错并且不图象清晰
代码如下：请高手指点

客户端：
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp,jpeg, ExtCtrls;

type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Edit1: TEdit;
Panel1: TPanel;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ClientSocket1read(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button3Click(Sender: TObject);

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

var
Form1: TForm1;
c:longint;
m:tmemorystream;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
try
ClientSocket1.Close;
ClientSocket1.Host:=edit1.Text;
ClientSocket1.Open;
except
showmessage(edit1.text+'未开机或未安装服务程序');
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
clientsocket1.Socket.SendText('gets'); //发送申请，通知服务端需要屏幕图象
end;


procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
buffer:array [0..10000] of byte;
len:integer;
ll:string;
b:tbitmap;
j:TJPEGImage;
begin
Image1.Repaint;
if c=0 then //C为服务端发送的字节数，如果为0表示为尚未开始图象接收
begin
ll:=socket.ReceiveText;
c:=strtoint(ll); //设置需接收的字节数
clientsocket1.Socket.SendText('okok'); //通知服务端开始发送图象
end else
begin
len:=socket.ReceiveLength;
socket.ReceiveBuf(buffer,len);
m.Write(buffer,len);
if m.Size>=c then
begin
m.Position:=0;
b:=tbitmap.Create;
j:=tjpegimage.Create;
try
j.LoadFromStream(m);
b.Assign(j);
Image1.Picture.Bitmap:=b;
finally
b.free;
j.free;
m.Clear;
c:=0;
end;
end;
end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
m:=tmemorystream.Create;

end;

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

procedure TForm1.Button3Click(Sender: TObject);
begin
application.Terminate;
end;

end.


服务器端：
unit Unit1;

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);
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;
desk:tcanvas;
bitmap:tbitmap;
jpg:tjpegimage;

begin
s:=socket.ReceiveText;
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;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Open;
end;

end.
我想服务器端应该没什么问题
应该每次我关掉客户端后从新连接服务器端（服务器端不重起程序）
截图都很正常。
我想问题主要是出在客户端上。请高手指点
谢谢！
 
我试了N下,没有报错啊,不过闪的厉害,而且处理速度慢,资源占用比较厉害[:(]
 
不会吧
在本机好象不容易报错
但是在网络上运行的时候特别容易报错
本机的时候确实报错的机会不大
关于资源占用问题wjames有什么意见请指点一下
谢谢
 
用Socket API写吧...用控件太慢,而且编写难度也高,而且容易出错。
用Socket API就简单得多了,速度又快...
TCP太慢.改UDP才行..
用Jpeg压缩绝对不是好办法....改用zlib流压缩,采用快速压缩方式...
最后提醒一点.流虽然好用但要小心前后的工作次序.不然内存很快就用光..

如果采用DirectDraw直接将显存数据取出,再加模糊图像判断,只传部分变化数据.
再在Client端直写显存,呵呵..会是怎么一回事呢??自己慢慢研究吧......
 
呵呵
没试过
我试试，谢谢啊edust
有这样的文章我看看吗
你的提法我很感受用，并且我已经遇到这样的问题了
看来这个帖子很快就能节了：）
 
我用的是TNMUDP，没有楼主这样的情况；楼主的程序好象只截图，没有保存之类的操作吧，看来也是刚学delphi...共同学习...
 
相关的知识在
http://www.csdn.com.cn
自己慢慢找.
 
我并不想保存
只是想实现屏幕监视
如果一直用对屏幕截图的话怕服务器端太占用资源
而导致服务器端不能进行正常操作
所以就是拿来看看
想保存到是很容易
 
屏幕录像机可以广播视频 email:dxmylove@yahoo.com.cn,qq:171833017,个人主页:http://www.websamba.com/dxmylove
 
多人接受答案了。
 
您必须登录或注册才可回复。

Similar threads

Y
我的server怎么不能发信息到client？？？dx们可以帮我解释一下套接字吗？(20分)
回复
3
查看
216
ybbh
Y
S
有关代理服务器的一段代码，大家给看看毛病再哪儿，谢谢(50分)
回复
3
查看
143
sun112233
S
J
如何传输一个结构?(100分)
回复
3
查看
167
jingtao
J
B
学习TServerSocket 和 TClientSocket进行文件传输，为什么多个Client同时向Server传时，出现如下错误： (30分)
回复
7
查看
221
wab
W
G
关于clientsocket的问题，求救!贴出了源程序。(再加100分!) (50分)
回复
16
查看
311
genue
G
后退
顶部