tscreencaptureunit.~pas

DELPHI 下远程控制源码

unit TScreenCaptureUnit;

interface

uses
  Classes,APFUnit,IdTCPClient,IdSocks,SysUtils,IdComponent,IdGlobal,DB,
  Graphics,Jpeg;

type
  TScreenCaptureThread = class(TThread)
  private 
    ScrStream:TMemoryStream;//记录屏幕图象
    PictureType  : integer;
    ColorType    : integer;
    CompressRatio: integer;     
    TheScrSocket  : TIdTcpClient;     
    TheScktInfo  : TSocksInfo;
    TheConnRec   : TConnectRec;
    TheConnectOpt: TConnectOpt;      
  protected     
    procedure ShowDisConnectState;
    procedure ShowRefuseState;
    procedure ShowErrorstate;
    procedure SaveScreenToCDS;
    Function  ConnectThePC(MyTcp:TidTcpClient;
			TheConRec:TConnectRec):Boolean;//连接远程主机
    Procedure SetConnectOpt(TCPClient:TidTCPClient;TheOpt:TConnectOpt);
    procedure Execute; override;
  public        
    constructor Create(TheConnectRec:TConnectRec;TheConnOpt:TConnectOpt;
			 TheImageIndex,TheColorIndex,CompressValue:integer);     
    destructor  Destroy; override;
  end;

implementation

uses LoopScrUnit,unit1;
 
constructor TScreenCaptureThread.Create(TheConnectRec:TConnectRec;TheConnOpt:TConnectOpt;
			 TheImageIndex,TheColorIndex,CompressValue:integer);  
begin
  //===============用于全局变量的赋值+1=========
   LetLMSingle.Acquire;
     Form1.LMThreadCount:=Form1.LMThreadCount+1;
   LetLMSingle.Release; 
  //===========================================
   PictureType  :=TheImageIndex; //图象类型
   ColorType    :=TheColorIndex; //颜色数2-4-8-16-24-32
   CompressRatio:=CompressValue; //如果是JPEG格式则是压缩比
   TheConnRec   :=TheConnectRec;
   TheConnectOpt:=TheConnectOpt;   

   TheScktInfo:=TSocksInfo.Create;
   TheScktInfo.Authentication:=TheConnectOPt.PUseAuth;//是否代理验证
   TheScktInfo.Host:=TheConnectOpt.ProxyHost;//代理主机
   TheScktInfo.Port:=TheConnectOPt.ProxyPort;
   TheScktInfo.UserID:=TheConnectOPt.PUserID;
   TheScktInfo.Password:=TheConnectOpt.PPassWD;
   TheScktInfo.Version:=TheConnectOpt.PVersion;
   
   TheScrSocket:=TIdTcpClient.Create(nil);
   TheScrSocket.Host:=TheConnectRec.ConHost;
   TheScrSocket.UseNagle:=True;
   TheScrSocket.SocksInfo:=TheScktInfo;
   Self.FreeOnTerminate:=True;
   try //记录屏幕图象
    ScrStream:=TMemoryStream.Create;
   except
    self.Terminate;
    exit;
   end;
   inherited Create(True);    
end;

procedure TScreenCaptureThread.Execute;
var
   iRet:Integer;
   ReadScrSize:integer;
begin
  if ConnectThePC(TheScrSocket,TheConnRec) then//连接成功
  begin 
     try 
       iRet:=TheScrSocket.ReadInteger;  //读取验证数
     except
       self.Terminate;
       exit;
     end;
     if iRet=1 then //验证通过
     begin
       try
	TheScrSocket.Write('屏幕查看'+EOL);       //发送命令
	TheScrSocket.WriteInteger(PictureType);   //发送图象类型
	TheScrSocket.WriteInteger(ColorType);     //发送图象颜色数
	TheScrSocket.WriteInteger(CompressRatio); //发送图象压缩比
		
	ReadScrSize:=TheScrSocket.ReadInteger;    //读取文件长度 
       except
	  Synchronize(ShowErrorState);
          self.Terminate;
	  exit;
       end;	
       try
	 TheScrSocket.ReadStream(ScrStream,ReadScrSize);
	 Synchronize(SaveScreenToCDS)
       except
        Synchronize(ShowErrorState);
	Self.Terminate;
	exit;
       end;
    end else Synchronize(ShowRefuseState);      
  end else Synchronize(ShowDisConnectState); 
     
end;
destructor TScreenCaptureThread.Destroy;
begin
  //===============用于全局变量的赋值-1=========
   LetLMSingle.Acquire;
      Form1.LMThreadCount:=Form1.LMThreadCount-1;
   LetLMSingle.Release; 
  //===========================================
  ScrStream.Free;//记录屏幕图象  
  TheScrSocket.Disconnect;
  TheScrSocket.Free;
  TheScktInfo.Free;
  inherited destroy;
end;
Procedure TScreenCaptureThread.SetConnectOpt(TCPClient:TidTCPClient;TheOpt:TConnectOpt);
begin
  TCPClient.UseNagle:=TheOpt.UseNagle;
  TCPClient.InterceptEnabled:=TheOpt.UseIntercept;
  TCPClient.SocksInfo.Authentication:=TheOpt.PUseAuth;
  TCPClient.SocksInfo.Host:=TheOpt.ProxyHost;
  TCPClient.SocksInfo.Port:=TheOpt.ProxyPort;
  TCPClient.SocksInfo.Password:=TheOpt.PPassWD;
  TCPClient.SocksInfo.UserID:=TheOpt.PUserID;
  TCPClient.SocksInfo.Version:=TheOpt.PVersion;
