serverdlg.pas

能够监视另一台机子的屏幕

unit ServerDlg;

interface

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

implementation

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

   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