关于在局域网如何监视另一台计算机的屏幕。(200分)

  • 主题发起人 西山居士
  • 开始时间
采用显存图像拷贝方法!
 
databox 的内容应该是对的,我在网上也看过
 
to xsjs:
I have been just studying Net Programming,and I'v happened to make
one -----Using TCP/IP,not udp...
All the codes are :
//There are still some bugs(or called disadvantages)!It's only a not-so-good
//demo
----------------------------------------------------------------------------
{At Server party:}
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp,jpeg,shellapi;

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

var
Form1: TForm1;
TmpStream:TMemoryStream;
TmpBuf:array[0..1023]of byte;
implementation

{$R *.DFM}

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

procedure TForm1.FormCreate(Sender: TObject);
begin
State := stWaiting;
TmpStream:=TMemoryStream.Create;
form1.Width:=0;
form1.Height:=0;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var BitMap:TBitMap;
DesktopCanvas:TCanvas;
JpegPic:TJpegImage;
TmpText:String;
count:LongInt;
begin
if State = stWaiting then
begin
TmpText:=socket.ReceiveText;
if TmpText='准备抓图' then
begin
Bitmap:=TBitmap.Create; DesktopCanvas:=TCanvas.Create;JpegPic := TJpegImage.Create;
DesktopCanvas.Handle:=GetDc(Hwnd_Desktop);
try
Bitmap.Width:=Screen.Width;
Bitmap.Height:=Screen.Height;
Bitmap.Canvas.CopyRect(BitMap.Canvas.ClipRect,DesktopCanvas,Bitmap.Canvas.ClipRect);
JpegPic.Assign(Bitmap);
JpegPic.CompressionQuality :=30;
JpegPic.Compress;
TmpStream.Position:=0;
JpegPic.SaveToStream(TmpStream);
finally
BitMap.Free; DesktopCanvas.Free; ReleaseDc(handle,hwnd_Desktop);
TmpStream.Position:=0; state:=stWorking;
end; //end of finally
Socket.SendText('准备完毕');
end;
end
else
if state=stWorking then
begin
TmpText:=Socket.ReceiveText;
if TmpText='开始抓图' then
begin
state:=stSending;
Count:=TmpStream.Read(TmpBuf,SizeOf(TmpBuf));
Socket.SendBuf(TmpBuf,Count);
if Count<sizeof(TmpBuf) then state := stWaiting else state:=stGoOnSending;
end;
end
else
if State=stGoOnSending then
begin
TmpText:=Socket.ReceiveText;
if Tmptext = '继续发送' then
begin
Count:=TmpStream.Read(TmpBuf,SizeOf(TmpBuf));
Socket.SendBuf(TmpBuf,Count);
if Count<sizeof(TmpBuf) then
begin state := stWaiting; TmpStream.Clear;TmpStream.position:=0; end;
end;
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
TmpStream.Free;
end;

end.
-------------------------------------------------------------------------------
{At Client party:}
unit Unit1;

interface

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

type
TState = (stIdle,stWorking,stReceiving,stGoOnReceiving);
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
Image1: TImage;
PopupMenu1: TPopupMenu;
host1: TMenuItem;
startS1: TMenuItem;
N1: TMenuItem;
exitE1: TMenuItem;
Timer1: TTimer;
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure exitE1Click(Sender: TObject);
procedure host1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure startS1Click(Sender: TObject);
procedure ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure Timer1Timer(Sender: TObject);
private
State : TState;
Address:string;
_flag:boolean;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
var TmpStream:TMemoryStream;
JpegPic:TJpegImage;
TmpBuf:array[0..1023]of byte;
received:Longint;
times:Longint;
{$R *.DFM}

procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode:=0;
ShowMessage('Error occur...');
end;

