delphi怎样捕获客户端的屏幕？？？？？（高分相送)

Question

怎样捕获客户端的屏幕,到GOOGLE中搜索到的我一运行就死机,所以可以的话把写好的例子发到我的[email protected]  谢谢帮助

Answer 1

 
回首页
 网络时空
 飞越新闻
 电子商务
 文章推荐
 免费资源
 开心一刻
 访客留言
 
 
　DELPHI：实现远程屏幕抓取
 --------------------------------------------------------------------------------
 作者：檀革勤　　----在网络管理中，有时需要通过监视远程计算机屏幕来了解网上微机的使用情况。虽然，市面上有很多软件可以实现该功能，有些甚至可以进行远程控制，但在使用上缺乏灵活性，如无法指定远程计算机屏幕区域的大小和位置，进而无法在一屏上同时监视多个屏幕。其实，可以用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后面加入变量定义
为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下调试通过。
 　 

Answer 2

分为服务端和客户端两个部分，虽然不是一个完整的delphi工程，但是我们关心的其中有用的代码，对吧？
下面是服务端
unit ServerDlg;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, WinSock, ScktComp, Menus, TrayIcon, FormSettings,
RemConMessages, ZLib, MsgSimulator, ComCtrls, ShellAPI;type
TServerForm = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
LogList: TListBox;
ServerPanel: TPanel;
Label5: TLabel;
StartLab: TLabel;
Label9: TLabel;
ConLab: TLabel;
Label11: TLabel;
NumRecLab: TLabel;
Label13: TLabel;
NumSendLab: TLabel;
Label3: TLabel;
LastRecLab: TLabel;
Label4: TLabel;
NumErrLab: TLabel;
Panel1: TPanel;
Label1: TLabel;
NameLabel: TLabel;
Label2: TLabel;
PortEdit: TEdit;
Panel2: TPanel;
StartBut: TButton;
DisconBut: TButton;
MinimizeBut: TButton;
ClientBut: TButton;
ServerSocket1: TServerSocket;
TrayIcon1: TTrayIcon;
TrayMenu: TPopupMenu;
RemoteControl1: TMenuItem;
N1: TMenuItem;
Client1: TMenuItem;
N2: TMenuItem;
Shutdown1: TMenuItem;
FormSettings1: TFormSettings;
MsgSimulator1: TMsgSimulator;
Label6: TLabel;
PassEdit: TEdit;
procedure StartButClick(Sender: TObject);
procedure DisconButClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure MinimizeButClick(Sender: TObject);
procedure RemoteControl1Click(Sender: TObject);
procedure Shutdown1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ServerSocket1Listen(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Client1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure ClientButClick(Sender: TObject);
protected
NumRec : double;
NumSend : double;
NumError : integer;
CurMsg : string;
LoggedOn : boolean;
CurBmp : TBitmap;
CurSocket : TCustomWinSocket;
CurHandle : THandle;
SleepTime : integer;
ViewMode : TViewMode;
CompMode : TCompressionLevel;
procedure UpdateStats;
procedure Log(const s: string);
procedure ProcessClick(const Data: string);
procedure ProcessDrag(const Data: string);
procedure Send_Screen_Update(Socket: TCustomWinSocket);
procedure SleepDone(Sender: TObject);
procedure ProcessKeys(const Data: string);
procedure CreateSleepThread;
procedure GetHostNameAddr;
procedure ParseComLine;
function Get_Process_List: string;
procedure CloseWindow(const Data: string);
procedure KillWindow(const Data: string);
function Get_Drive_List: string;
function GetDirectory(const PathName: string): string;
function GetFile(const PathName: string): string;
public
procedure EnableButs;
procedure ProcessMessage(const Msg: string; Socket: TCustomWinSocket);
procedure SendMsg(MsgNum: integer; const MsgData: string; Socket: TCustomWinSocket);
end;var
ServerForm: TServerForm;implementationuses ClientFrm;{$R *.DFM}procedure TServerForm.StartButClick(Sender: TObject);
begin
with ServerSocket1 do begin
Port := StrToInt(PortEdit.Text);
Active := True;
end;
EnableButs;
end;procedure TServerForm.DisconButClick(Sender: TObject);
begin
ServerSocket1.Active := False;
EnableButs;
end;procedure TServerForm.EnableButs;
var
b : boolean;
begin
b := ServerSocket1.Active;StartBut.Enabled := not b;
PortEdit.Enabled := not b;
DisconBut.Enabled := b;
// MinimizeBut.Enabled := b;
end;procedure TServerForm.GetHostNameAddr;
var
buf : array[0..MAX_PATH] of char;
he : PHostEnt;
buf2 : PChar;
rc : integer;
begin
rc := GetHostName(buf, sizeof(buf));if rc<>SOCKET_ERROR then begin
he := GetHostByName(buf);
if he = nil then begin
rc := WSAGetLastError;
NameLabel.Caption := Format('Socket Error %d = %s', [rc, SysErrorMessage(rc)]);
end else begin
buf2 := inet_ntoa(PInAddr(he.h_addr^)^);
NameLabel.Caption := Format('%s (%s)', [buf, buf2]);
end;
end else begin
NameLabel.Caption := 'Unknown Host';
end;
end;procedure TServerForm.FormShow(Sender: TObject);
begin
EnableButs;
GetHostNameAddr;
end;procedure TServerForm.MinimizeButClick(Sender: TObject);
begin
if ServerSocket1.Active then begin
TrayIcon1.ToolTip := Application.Title + ' - Port: ' + PortEdit.Text;
end else begin
TrayIcon1.ToolTip := Application.Title + ' - Inactive';
end;TrayIcon1.Active := True;
ShowWindow(Application.Handle, SW_HIDE);
Hide;
end;procedure TServerForm.RemoteControl1Click(Sender: TObject);
begin
TrayIcon1.Active := False;
ShowWindow(Application.Handle, SW_SHOW);
Application.Restore;
Show;
SetForegroundWindow(Handle);
end;procedure TServerForm.Shutdown1Click(Sender: TObject);
begin
RemoteControl1Click(nil);
Close;
end;procedure TServerForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FormSettings1.SaveSettings;
end;procedure TServerForm.ServerSocket1Listen(Sender: TObject;
Socket: TCustomWinSocket);
begin
StartLab.Caption := CurTime;
NumRec := 0;
NumSend := 0;
CurMsg := '';
LoggedOn := False;
UpdateStats;
Log('Startup at ' + CurTime);
end;procedure TServerForm.UpdateStats;
begin
ConLab.Caption := IntToStr(ServerSocket1.Socket.ActiveConnections);
NumRecLab.Caption := Format('%1.0n', [NumRec]);
NumSendLab.Caption := Format('%1.0n', [NumSend]);
NumErrLab.Caption := IntToStr(NumError);
end;procedure TServerForm.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
s : string;
begin
Log(Format('%-20s %s', ['Recv Data', Socket.RemoteAddress]));LastRecLab.Caption := CurTime;
s := Socket.ReceiveText;
NumRec := NumRec + Length(s);
UpdateStats;CurMsg := CurMsg + s;while IsValidMessage(CurMsg) do begin
s := TrimFirstMsg(CurMsg);
ProcessMessage(s, Socket);
end;
end;procedure TServerForm.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Log(Format('%-20s %s', ['Connect', Socket.RemoteAddress]));ViewMode := vmColor4;
CompMode := clDefault;
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_NORMAL);
UpdateStats;
end;procedure TServerForm.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Log(Format('%-20s %s', ['Disconnect', Socket.RemoteAddress]));UpdateStats;
end;procedure TServerForm.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Log(Format('%-20s %d', ['Error', ErrorCode]));ErrorCode := 0;
Inc(NumError);
UpdateStats;
end;procedure TServerForm.Log(const s: string);
begin
LogList.ItemIndex := LogList.Items.Add(s);
end;procedure TServerForm.ProcessMessage(const Msg: string; Socket: TCustomWinSocket);
var
MsgNum, x: integer;
rc : integer;
Data : string;
bmp : TBitmap;
tmp : string;
begin
CurSocket := Socket;
Move(Msg[1], MsgNum, sizeof(integer));
Data := Copy(Msg, 9, Length(Msg));Log(Format('%-20s %d', ['Message', MsgNum]));if MsgNum = MSG_LOGON then begin
LoggedOn := (AnsiCompareText(Data, PassEdit.Text) = 0);
if LoggedOn then begin
SendMsg(MSG_LOGON, '1', Socket)
end else begin
SendMsg(MSG_LOGON, '0', Socket);
end;
exit;
end;if not LoggedOn then begin
Log('Denied Access!');
SendMsg(MSG_STAT_MSG, 'Invalid Password', Socket);
Socket.Close;
exit;
end;

