分为服务端和客户端两个部分，虽然不是一个完整的delphi工程，但是我们关心的其中有用的代码，对吧？下面是服务端unit ServerDlg;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ExtCtrls, StdCtrls, WinSock, ScktComp, Menus, TrayIcon, FormSettings,RemConMessages, ZLib, MsgSimulator, ComCtrls, ShellAPI;typeTServerForm = 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);protectedNumRec : 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;publicprocedure EnableButs;procedure ProcessMessage(const Msg: string; Socket: TCustomWinSocket);procedure SendMsg(MsgNum: integer; const MsgData: string; Socket: TCustomWinSocket);end;varServerForm: TServerForm;implementationuses ClientFrm;{$R *.DFM}procedure TServerForm.StartButClick(Sender: TObject);beginwith ServerSocket1 do beginPort := StrToInt(PortEdit.Text);Active := True;end;EnableButs;end;procedure TServerForm.DisconButClick(Sender: TObject);beginServerSocket1.Active := False;EnableButs;end;procedure TServerForm.EnableButs;varb : boolean;beginb := ServerSocket1.Active;StartBut.Enabled := not b;PortEdit.Enabled := not b;DisconBut.Enabled := b;// MinimizeBut.Enabled := b;end;procedure TServerForm.GetHostNameAddr;varbuf : array[0..MAX_PATH] of char;he : PHostEnt;buf2 : PChar;rc : integer;beginrc := GetHostName(buf, sizeof(buf));if rc<>SOCKET_ERROR then beginhe := GetHostByName(buf);if he = nil then beginrc := WSAGetLastError;NameLabel.Caption := Format('Socket Error %d = %s', [rc, SysErrorMessage(rc)]);end else beginbuf2 := inet_ntoa(PInAddr(he.h_addr^)^);NameLabel.Caption := Format('%s (%s)', [buf, buf2]);end;end else beginNameLabel.Caption := 'Unknown Host';end;end;procedure TServerForm.FormShow(Sender: TObject);beginEnableButs;GetHostNameAddr;end;procedure TServerForm.MinimizeButClick(Sender: TObject);beginif ServerSocket1.Active then beginTrayIcon1.ToolTip := Application.Title + ' - Port: ' + PortEdit.Text;end else beginTrayIcon1.ToolTip := Application.Title + ' - Inactive';end;TrayIcon1.Active := True;ShowWindow(Application.Handle, SW_HIDE);Hide;end;procedure TServerForm.RemoteControl1Click(Sender: TObject);beginTrayIcon1.Active := False;ShowWindow(Application.Handle, SW_SHOW);Application.Restore;Show;SetForegroundWindow(Handle);end;procedure TServerForm.Shutdown1Click(Sender: TObject);beginRemoteControl1Click(nil);Close;end;procedure TServerForm.FormClose(Sender: TObject; var Action: TCloseAction);beginFormSettings1.SaveSettings;end;procedure TServerForm.ServerSocket1Listen(Sender: TObject;Socket: TCustomWinSocket);beginStartLab.Caption := CurTime;NumRec := 0;NumSend := 0;CurMsg := '';LoggedOn := False;UpdateStats;Log('Startup at ' + CurTime);end;procedure TServerForm.UpdateStats;beginConLab.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);vars : string;beginLog(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 begins := TrimFirstMsg(CurMsg);ProcessMessage(s, Socket);end;end;procedure TServerForm.ServerSocket1ClientConnect(Sender: TObject;Socket: TCustomWinSocket);beginLog(Format('%-20s %s', ['Connect', Socket.RemoteAddress]));ViewMode := vmColor4;CompMode := clDefault;SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_NORMAL);UpdateStats;end;procedure TServerForm.ServerSocket1ClientDisconnect(Sender: TObject;Socket: TCustomWinSocket);beginLog(Format('%-20s %s', ['Disconnect', Socket.RemoteAddress]));UpdateStats;end;procedure TServerForm.ServerSocket1ClientError(Sender: TObject;Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;var ErrorCode: Integer);beginLog(Format('%-20s %d', ['Error', ErrorCode]));ErrorCode := 0;Inc(NumError);UpdateStats;end;procedure TServerForm.Log(const s: string);beginLogList.ItemIndex := LogList.Items.Add(s);end;procedure TServerForm.ProcessMessage(const Msg: string; Socket: TCustomWinSocket);varMsgNum, x: integer;rc : integer;Data : string;bmp : TBitmap;tmp : string;beginCurSocket := Socket;Move(Msg[1], MsgNum, sizeof(integer));Data := Copy(Msg, 9, Length(Msg));Log(Format('%-20s %d', ['Message', MsgNum]));if MsgNum = MSG_LOGON then beginLoggedOn := (AnsiCompareText(Data, PassEdit.Text) = 0);if LoggedOn then beginSendMsg(MSG_LOGON, '1', Socket)end else beginSendMsg(MSG_LOGON, '0', Socket);end;exit;end;if not LoggedOn then beginLog('Denied Access!');SendMsg(MSG_STAT_MSG, 'Invalid Password', Socket);Socket.Close;exit;end;if MsgNum = MSG_REFRESH then beginLog('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 beginSend_Screen_Update(Socket);end;if MsgNum = MSG_CLICK then beginSendMsg(MSG_STAT_MSG, 'Simulating Input', Socket);ProcessClick(Data);// SleepDone will be called when it is finishedend;if MsgNum = MSG_DRAG then beginSendMsg(MSG_STAT_MSG, 'Simulating Input', Socket);ProcessDrag(Data);// SleepDone will be called when it is finishedend;if MsgNum = MSG_KEYS then beginSendMsg(MSG_STAT_MSG, 'Simulating Input', Socket);ProcessKeys(Data);// SleepDone will be called when it is finishedend;if MsgNum = MSG_SEVER_DELAY then beginMove(Data[1], SleepTime, sizeof(integer));SendMsg(MSG_SEVER_DELAY, '', Socket);end;if MsgNum = MSG_VIEW_MODE then beginMove(Data[1], x, sizeof(integer));ViewMode := TViewMode(x);SendMsg(MSG_VIEW_MODE, '', Socket);end;if MsgNum = MSG_FOCUS_SERVER then beginif TrayIcon1.Active then RemoteControl1Click(nil);SetFocus;CreateSleepThread;// SleepDone will be called when it is finishedend;if MsgNum = MSG_COMP_MODE then beginMove(Data[1], x, sizeof(integer));CompMode := TCompressionLevel(x);SendMsg(MSG_COMP_MODE, '', Socket);end;if MsgNum = MSG_PRIORITY_MODE then beginMove(Data[1], x, sizeof(integer));SetThreadPriority(GetCurrentThread, x);SendMsg(MSG_PRIORITY_MODE, '', Socket);end;if MsgNum = MSG_PROCESS_LIST then beginSendMsg(MSG_PROCESS_LIST, Get_Process_List, Socket);end;if MsgNum = MSG_CLOSE_WIN then beginCloseWindow(Data);end;if MsgNum = MSG_KILL_WIN then beginKillWindow(Data);end;if MsgNum = MSG_DRIVE_LIST then beginSendMsg(MSG_DRIVE_LIST, Get_Drive_List, Socket);end;if MsgNum = MSG_DIRECTORY then beginSendMsg(MSG_DIRECTORY, GetDirectory(Data), Socket);end;if MsgNum = MSG_FILE then beginSendMsg(MSG_FILE, GetFile(Data), Socket);end;if MsgNum = MSG_REMOTE_LAUNCH then beginSendMsg(MSG_STAT_MSG, 'Launching File: ' + Data, Socket);rc := ShellExecute(Handle, 'open', PChar(Data), nil, nil, SW_SHOWNORMAL);if rc <= 32 then beginData := Format('ShellExecute Error #%d Launching %s', [rc, Data]);SendMsg(MSG_REMOTE_LAUNCH, Data, Socket);end else beginSendMsg(MSG_REMOTE_LAUNCH, Data, Socket);end;end;end;function EnumWinProc(hw: THandle; lp: LParam): boolean; stdcall;varsl : TStringList;buf : array[0..MAX_PATH] of char;s, iv : string;beginsl := TStringList(lp);GetWindowText(hw, buf, sizeof(buf));if buf<>'' then beginif 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;varsl : TStringList;beginsl := TStringList.Create;EnumWindows(@EnumWinProc, integer(sl));Result := sl.Text;sl.Free;end;function TServerForm.Get_Drive_List: string;varDriveBits : integer;i : integer;beginResult := '';DriveBits := GetLogicalDrives;for i := 0 to 25 do beginif (DriveBits and (1 shl i)) <> 0 thenResult := Result + Chr(Ord('A') + i) + ':/' + #13#10;end;end;function TServerForm.GetDirectory(const PathName: string): string;varDirList : TStringList;CommaList : TStringList;sr : TSearchRec;s : string;dt : TDateTime;beginDirList := TStringList.Create;CommaList := TStringList.Create;if FindFirst(PathName, faAnyFile, sr) = 0 then repeatCommaList.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;varfs : TFileStream;beginfs := 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);varsl : TStringList;i : integer;hw : THandle;beginsl := TStringList.Create;EnumWindows(@EnumWinProc, integer(sl));i := sl.IndexOf(Data);if i<>-1 then beginhw := 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);varsl : TStringList;i : integer;hw : THandle;ProcID : integer;hProc : THandle;beginsl := TStringList.Create;EnumWindows(@EnumWinProc, integer(sl));i := sl.IndexOf(Data);if i<>-1 then beginhw := 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);beginSend_Screen_Update(CurSocket);end;procedure TServerForm.Send_Screen_Update(Socket: TCustomWinSocket);varbmp, dif : TBitmap;R : TRect;tmp : string;beginLog('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;begincase but of1 : Result := mbLeft;2 : Result := mbRight;else Result := mbLeft;end;end;procedure TServerForm.ProcessClick(const Data: string);varx, y, i : integer;num, but : integer;p : TPoint;beginMove(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 Handlep := Point(x, y);CurHandle := WindowFromPoint(p);Assert(CurHandle<>0);SetCursorPos(x, y);// Create the Messages to send in the Hook procedurewith MsgSimulator1 do beginMessages.Clear;for i := 1 to num doAdd_ClickEx(0, GetMB(but), [], x, y, 1);Play;end;CreateSleepThread;end;procedure TServerForm.ProcessDrag(const Data: string);varx, y : integer;time : integer;num, but : integer;p : TPoint;StartPt : TPoint;StopPt : TPoint;beginMove(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 DownMove(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 Handlep := Point(x, y);CurHandle := WindowFromPoint(p);Assert(CurHandle<>0);with MsgSimulator1 do beginMessages.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);beginwith MsgSimulator1 do beginMessages.Clear;Add_ASCII_Keys(Data);Play;end;CreateSleepThread;end;procedure TServerForm.SendMsg(MsgNum: integer; const MsgData: string; Socket: TCustomWinSocket);vars : string;begins := 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);beginCurBmp := TBitmap.Create;SleepTime := 50;ParseComLine;end;procedure TServerForm.FormDestroy(Sender: TObject);beginCurBmp.Free;end;typeTSleepThread = class(TThread)publicSleepTime : integer;procedure Execute; override;end;procedure TSleepThread.Execute;beginSleep(SleepTime);end;procedure TServerForm.CreateSleepThread;varst : TSleepThread;beginst := TSleepThread.Create(True);st.SleepTime := SleepTime;st.OnTerminate := SleepDone;st.Resume;end;procedure TServerForm.Client1Click(Sender: TObject);beginClientForm.Show;end;procedure TServerForm.FormCloseQuery(Sender: TObject;var CanClose: Boolean);varrc : integer;beginif ServerSocket1.Socket.ActiveConnections > 0 then beginrc := MessageDlg('Clients are still connected, do you want to close?',mtWarning, mbYesNoCancel, 0);CanClose := (rc = mrYes);end;end;procedure TServerForm.ParseComLine;vari : integer;s : string;AutoStart : boolean;beginAutoStart := False;for i := 1 to ParamCount do begins := UpperCase(ParamStr(i));if Copy(s, 1, 6) = '/PORT:' then beginPortEdit.Text := Copy(s, 7, Length(s));AutoStart := True;StartButClick(nil);MinimizeButClick(nil);end;if s = '/CLIENT' then beginMinimizeButClick(nil);AutoStart := True;end;end;if not AutoStart thenVisible := True;end;procedure TServerForm.ClientButClick(Sender: TObject);beginClientForm.Show;end;end.下面是客户端unit ClientFrm;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ScktComp, ExtCtrls, ComCtrls, FormSettings, Menus, StdCtrls, Buttons,RemConMessages, ZLib;constDEFAULT_SERVER_DELAY = 500;DEFAULT_VIEW_MODE = vmColor4;DEFAULT_COMP_MODE = clDefault;DEFAULT_SVR_PRIORITY = THREAD_PRIORITY_HIGHEST;typeTMoveObj = classX, Y : integer;Time : integer;end;TClientForm = class(TForm)StatPanel: TPanel;StatusBar1: TStatusBar;ScrollBox1: TScrollBox;Image1: TImage;ClientSocket1: TClientSocket;Timer1: TTimer;MainMenu1: TMainMenu;File1: TMenuItem;Connect1: TMenuItem;N1: TMenuItem;Exit1: TMenuItem;Disconnect1: TMenuItem;View1: TMenuItem;RefreshComplete1: TMenuItem;UpdateChanges1: TMenuItem;ResponseTimer: TTimer;ClickTimer: TTimer;Options1: TMenuItem;ServerPause1: TMenuItem;N005sec1: TMenuItem;N010sec1: TMenuItem;N050sec1: TMenuItem;N100sec1: TMenuItem;N200sec1: TMenuItem;N500sec1: TMenuItem;LogList: TListBox;Splitter1: TSplitter;N2: TMenuItem;Log1: TMenuItem;CommStat1: TMenuItem;N3: TMenuItem;Shutdown1: TMenuItem;Special1: TMenuItem;FocusServerWindow1: TMenuItem;BitmapFormat1: TMenuItem;Color4: TMenuItem;Gray4: TMenuItem;Gray8: TMenuItem;Color24: TMenuItem;Default1: TMenuItem;WaitImage: TImage;CompressionLevel1: TMenuItem;HighSlow1: TMenuItem;Medium1: TMenuItem;LowFast1: TMenuItem;ServerPriority1: TMenuItem;Critical1: TMenuItem;Highest1: TMenuItem;AboveNormal1: TMenuItem;Normal1: TMenuItem;BelowNormal1: TMenuItem;Lowest1: TMenuItem;Idle1: TMenuItem;N4: TMenuItem;ScaleImage1: TMenuItem;ProcessList1: TMenuItem;N5: TMenuItem;FileList1: TMenuItem;Panel1: TPanel;SendCRBut: TSpeedButton;SendBut: TSpeedButton;SendPanel: TPanel;SendEdit: TEdit;Help1: TMenuItem;About1: TMenuItem;StatBarMenu: TMenuItem;FullScreen1: TMenuItem;procedure FormShow(Sender: TObject);procedure Timer1Timer(Sender: TObject);procedure FormClose(Sender: TObject; var Action: TCloseAction);procedure ClientSocket1Lookup(Sender: TObject;Socket: TCustomWinSocket);procedure ClientSocket1Connecting(Sender: TObject;Socket: TCustomWinSocket);procedure ClientSocket1Connect(Sender: TObject;Socket: TCustomWinSocket);procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;ErrorEvent: TErrorEvent; var ErrorCode: Integer);procedure Exit1Click(Sender: TObject);procedure Connect1Click(Sender: TObject);procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);procedure ClientSocket1Disconnect(Sender: TObject;Socket: TCustomWinSocket);procedure Disconnect1Click(Sender: TObject);procedure RefreshComplete1Click(Sender: TObject);procedure UpdateChanges1Click(Sender: TObject);procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);procedure ResponseTimerTimer(Sender: TObject);procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);procedure Image1Click(Sender: TObject);procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);procedure Image1DblClick(Sender: TObject);procedure ClickTimerTimer(Sender: TObject);procedure PauseChange(Sender: TObject);procedure SendButClick(Sender: TObject);procedure SendCRButClick(Sender: TObject);procedure Log1Click(Sender: TObject);procedure CommStat1Click(Sender: TObject);procedure FormCreate(Sender: TObject);procedure Shutdown1Click(Sender: TObject);procedure FormDestroy(Sender: TObject);procedure FocusServerWindow1Click(Sender: TObject);procedure ColorClick(Sender: TObject);procedure CompClick(Sender: TObject);procedure PriorityClick(Sender: TObject);procedure ScaleImage1Click(Sender: TObject);procedure ProcessList1Click(Sender: TObject);procedure FileList1Click(Sender: TObject);procedure SendPanelResize(Sender: TObject);procedure About1Click(Sender: TObject);procedure StatBarMenuClick(Sender: TObject);procedure FullScreen1Click(Sender: TObject);procedure FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);protectedNumRec : double;NumSend : double;CurMsg : string;NeedReply : integer;LastX : integer;LastY : integer;t1 : DWORD;but : integer;NumClick : integer;MoveList : TList;Anim : integer;LastRec : DWORD;ServerDelay: integer;ViewMode : TViewMode;CompMode : TCompressionLevel;SvrPriority: integer;ProcForm : TForm;FileForm : TForm;LastCPS : string;BeforeFull : TRect;procedure SetStat(i: integer; s: string);procedure UpdateStats;procedure SendText(const Text: string);procedure Log(const s: string);procedure EnableButs;procedure ClearMoveList;procedure AddMove(x, y: integer);procedure ParseComLine;procedure StopAnim;procedure StartAnim;procedure EnableInput;procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;function CanSendMenuMsg: boolean;procedure Send_Current_Settings;procedure ScaleXY(var X, Y: integer);procedure UpdateLogVis;publicprocedure SendMsg(MsgNum: integer; const MsgData: string; Socket: TCustomWinSocket);procedure ProcessMessage(const Msg: string; Socket: TCustomWinSocket);property Stat[i: integer]: string write SetStat;end;varClientForm: TClientForm;implementationuses ConnectDlg, ProcListDlg, FilesDlg, About, FsTopDlg;{$R *.DFM}procedure TClientForm.FormShow(Sender: TObject);beginUpdateLogVis;if not ClientSocket1.Active thenTimer1.Enabled := True;end;function IsDotAddress(const s: string): boolean;vari : integer;beginResult := True;for i := 1 to Length(s) doif not (s[i] in ['0'..'9', '.']) then Result := False;end;procedure TClientForm.Timer1Timer(Sender: TObject);varf : TForm;beginTimer1.Enabled := False;f := Self;with ClientConnectForm do beginLeft := (f.Left + f.Width div 2) - Width div 2;Top := (f.Top + f.Height div 2) - Height div 2;if ShowModal = mrOK then with ClientSocket1 do beginif IsDotAddress(ServerCombo.Text) then beginHost := '';Address := ServerCombo.Text;end else beginAddress := '';Host := ServerCombo.Text;end;Port := StrToInt(PortEdit.Text);StartAnim;Active := True;end;end;end;procedure TClientForm.FormClose(Sender: TObject; var Action: TCloseAction);beginif BorderStyle<>bsNone then FormSettings1.SaveSettings;Disconnect1Click(nil);end;procedure TClientForm.ClientSocket1Lookup(Sender: TObject;Socket: TCustomWinSocket);beginStat[0] := ('Looking up: ' + ClientSocket1.Host);end;procedure TClientForm.SetStat(i: integer; s: string);beginFSTopForm.StatLabel.Caption := s;StatusBar1.Panels[i].Text := s;Update;end;procedure TClientForm.ClientSocket1Connecting(Sender: TObject;Socket: TCustomWinSocket);beginStat[0] := ('Connecting: ' + ClientSocket1.Host);end;procedure TClientForm.ClientSocket1Connect(Sender: TObject;Socket: TCustomWinSocket);beginLog(Format('%-7s %s', ['LogOn', DateTimeToStr(Now)]));EnableButs;Stat[0] := ('Connected: ' + Socket.RemoteHost);Caption := 'Remote Control Client - ' + Socket.RemoteHost;NumSend := 0;NumRec := 0;NeedReply := 0;StopAnim;EnableInput;SendMsg(MSG_LOGON, ClientConnectForm.PassEdit.Text, ClientSocket1.Socket);Send_Current_Settings;end;procedure TClientForm.ClientSocket1Error(Sender: TObject;Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;var ErrorCode: Integer);beginStat[0] := ('Error: ' + IntToStr(ErrorCode));ErrorCode := 0;if not Socket.Connected then StopAnim;end;procedure TClientForm.Exit1Click(Sender: TObject);beginClose;end;procedure TClientForm.Connect1Click(Sender: TObject);beginImage1.Picture.Bitmap := nil;Timer1Timer(nil);end;procedure TClientForm.SendMsg(MsgNum: integer; const MsgData: string; Socket: TCustomWinSocket);vars : string;beginLog(Format('%-7s #%2.2d', ['Send', MsgNum]));Stat[0] := Format('Sending Message (Len = %1.0n)', [Length(MsgData)+0.0]);s := IntToByteStr(MsgNum) + IntToByteStr(Length(MsgData)) + MsgData;Socket.SendText(s);NumSend := NumSend + Length(s);UpdateStats;Inc(NeedReply);StartAnim;end;procedure TClientForm.UpdateStats;begin// Stat[0] := Format('Sent: %1.0n', [NumSend]);// Stat[1] := Format('Recv: %1.0n', [NumRec]);end;procedure TClientForm.ClientSocket1Read(Sender: TObject;Socket: TCustomWinSocket);vars : string;msg : integer;len : integer;PerStr : string;tdif : double;cps : string;begin// WaitImage.Hint := 'Data Last Received:' + #13#10 + CurTime;s := Socket.ReceiveText;NumRec := NumRec + Length(s);UpdateStats;if CurMsg = '' then LastRec := GetTickCount;CurMsg := CurMsg + s;if Length(CurMsg) >= 8 then beginMove(CurMsg[1], msg, sizeof(integer));Move(CurMsg[5], len, sizeof(integer));PerStr := Format('(%1.0n%%)', [Length(CurMsg) / (len + 8.0) * 100.0]);tdif := (GetTickCount - LastRec) / 1000.0;if tdif > 0.5 then cps := Format('%1.0n cps', [Length(CurMsg) / tdif])else cps := '';Stat[0] := Format('Received: %1.0n of %1.0n %s %s',[Length(CurMsg) + 0.0, len + 8.0, PerStr, cps]);LastCPS := cps;end else beginif Length(s) > 0 thenStat[0] := 'Received: ' + IntToStr(Length(CurMsg));end;while IsValidMessage(CurMsg) do begins := TrimFirstMsg(CurMsg);ProcessMessage(s, Socket);end;end;procedure TClientForm.ProcessMessage(const Msg: string; Socket: TCustomWinSocket);varMsgNum : integer;Data : string;bmp : TBitmap;R : TRect;beginMove(Msg[1], MsgNum, sizeof(integer));if MsgNum <> MSG_STAT_MSG thenLog(Format('%-7s #%0.2d %6.0n bytes %s', ['Recv', MsgNum, Length(Msg)+0.0, LastCPS]));Data := Copy(Msg, 9, Length(Msg));if MsgNum = MSG_STAT_MSG then beginStat[0] := Data;exit;end;Dec(NeedReply);if NeedReply = 0 then beginStopAnim;end;if MsgNum = MSG_LOGON then beginif Data <> '0' then beginStat[0] := 'Log on Successful';if ClientConnectForm.StartScreenBox.Checked thenSendMsg(MSG_REFRESH, '', ClientSocket1.Socket);end else beginStat[0] := 'Invalid Password!';MessageDlg('Invalid Password!', mtWarning, [mbOK], 0);end;end;if MsgNum = MSG_REFRESH then beginStat[0] := 'Decompressing';SaveString(Data, 'Temp2.txt');UnCompressBitmap(Data, Image1.Picture.Bitmap);Stat[0] := 'Ready';end;if MsgNum = MSG_SCREEN_UPDATE then beginbmp := TBitmap.Create;Stat[0] := 'Decompressing';UnCompressBitmap(Data, bmp);R := Rect(0, 0, bmp.Width, bmp.Height);with Image1.Picture.Bitmap.Canvas do beginCopyMode := cmSrcInvert;CopyRect(R, bmp.Canvas, R);end;Stat[0] := 'Ready';bmp.Free;end;if MsgNum = MSG_SEVER_DELAY then beginStat[0] := 'Server Delay Set';end;if MsgNum = MSG_VIEW_MODE then beginStat[0] := 'View Mode Set';end;if MsgNum = MSG_COMP_MODE then beginStat[0] := 'Compression Mode Set';end;if MsgNum = MSG_PRIORITY_MODE then beginStat[0] := 'Priority Mode Set';end;if MsgNum = MSG_PROCESS_LIST then beginif ProcForm = nil thenProcForm := TProcListForm.Create(Self);(ProcForm as TProcListForm).SetList(Data);ProcForm.Show;Stat[0] := 'Received Process List';end;if MsgNum = MSG_DRIVE_LIST then beginif FileForm = nil thenFileForm := TFilesForm.Create(Self);(FileForm as TFilesForm).SetDriveList(Data);FileForm.Show;Stat[0] := 'Received Drive List';end;if MsgNum = MSG_DIRECTORY then beginAssert(FileForm <> nil);(FileForm as TFilesForm).SetDirData(Data);FileForm.Show;Stat[0] := 'Received Directory';end;if MsgNum = MSG_FILE then beginAssert(FileForm <> nil);Stat[0] := 'Received File';(FileForm as TFilesForm).SetFileData(Data);end;if MsgNum = MSG_REMOTE_LAUNCH then beginStat[0] := 'Launched File: ' + Data;end;end;procedure TClientForm.ClientSocket1Disconnect(Sender: TObject;Socket: TCustomWinSocket);beginLog(Format('%-7s %s', ['LogOff', DateTimeToStr(Now)]));ClientSocket1.Active := False;EnableButs;Stat[0] := ('Disconnected: ' + Socket.RemoteHost);Caption := 'Remote Control Client';StopAnim;end;procedure TClientForm.Disconnect1Click(Sender: TObject);beginStat[0] := 'Disconnecting...';ClientSocket1.Active := False;EnableButs;StopAnim;end;procedure TClientForm.RefreshComplete1Click(Sender: TObject);beginSendMsg(MSG_REFRESH, '', ClientSocket1.Socket);end;procedure TClientForm.UpdateChanges1Click(Sender: TObject);beginSendMsg(MSG_SCREEN_UPDATE, '', ClientSocket1.Socket);end;procedure TClientForm.Image1MouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer);beginScaleXY(X, Y);LastX := X;LastY := Y;AddMove(X, Y);end;procedure TClientForm.AddMove(x, y: integer);varMoveObj : TMoveObj;beginMoveObj := TMoveObj.Create;MoveObj.X := X;MoveObj.Y := Y;MoveObj.Time := GetTickCount;MoveList.Add(MoveObj);end;procedure TClientForm.ResponseTimerTimer(Sender: TObject);varbm : TBitmap;x, y : integer;beginWaitImage.Hint := Format('Wait: %3.1n seconds', [(GetTickCount-t1)/1000.0]);bm := TBitmap.Create;bm.Width := WaitImage.Width;bm.Height := WaitImage.Height;Anim := Anim + 1;Anim := Anim and 31;for x := -1 to 1 dofor y := -1 to 1 dobm.Canvas.Draw(Anim + x*32, Anim + y*32, Application.Icon);WaitImage.Picture.Assign(bm);bm.Free;end;procedure TClientForm.Image1MouseDown(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer);beginScaleXY(X, Y);but := 1;if Button = mbRight then but := 2;ClearMoveList;AddMove(x, y);end;procedure TClientForm.Image1Click(Sender: TObject);beginNumClick := 1;ClickTimer.Enabled := True;end;procedure TClientForm.Image1MouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);beginScaleXY(X, Y);if but = 2 then begin// Only do this for Right ClicksSendMsg(MSG_CLICK, IntToByteStr(LastX) + IntToByteStr(LastY) +IntToByteStr(1 {Single}) + IntToByteStr(but), ClientSocket1.Socket);end;AddMove(x, y);end;procedure TClientForm.Image1DblClick(Sender: TObject);beginNumClick := 2;ClickTimer.Enabled := True;end;procedure TClientForm.ClickTimerTimer(Sender: TObject);vars : string;MoveObj : TMoveObj;i : integer;beginClickTimer.Enabled := False;if (MoveList.Count < 5) or (NumClick = 2) then begin// This is a Click or Double-clickSendMsg(MSG_CLICK, IntToByteStr(LastX) + IntToByteStr(LastY) +IntToByteStr(NumClick) + IntToByteStr(but), ClientSocket1.Socket);end else begin// This is a "drag" operations := IntToByteStr(but) + IntToByteStr(MoveList.Count);for i := 0 to MoveList.Count-1 do beginMoveObj := MoveList[i];s := s + IntToByteStr(MoveObj.X) + IntToByteStr(MoveObj.Y)+ IntToByteStr(MoveObj.time);end;SendMsg(MSG_DRAG, s, ClientSocket1.Socket);end;end;procedure TClientForm.SendButClick(Sender: TObject);beginSendText(SendEdit.Text);end;procedure TClientForm.SendCRButClick(Sender: TObject);beginSendText(SendEdit.Text + #13);end;procedure TClientForm.SendText(const Text: string);beginSendMsg(MSG_KEYS, Text, ClientSocket1.Socket);end;procedure TClientForm.Log1Click(Sender: TObject);beginLog1.Checked := not Log1.Checked;UpdateLogVis;end;procedure TClientForm.UpdateLogVis;beginLogList.Visible := Log1.Checked;Splitter1.Visible := Log1.Checked;if Log1.Checked thenLogList.Left := Splitter1.Left - 1;end;procedure TClientForm.Log(const s: string);beginLogList.ItemIndex := LogList.Items.Add(s);end;procedure TClientForm.CommStat1Click(Sender: TObject);beginCommStat1.Checked := not CommStat1.Checked;StatPanel.Visible := CommStat1.Checked;end;procedure TClientForm.EnableButs;varb : boolean;beginb := ClientSocket1.Active;Connect1.Enabled := not b;Disconnect1.Enabled := b;end;procedure TClientForm.FormCreate(Sender: TObject);beginEnableButs;MoveList := TList.Create;ParseComLine;StopAnim;EnableInput;ServerDelay := DEFAULT_SERVER_DELAY;ViewMode := DEFAULT_VIEW_MODE;CompMode := DEFAULT_COMP_MODE;SvrPriority := DEFAULT_SVR_PRIORITY;end;procedure TClientForm.Shutdown1Click(Sender: TObject);beginClose;Application.MainForm.Close;end;procedure TClientForm.FormDestroy(Sender: TObject);beginClearMoveList;MoveList.Free;end;procedure TClientForm.ClearMoveList;vari : integer;beginfor i := 0 to MoveList.Count-1 doTObject(MoveList[i]).Free;MoveList.Clear;end;procedure TClientForm.FocusServerWindow1Click(Sender: TObject);beginSendMsg(MSG_FOCUS_SERVER, '', ClientSocket1.Socket);end;procedure TClientForm.ParseComLine;vari : integer;s : string;beginfor i := 1 to ParamCount do begins := UpperCase(ParamStr(i));if s = '/CLIENT' then beginVisible := True;end;end;end;procedure TClientForm.EnableInput;varb : boolean;beginb := (NeedReply = 0) and ClientSocket1.Active;SendBut.Enabled := b;SendCRBut.Enabled := b;Image1.Enabled := b;Special1.Enabled := b;// Options1.Enabled := b;end;procedure TClientForm.StopAnim;varbmp : TBitmap;beginScreen.Cursor := crDefault;ResponseTimer.Enabled := False;// Stat[2] := 'Not Waiting';bmp := TBitmap.Create;bmp.Width := WaitImage.Width;bmp.Height := WaitImage.Height;bmp.Canvas.Draw(2, 2, Application.Icon);WaitImage.Picture.Assign(bmp);bmp.Free;EnableInput;end;procedure TClientForm.StartAnim;beginAnim := 2;ResponseTimer.Enabled := True;// Stat[2] := 'Waiting';t1 := GetTickCount;Screen.Cursor := crAppStart;EnableInput;end;procedure TClientForm.WMSysCommand(var Message: TWMSysCommand);beginif (Message.CmdType and $FFF0 = SC_MINIMIZE) thenApplication.Minimizeelseinherited;end;function TClientForm.CanSendMenuMsg: boolean;beginResult := ClientSocket1.Active;end;procedure TClientForm.PauseChange(Sender: TObject);vard : integer;begind := 0;(Sender as TMenuItem).Checked := True;if Sender = N005sec1 then d := 50;if Sender = N010sec1 then d := 100;if Sender = N050sec1 then d := 500;if Sender = N100sec1 then d := 1000;if Sender = N200sec1 then d := 2000;if Sender = N500sec1 then d := 5000;ServerDelay := d;if CanSendMenuMsg thenSendMsg(MSG_SEVER_DELAY, IntToByteStr(d), ClientSocket1.Socket);end;procedure TClientForm.ColorClick(Sender: TObject);varvm : TViewMode;x : integer;begin(Sender as TMenuItem).Checked := True;vm := vmDefault;if Sender = Color4 then vm := vmColor4;if Sender = Gray4 then vm := vmGray4;if Sender = Gray8 then vm := vmGray8;if Sender = Color24 then vm := vmColor24;if Sender = Default1 then vm := vmDefault;ViewMode := vm;if CanSendMenuMsg then beginx := integer(vm);SendMsg(MSG_VIEW_MODE, IntToByteStr(x), ClientSocket1.Socket);SendMsg(MSG_REFRESH, '', ClientSocket1.Socket);end;end;procedure TClientForm.CompClick(Sender: TObject);varcm : TCompressionLevel;begin(Sender as TMenuItem).Checked := True;cm := clDefault;if Sender = HighSlow1 then cm := clMax;if Sender = Medium1 then cm := clDefault;if Sender = LowFast1 then cm := clFastest;CompMode := cm;if CanSendMenuMsg thenSendMsg(MSG_COMP_MODE, IntToByteStr(integer(cm)), ClientSocket1.Socket);end;procedure TClientForm.PriorityClick(Sender: TObject);varx : integer;begin(Sender as TMenuItem).Checked := True;x := THREAD_PRIORITY_NORMAL;if Sender = Critical1 then x := THREAD_PRIORITY_TIME_CRITICAL;if Sender = Highest1 then x := THREAD_PRIORITY_HIGHEST;if Sender = AboveNormal1 then x := THREAD_PRIORITY_ABOVE_NORMAL;if Sender = Normal1 then x := THREAD_PRIORITY_NORMAL;if Sender = BelowNormal1 then x := THREAD_PRIORITY_BELOW_NORMAL;if Sender = Lowest1 then x := THREAD_PRIORITY_LOWEST;if Sender = Idle1 then x := THREAD_PRIORITY_IDLE;SvrPriority := x;if CanSendMenuMsg thenSendMsg(MSG_PRIORITY_MODE, IntToByteStr(x), ClientSocket1.Socket);end;procedure TClientForm.Send_Current_Settings;beginSendMsg(MSG_SEVER_DELAY, IntToByteStr(ServerDelay), ClientSocket1.Socket);SendMsg(MSG_VIEW_MODE, IntToByteStr(integer(ViewMode)), ClientSocket1.Socket);SendMsg(MSG_COMP_MODE, IntToByteStr(integer(CompMode)), ClientSocket1.Socket);SendMsg(MSG_PRIORITY_MODE, IntToByteStr(SvrPriority), ClientSocket1.Socket);end;procedure TClientForm.ScaleImage1Click(Sender: TObject);beginScaleImage1.Checked := not ScaleImage1.Checked;if ScaleImage1.Checked then beginImage1.AutoSize := False;Image1.Stretch := True;Image1.Align := alClient;end else beginImage1.AutoSize := True;Image1.Stretch := False;Image1.Align := alNone;Image1.Picture.Assign(Image1.Picture.Graphic); // To trigger the Autosize propertyend;end;procedure TClientForm.ScaleXY(var X, Y: integer);beginif not ScaleImage1.Checked then exit;with Image1 do beginX := X * Picture.Width div Width;Y := Y * Picture.Height div Height;end;end;procedure TClientForm.ProcessList1Click(Sender: TObject);beginSendMsg(MSG_PROCESS_LIST, '', ClientSocket1.Socket);end;procedure TClientForm.FileList1Click(Sender: TObject);beginSendMsg(MSG_DRIVE_LIST, '', ClientSocket1.Socket);end;procedure TClientForm.SendPanelResize(Sender: TObject);beginSendEdit.Width := SendPanel.ClientWidth - 8;end;procedure TClientForm.About1Click(Sender: TObject);beginAboutBox.ShowModal;end;procedure TClientForm.StatBarMenuClick(Sender: TObject);beginStatBarMenu.Checked := not StatBarMenu.Checked;StatusBar1.Visible := StatBarMenu.Checked;end;procedure TClientForm.FullScreen1Click(Sender: TObject);beginif BorderStyle = bsSizeable then beginBeforeFull := BoundsRect;Menu := nil;Left := 0;Top := 0;Width := Screen.Width;Height := Screen.Height;BorderStyle := bsNone;StatPanel.Visible := False;StatusBar1.Visible := False;ScrollBox1.BorderStyle := bsNone;FSTopForm.Show;end else beginBoundsRect := BeforeFull;Menu := MainMenu1;BorderStyle := bsSizeable;StatPanel.Visible := True;StatusBar1.Visible := True;ScrollBox1.BorderStyle := bsSingle;FSTopForm.Hide;end;end;procedure TClientForm.FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);begin// If in Full-Screen mode, do an extra check for Hot-Keys on the popup menuif BorderStyle = bsNone then beginFSTopForm.CheckShortCut(Key, Shift);end;end;end.
