Divided into two parts: the server and the client, although not a complete Delphi project, but we care about the useful code, right? The following is a server 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); func tion 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 damhe beginhe: = gethostbyname (buf); if He = nil damrc: = wsagetlasterror; Namelabel.caption: = format ('socket error% d =% s', [RC, SYSERRORMESSAGE (RC)]); ELSE beginbuf2: = inet_ntoa (pinddr (he.h_addr ^) ^; namelabel.caption: = Format ('% s (% s)', [buf, buf2]); end; end else beginnamelabel.caption: = 'unknown host'; end; end; procedure TSERVERMM.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; e nd; 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; Soc ket: 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 F inishedend; 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 damove (data [1], x, sizeof (integer); viewmode: = tviewMode (x); sendmsg (msg_view_mode, '', socket);
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 dam (MSG_STAT_MSG, 'Launchi NG 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 shli 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); = format ('% 1.0n ', [sr.size 0.0]); Commalist .Add (s); dt: = fileDatetodatetime (sr.t) IME); s: = formatdatetime ('YYYY-MM-DD HH: NN ampm', dt); Commalist.Add (s); dirlist.add (dismalist.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 THENBEGINW: = 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 but1: result: = mbleft; 2: Result: = Mbright; Else Result: = MBLEFT; 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 BeginMESS.CLEAR; For i: = 1 to Num doadd_clickex (0, getMB (but), [], x, y, 1); Play; end; createepthread; 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); Move); 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 (int Eger); setcursorpos (x, y); // Find the window handlep: = Point (x, y); curhandle: = windowfromPoint (p); assert (curHandle <> 0); with msgsimulator1 do beg 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 ServerSock et1.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 begin: = Uppercase (paramstr (i)); if Copy (S, 1, 6) = '/ Port: 'Ten Beginportedit.text: = COPY (S, 7, Length (s)); autostart: = true; startbutclick (nil); minimizeButClick (nil); end; if s =' / client 'Tenminimizebutclick (nil) AutoStart: = true; end; end; if not autostart thenvisible: = true;
procedure TServerForm.ClientButClick (Sender: TObject); beginClientForm.Show; end; end The following is a client 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: T MenuItem; 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 Image1Mo useMove (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: s tring); 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; importationUses 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 basleft: = (F.L.L.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) INTTOBYTESTER (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.Rec 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:' INTOSTR (longth (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 kilog (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 damstat [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 the begin: = 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 the beginstat [0]: = 'Server delay set'; end; if msgnum = msg_view_mode the beginning [0]: = 'view mode set'; end; if msgnum = msg_comp_mode the 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 the beginassert (Fileform as tfilesform) .SetDirData (data); fileform.show; stat [0]: = 'Received Directory'; END; if msgnum = msg_file kiln = msg_file1 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.cre Ate; 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 dam: = 2; ClearmovelMoveList; 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) INTTOBYTESTER (MoveList.count); for i: = 0 to movelist.count-1 do beginmoveobj: = MoveList [i]; s: = s INTTOBYTESTR (MoveObj.x) INTTOBYTESTESTESTESTER (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_SERVE R, '', 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 .Nabled: = B; special1.enabled: = b; // Options1.enabled: = b; end; procedure tclientform.stopanim; varbmp: tbitmap; beginscreen.cursor: = crdefault; responsetimer.enable: = 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 TEND : = 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 TClientFo Rm.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 (M SG_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; Else Beginimage1.autosize: = true; image1.stretch: = false; Image1.Align: = alnone