Answer 3

if MsgNum = MSG_REFRESH then begin
Log('Screen Capture');
SendMsg(MSG_STAT_MSG, 'Screen Capture', Socket);
GetScreen(bmp, ViewMode);
Log('Compressing Bitmap');
SendMsg(MSG_STAT_MSG, 'Screen Compression', Socket);
CompressBitmap(bmp, tmp);
SaveString(tmp, 'Temp1.txt');
SendMsg(MSG_REFRESH, tmp, Socket);
CurBmp.Assign(bmp);
bmp.Free;
end;if MsgNum = MSG_SCREEN_UPDATE then begin
Send_Screen_Update(Socket);
end;if MsgNum = MSG_CLICK then begin
SendMsg(MSG_STAT_MSG, 'Simulating Input', Socket);
ProcessClick(Data);
// SleepDone will be called when it is finished
end;if MsgNum = MSG_DRAG then begin
SendMsg(MSG_STAT_MSG, 'Simulating Input', Socket);
ProcessDrag(Data);
// SleepDone will be called when it is finished
end;if MsgNum = MSG_KEYS then begin
SendMsg(MSG_STAT_MSG, 'Simulating Input', Socket);
ProcessKeys(Data);
// SleepDone will be called when it is finished
end;if MsgNum = MSG_SEVER_DELAY then begin
Move(Data[1], SleepTime, sizeof(integer));
SendMsg(MSG_SEVER_DELAY, '', Socket);
end;if MsgNum = MSG_VIEW_MODE then begin
Move(Data[1], x, sizeof(integer));
ViewMode := TViewMode(x);
SendMsg(MSG_VIEW_MODE, '', Socket);
end;if MsgNum = MSG_FOCUS_SERVER then begin
if TrayIcon1.Active then RemoteControl1Click(nil);
SetFocus;
CreateSleepThread;
// SleepDone will be called when it is finished
end;if MsgNum = MSG_COMP_MODE then begin
Move(Data[1], x, sizeof(integer));
CompMode := TCompressionLevel(x);
SendMsg(MSG_COMP_MODE, '', Socket);
end;if MsgNum = MSG_PRIORITY_MODE then begin
Move(Data[1], x, sizeof(integer));
SetThreadPriority(GetCurrentThread, x);
SendMsg(MSG_PRIORITY_MODE, '', Socket);
end;if MsgNum = MSG_PROCESS_LIST then begin
SendMsg(MSG_PROCESS_LIST, Get_Process_List, Socket);
end;if MsgNum = MSG_CLOSE_WIN then begin
CloseWindow(Data);
end;if MsgNum = MSG_KILL_WIN then begin
KillWindow(Data);
end;if MsgNum = MSG_DRIVE_LIST then begin
SendMsg(MSG_DRIVE_LIST, Get_Drive_List, Socket);
end;if MsgNum = MSG_DIRECTORY then begin
SendMsg(MSG_DIRECTORY, GetDirectory(Data), Socket);
end;if MsgNum = MSG_FILE then begin
SendMsg(MSG_FILE, GetFile(Data), Socket);
end;if MsgNum = MSG_REMOTE_LAUNCH then begin
SendMsg(MSG_STAT_MSG, 'Launching File: ' + Data, Socket);
rc := ShellExecute(Handle, 'open', PChar(Data), nil, nil, SW_SHOWNORMAL);
if rc <= 32 then begin
Data := Format('ShellExecute Error #%d Launching %s', [rc, Data]);
SendMsg(MSG_REMOTE_LAUNCH, Data, Socket);
end else begin
SendMsg(MSG_REMOTE_LAUNCH, Data, Socket);
end;
end;
end;function EnumWinProc(hw: THandle; lp: LParam): boolean; stdcall;
var
sl : TStringList;
buf : array[0..MAX_PATH] of char;
s, iv : string;
begin
sl := TStringList(lp);
GetWindowText(hw, buf, sizeof(buf));
if buf<>'' then begin
if IsWindowVisible(hw) then iv := '' else iv := '(Invisible)';
s := Format('%8.8x - %-32s %s', [hw, buf, iv]);
sl.AddObject(s, TObject(hw));
end;
Result := True;
end;function TServerForm.Get_Process_List: string;
var
sl : TStringList;
begin
sl := TStringList.Create;
EnumWindows(@EnumWinProc, integer(sl));
Result := sl.Text;
sl.Free;
end;function TServerForm.Get_Drive_List: string;
var
DriveBits : integer;
i : integer;
begin
Result := '';
DriveBits := GetLogicalDrives;
for i := 0 to 25 do begin
if (DriveBits and (1 shl i)) <> 0 then
Result := Result + Chr(Ord('A') + i) + ':\' + #13#10;
end;
end;function TServerForm.GetDirectory(const PathName: string): string;
var
DirList : TStringList;
CommaList : TStringList;
sr : TSearchRec;
s : string;
dt : TDateTime;
begin
DirList := TStringList.Create;
CommaList := TStringList.Create;if FindFirst(PathName, faAnyFile, sr) = 0 then repeat
CommaList.Clear;
s := sr.Name;
if (s = '.') or (s = '..') then continue;if (sr.Attr and faDirectory) <> 0 then s := s + '\';
CommaList.Add(s);
s := Format('%1.0n', [sr.Size+0.0]);
CommaList.Add(s);
dt := FileDateToDateTime(sr.Time);
s := FormatDateTime('yyyy-mm-dd hh:nn ampm', dt);
CommaList.Add(s);DirList.Add(CommaList.CommaText);
until FindNext(sr) <> 0;
FindClose(sr);Result := DirList.Text;CommaList.Free;
DirList.Free;
end;function TServerForm.GetFile(const PathName: string): string;
var
fs : TFileStream;
begin
fs := TFileStream.Create(PathName, fmOpenRead or fmShareDenyWrite);
SetLength(Result, fs.Size);
fs.Read(Result[1], fs.Size);
fs.Free;
end;procedure TServerForm.CloseWindow(const Data: string);
var
sl : TStringList;
i : integer;
hw : THandle;
begin
sl := TStringList.Create;
EnumWindows(@EnumWinProc, integer(sl));
i := sl.IndexOf(Data);
if i<>-1 then begin
hw := THandle(sl.Objects[i]);SendMessage(hw, WM_CLOSE, 0, 0);Sleep(SleepTime);
SendMsg(MSG_PROCESS_LIST, Get_Process_List, CurSocket);
end;
sl.Free;
end;procedure TServerForm.KillWindow(const Data: string);
var
sl : TStringList;
i : integer;
hw : THandle;
ProcID : integer;
hProc : THandle;
begin
sl := TStringList.Create;
EnumWindows(@EnumWinProc, integer(sl));
i := sl.IndexOf(Data);
if i<>-1 then begin
hw := THandle(sl.Objects[i]);GetWindowThreadProcessId(hw, @ProcID);
hProc := OpenProcess(PROCESS_ALL_ACCESS, False, ProcID);
TerminateProcess(hProc, DWORD(-1));
CloseHandle(hProc);Sleep(SleepTime);
SendMsg(MSG_PROCESS_LIST, Get_Process_List, CurSocket);
end;
sl.Free;
end;procedure TServerForm.SleepDone(Sender: TObject);
begin
Send_Screen_Update(CurSocket);
end;procedure TServerForm.Send_Screen_Update(Socket: TCustomWinSocket);
var
bmp, dif : TBitmap;
R : TRect;
tmp : string;
begin
Log('Screen Capture');
SendMsg(MSG_STAT_MSG, 'Screen Capture', Socket);
GetScreen(bmp, ViewMode);
Log('Creating Diff Image');
dif := TBitmap.Create;
dif.Assign(bmp);
R := Rect(0, 0, dif.Width, dif.Height);
SendMsg(MSG_STAT_MSG, 'Screen Difference', Socket);
dif.Canvas.CopyMode := cmSrcInvert;
dif.Canvas.CopyRect(R, CurBmp.Canvas, R);Log('Compressing Bitmap');
SendMsg(MSG_STAT_MSG, 'Screen Compression', Socket);
CompressBitmap(dif, tmp);SendMsg(MSG_SCREEN_UPDATE, tmp, Socket);
CurBmp.Assign(bmp);dif.Free;
bmp.Free;
end;function GetMB(but: integer): TMouseButton;
begin
case but of
1 : Result := mbLeft;
2 : Result := mbRight;
else Result := mbLeft;
end;
end;procedure TServerForm.ProcessClick(const Data: string);
var
x, y, i : integer;
num, but : integer;
p : TPoint;
begin
Move(Data[1], x, sizeof(integer));
Move(Data[1+4], y, sizeof(integer));
Move(Data[1+8], num, sizeof(integer));
Move(Data[1+12], but, sizeof(integer));// Find the Window Handle
p := Point(x, y);
CurHandle := WindowFromPoint(p);
Assert(CurHandle<>0);SetCursorPos(x, y);// Create the Messages to send in the Hook procedure
with MsgSimulator1 do begin
Messages.Clear;
for i := 1 to num do
Add_ClickEx(0, GetMB(but), [], x, y, 1);
Play;
end;CreateSleepThread;
end;procedure TServerForm.ProcessDrag(const Data: string);
var
x, y : integer;
time : integer;
num, but : integer;
p : TPoint;
StartPt : TPoint;
StopPt : TPoint;
begin
Move(Data[1], but, sizeof(integer));
Move(Data[1+4], num, sizeof(integer));
Assert(num > 2);// Create the Messages to send in the Hook procedure
// Mouse Down
Move(Data[(1-1)*12 + 9], x, sizeof(integer));
Move(Data[(1-1)*12 + 13], y, sizeof(integer));
Move(Data[(1-1)*12 + 17], time, sizeof(integer));
SetCursorPos(x, y);
// Find the Window Handle
p := Point(x, y);
CurHandle := WindowFromPoint(p);
Assert(CurHandle<>0);with MsgSimulator1 do begin
Messages.Clear;StartPt.X := x;
StartPt.Y := y;
Windows.ScreenToClient(CurHandle, StartPt);