procedure TForm1.exitE1Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.host1Click(Sender: TObject);
var t:string;
begin
received:=0;
t:=InputBox('host address','enter your server address','192.168.1.29');
Form1.Address:=t;
Form1.startS1.Enabled:=true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
state:=stIdle; times:=0; _flag:=false;
TmpStream:=TMemoryStream.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
TmpStream.Free;
JpegPic.Free;
end;

procedure TForm1.startS1Click(Sender: TObject);
begin
ClientSocket1.Address:=Form1.Address;
ClientSocket1.Active:=true;
state :=stWorking;
end;

procedure TForm1.ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
begin
Form1.Caption:='Trying connecting to '+ClientSocket1.Address;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Form1.Caption:='Successfully connected to'+Socket.RemoteAddress;
inc(times);
Socket.SendText('准备抓图');
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Form1.Caption:='DisConnected already...'
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var BitMap:TBitMap;
TempText:String;
count:LongInt;
begin
if state=stWorking then
begin
TempText:=Socket.ReceiveText;
if TempText='准备完毕' then begin state:=stReceiving; Socket.SendText('开始抓图')end
end
else
if state=stReceiving then
begin
count:=Socket.ReceiveBuf(TmpBuf,SizeOf(TmpBuf));
received:=received+count; Form1.Caption:=IntToStr(received);
TmpStream.Write(TmpBuf,count);
if count<SizeOf(TmpBuf) then state:=stIdle
else begin state:=stGoOnReceiving; Socket.SendText('继续发送'); end;
end
else
if State=stGoOnReceiving then
begin
count:=Socket.ReceiveBuf(TmpBuf,SizeOf(TmpBuf));
received:=received+count; Form1.Caption:=IntToStr(received);
TmpStream.Write(TmpBuf,count);
if count<SizeOf(TmpBuf) then state:=stIdle else Socket.SendText('继续发送');
if state=stIdle then
begin
if fileexists('c:/123.jpg') then deletefile('c:/123.jpg');
TmpStream.SaveToFile('c:/123.jpg');
TmpStream.Clear;
TmpStream.Position:=0;
Application.ProcessMessages;
Image1.Picture.LoadFromFile('c:/123.jpg');
TmpStream.Clear; _flag:=true;
end;
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if _flag=true then
begin
_flag:=false;
startS1Click(self);
end;
end;

end.
 
//go on
if Count<sizeof(TmpBuf) then state := stWaiting else state:=stGoOnSending;
end;
end
else
if State=stGoOnSending then
begin
TmpText:=Socket.ReceiveText;
if Tmptext = '继续发送' then
begin
Count:=TmpStream.Read(TmpBuf,SizeOf(TmpBuf));
Socket.SendBuf(TmpBuf,Count);
if Count<sizeof(TmpBuf) then
begin state := stWaiting; TmpStream.Clear;TmpStream.position:=0; end;
end;
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
TmpStream.Free;
end;

end.
 
//抱歉,我Ctrl+V时出了问题.... :p
if Count<sizeof(TmpBuf) then state := stWaiting else state:=stGoOnSending;
end;
end
else
if State=stGoOnSending then
begin
TmpText:=Socket.ReceiveText;
if Tmptext = '继续发送' then
begin
Count:=TmpStream.Read(TmpBuf,SizeOf(TmpBuf));
Socket.SendBuf(TmpBuf,Count);
if Count<sizeof(TmpBuf) then
begin state := stWaiting; TmpStream.Clear;TmpStream.position:=0; end;
end;
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
TmpStream.Free;
end;

end.
 
重大发现:Win2000在像我上面 Ctrl+V 时会出问题!
表现就是无法正常粘贴!#·¥%!·#%!%#!·#!·#
------------------------------------------------
算了,还是e-mail 给xsjs(hqlsta@263.net)吧!
谁想要就问he/she要吧.....-----我这几天恐怕
不能回信了。。。
 

