用delphi实现冰河的远程屏幕操作功能_Delphi程序_学习笔记★闵涛★计算机学习电脑编程软硬件技巧


	转至繁体中文版	\| 网站首页 \| 图文教程 \| 资源下载 \| 站长博客 \| 图片素材 \| 武汉seo \| 武汉网站优化 \|

用delphi实现冰河的远程屏幕操作功能

作者：闵涛文章来源：闵涛的学习笔记点击数：2844 更新时间：2009/4/23 18:26:07

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

Move(Data[(num-1)*12 + 9], x, sizeof(integer));
Move(Data[(num-1)*12 + 13], y, sizeof(integer));
StopPt.X := x;
StopPt.Y := y;
Windows.ScreenToClient(CurHandle, StopPt);

Add_Window_Drag(CurHandle, StartPt.X, StartPt.Y, StopPt.X, StopPt.Y);

Play;
end;

CreateSleepThread;
end;

procedure TServerForm.ProcessKeys(const Data: string);
begin
with MsgSimulator1 do begin
Messages.Clear;
Add_ASCII_Keys(Data);
Play;
end;

CreateSleepThread;
end;

procedure TServerForm.SendMsg(MsgNum: integer; const MsgData: string; Socket: TCustomWinSocket);
var
s : string;
begin
s := IntToByteStr(MsgNum) + IntToByteStr(Length(MsgData)) + MsgData;

Log(Format(''''%-20s %-4d %1.0n'''', [''''Send'''', MsgNum, Length(s)+0.0]));

Socket.SendText(s);
NumSend := NumSend + Length(s);
UpdateStats;
end;

procedure TServerForm.FormCreate(Sender: TObject);
begin
CurBmp := TBitmap.Create;
SleepTime := 50;
ParseComLine;
end;

procedure TServerForm.FormDestroy(Sender: TObject);
begin
CurBmp.Free;
end;

type
TSleepThread = class(TThread)
public
SleepTime : integer;
procedure Execute; override;
end;

procedure TSleepThread.Execute;
begin
Sleep(SleepTime);
end;

procedure TServerForm.CreateSleepThread;
var
st : TSleepThread;
begin
st := TSleepThread.Create(True);
st.SleepTime := SleepTime;
st.OnTerminate := SleepDone;
st.Resume;
end;

procedure TServerForm.Client1Click(Sender: TObject);
begin
ClientForm.Show;
end;

procedure TServerForm.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
var
rc : integer;
begin
if ServerSocket1.Socket.ActiveConnections > 0 then begin
rc := MessageDlg(''''Clients are still connected, do you want to close?'''',
mtWarning, mbYesNoCancel, 0);
CanClose := (rc = mrYes);
end;
end;

procedure TServerForm.ParseComLine;
var
i : integer;
s : string;
AutoStart : boolean;
begin
AutoStart := False;

for i := 1 to ParamCount do begin
s := UpperCase(ParamStr(i));

if Copy(s, 1, 6) = ''''/PORT:'''' then begin
PortEdit.Text := Copy(s, 7, Length(s));
AutoStart := True;
StartButClick(nil);
MinimizeButClick(nil);
end;

if s = ''''/CLIENT'''' then begin
MinimizeButClick(nil);
AutoStart := True;
end;
end;

if not AutoStart then
Visible := True;
end;

procedure TServerForm.ClientButClick(Sender: TObject);
begin
ClientForm.Show;
end;

end.
下面是客户端
unit ClientFrm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, ExtCtrls, ComCtrls, FormSettings, Menus, StdCtrls, Buttons,
RemConMessages, ZL

上一页 [1] [2] [3] [4] [5] 下一页

没有相关教程

教程录入：mintao 责任编辑：mintao

上一篇教程：在Internet传播声音

下一篇教程：用pascal写的最简单的winsock程序

【字体：小大】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口】

注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网]

　网友评论：（只显示最新10条。评论内容只代表网友观点，与本站立场无关！）

同类栏目

· C语言系列 · VB.NET程序
· JAVA开发 · Delphi程序
· 脚本语言

热门推荐

没有教程

赞助链接

闵涛博文

500 - 内部服务器错误。

您查找的资源存在问题，因而无法显示。

鄂公网安备 42011102001154号

站长：MinTao ICP备案号：鄂ICP备11006601号-18

闵涛站盟:医药大全-武穴网。A打造B、C、D……