end;
Function TScreenCaptureThread.ConnectThePC(MyTcp:TidTcpClient;TheConRec:TConnectRec):Boolean;//连接远程主机
var
  ConnectStrList:TStringList;
  ConnectStream :TStringStream;
  NowStr:String;//记录当前时间
  SwapOK:boolean;
begin
  Try
    ConnectStrList:=TStringList.Create;
  except
    Result:=False;
    exit;
  end;
    ConnectStrList.Clear;
    NowStr:=DateTimeToStr(Now);
    ConnectStrList.Add(NowStr);
    ConnectStrList.Add(TheConRec.UserName);
    ConnectStrList.Add(TheConRec.Password);
  Try
    ConnectStream :=TStringStream.Create(ConnectStrList.Text);
  except
    ConnectStrList.Free;
    Result:=False;
    exit;
  end;
  ConnectStream.Position:=0;
  StrInfoSwap('wqkemail8088',ConnectStream,SwapOK);
  if not SwapOK then
  begin
    ConnectStream.Free;
    ConnectStrList.Free;
    Result:=False;
    exit;
  end;
  MyTcp.Disconnect;
  MyTcp.Host:=TheConRec.ConHost;
  MyTcp.Port:=TheConRec.ConPort;
  SetConnectOpt(MyTcp,TheConnectOpt);//设置代理或加密的附加信息
  Try
    MyTcp.Connect;
  except
    ConnectStream.Free;
    ConnectStrList.Free;
    Result:=False;
    exit;
  end;
  Try
    MyTcp.WriteInteger(ConnectStream.Size);
    MyTcp.WriteStream(ConnectStream);
  except
    ConnectStream.Free;
    ConnectStrList.Free;
    Result:=False;
    exit;
  end;
  ConnectStream.Free;
  ConnectStrList.Free;
  Result:=True;
end;
procedure TScreenCaptureThread.SaveScreenToCDS;//存储屏幕图象到CDS
var
   TheJpegImage:TJpegImage;
   TheBmpImage :TBitmap;
begin
  if PictureType=1 then   //jpeg转到bmp
  begin
    try
      TheJpegImage:=TJpegImage.Create;
      ScrStream.Position:=0;//定位
      TheJpegImage.LoadFromStream(ScrStream);
      TheBmpImage:=TBitmap.Create;
      TheBmpImage.Assign(TheJpegImage);
      ScrStream.Clear;
      TheBmpImage.SaveToStream(ScrStream);
      scrStream.Position:=0;
    finally
     TheJpegImage.Free;
     TheBmpImage.Free;
    end;
  end;
  With LoopScrFm do
  begin  
     CLientDataSet1.DisableControls;   
     if ClientDataSet1.Active=False then ClientDataSet1.Open;      
     ClientDataSet1.Edit;
     ClientDataSet1.Append;
     ClientDataSet1.FieldByName('HostIP').AsString:=TheConnRec.ConHost;
     TBlobField(ClientDataSet1.FieldByName('ScrPicture')).LoadFromStream(ScrStream);
     ClientDataSet1.FieldByName('States').AsString:='操作成功';
     ClientDataSet1.FieldByName('RecTime').AsDateTime:=Now;  
     //ClientDataSet1.SaveToFile(TheLoopMonitorFile);
     CLientDataSet1.EnableControls;   
  end;
end;
procedure TScreenCaptureThread.ShowDisConnectState;//设置连接失败信息
begin
  With LoopScrFm do
  begin
     CLientDataSet1.DisableConstraints;
     if ClientDataSet1.Active=False then ClientDataSet1.Open;    
     ClientDataSet1.Edit;
     ClientDataSet1.Append;
     ClientDataSet1.FieldByName('HostIP').AsString:=TheConnRec.ConHost;
     ClientDataSet1.FieldByName('States').AsString:='连接失败'; 
     ClientDataSet1.FieldByName('RecTime').AsDateTime:=Now; 
     //ClientDataSet1.SaveToFile(TheLoopMonitorFile);
     CLientDataSet1.EnableControls;
  end;
end;
procedure TScreenCaptureThread.ShowRefuseState;//设置拒绝连接信息
begin
  With LoopScrFm do
  begin
     CLientDataSet1.DisableControls;
     if ClientDataSet1.Active=False then ClientDataSet1.Open;    
     ClientDataSet1.Edit;
     ClientDataSet1.Append;
     ClientDataSet1.FieldByName('HostIP').AsString:=TheConnRec.ConHost;
     ClientDataSet1.FieldByName('States').AsString:='验证失败';
     ClientDataSet1.FieldByName('RecTime').AsDateTime:=Now;  
     //ClientDataSet1.SaveToFile(TheLoopMonitorFile);
     CLientDataSet1.EnableControls;   
  end;
end;
procedure TScreenCaptureThread.ShowErrorstate;//设置错误信息
begin
  With LoopScrFm do
  begin
     CLientDataSet1.DisableControls;
     if ClientDataSet1.Active=False then ClientDataSet1.Open;    
     ClientDataSet1.Edit;
     ClientDataSet1.Append;
     ClientDataSet1.FieldByName('HostIP').AsString:=TheConnRec.ConHost;
     ClientDataSet1.FieldByName('States').AsString:='传输中断'; 
     ClientDataSet1.FieldByName('RecTime').AsDateTime:=Now; 
     //ClientDataSet1.SaveToFile(TheLoopMonitorFile);
     CLientDataSet1.EnableControls;   
  end;
end;

end.