到http://ciip.yeah.net看看功能强大的“金管家”的“网络第一盾”吧!里面的功
能几乎可以用在管理电脑使用的大方面。我从朋友处得到过一个,安装在我们单位的
81台电脑上,哇!效果不错耶!!!至于注册!!!???改改时间就可以了!不
知道“金管家”的作者会生气吗???????哈!

 
如果你知道告诉我( EMAINTO:zhan163@21cn.com
 
give me too
 
我自己做了一个远程检控程序,并且抓图作了XOR处理,不过运行时会不定期出错
可能是一些细节问题没有解决把,现在把工程发给你起切磋切磋吧xtsls@263.net。
别望了给分嘻嘻!
 
可以参考Oracle的VNC开放源码,它支持多种操作系统终端的监控
 
抓屏幕图像,保存为内存流--BMP流,压缩BMP流,JPG流,以及使用流}
{在网络中传送BMP流和JPG流的速度没测试过}
{BMP流的压缩是无损压缩}
{
全局变量
memoryStream:TMemoryStream;
memoryStream:=TMemoryStream.create;
}

var
image:Timage;
jpgstream:TJPEGImage;
ss:tcanvas;

begin
ss:=tcanvas.Create;
ss.Handle:=getdc(0);
image:=timage.Create(self);
image.width:=Screen.width;
image.Height:=screen.Height ;
image.picture.bitmap.PixelFormat:= pf16bit;
bitblt(image.canvas.handle,0,0,image.width,image.height,ss.handle,0,0,srccopy);

{大大的BMP流
image.picture.bitmap.SaveToStream(memoryStream);
}

{无损压缩BMP流 //uses Zlib.pas
//先定义变量count,DestStream,SourceStream
image.picture.bitmap.SaveToStream(memoryStream);
Count:=memoryStream.Size;
DestStream:=TMemoryStream.Create;
//压缩方式:clnone,clfastest,cldefault,clmax
SourceStream:=TCompressionStream.Create(cldefault, DestStream);
try
memoryStream.SaveToStream(SourceStream);
SourceStream.Free;
memoryStream.Clear;
memoryStream.WriteBuffer(Count, SizeOf(Count));
memoryStream.CopyFrom(DestStream, 0);
finally
DestStream.Free;
end;
}
{还原BMP流 //uses Zlib.pas
//先定义变量count,buffer,DestStream,SourceStream
//memoryStream是压缩的BMP流
memoryStream.ReadBuffer(Count, SizeOf(Count));
GetMem(Buffer, Count);
DestStream:=TMemoryStream.Create;
SourceStream:=TDecompressionStream.Create(memoryStream);
Try
SourceStream.ReadBuffer(Buffer^, Count);
DestStream.WriteBuffer(Buffer^, Count);
DestStream.Position:=0;
image.Picture.Bitmap.LoadFromStream(DestStream);
finally
FreeMem(Buffer);
DestStream.Free;
end;
}

{JPG流 //uses jpeg
jpgstream:= TJPEGImage.Create;
jpgstream.Assign(image.picture.bitmap);
jpgstream.CompressionQuality:=50;//压缩质量
jpgstream.Compress;
jpgstream.SaveToStream(memoryStream);//保存为JPG流
//使用JPG流 image.Picture.Assign(jpgstream);
jpgstream.free;
}

ReleaseDC(0,ss.Handle);
image.free;

{发送内存流...}
end;
 
jieshou daan
 
一个字:牛
 
两个字:真牛
 
放屁,都放屁。监视另一台计算机的屏幕,这样都不能流畅,每秒至少应有15帧才差不多。
 
三个字:绝对牛
 
林沐:礼貌还是要有的
你注意你的屏幕,如果不是动画,游戏,电影等应用,平均一秒会有多少变化?什么事情
都不是那么绝对的
 
能否将对方机器中的屏幕,显示在我的屏幕的一小块区域(即可以按比例缩小),
而不是1:1地显示
 
装个冰河什么的不就行了吗?
 

Similar threads

D
回复
0
查看
2K
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
回复
0
查看
502
import
I
顶部