serverdlg.pas

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

      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.