📄 remotecpcunit.~pas

📁 DELPHI 下远程控制源码
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
12 下一页
unit RemoteCPCUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons,APFUnit, StdCtrls,IdGlobal;

type
  TRemoteCPCFm = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    SpeedButton10: TSpeedButton;
    SpeedButton11: TSpeedButton;
    SpeedButton13: TSpeedButton;
    SpeedButton12: TSpeedButton;
    Timer1: TTimer;
    procedure Panel2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton12Click(Sender: TObject);
    procedure SpeedButton11Click(Sender: TObject);
    procedure SpeedButton13Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);

  private
    { Private declarations }
  public
    RemoteScreenWidth  :integer;
    RemoteScreenHeight :integer;
    TheCacheBmp:TBitmap;//设置屏幕显示的内存影象bmp
  end;

var
  RemoteCPCFm: TRemoteCPCFm;
  StringsLen:Integer;
  SendStrings:TStringList;
  
implementation

uses SScrParamSetUnit, Unit1,TCaptureSSSThreadUnit;

var  
    TheSubThread:TCaptureSSSThread;
{$R *.dfm}

procedure TRemoteCPCFm.Panel2MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    Panel2.Tag:=12;
    SpeedButton1.Tag:=x;
    SpeedButton2.Tag:=y;
end;

procedure TRemoteCPCFm.Panel2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   Panel2.Tag:=0;    
end;

procedure TRemoteCPCFm.Panel2MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
   if Panel2.Tag=12 then
   begin
     Panel1.Left:=Panel1.Left+(x-SpeedButton1.Tag);
     Panel1.Top :=Panel1.Top+(y-SpeedButton2.Tag);
     Canvas.StretchDraw(RemoteCPCFm.ClientRect,Self.TheCacheBmp);      
   end;
end;

procedure TRemoteCPCFm.SpeedButton7Click(Sender: TObject);
begin
    close;
    Timer1.Enabled:=False; 
    SpeedButton1.Enabled:=True;
    SpeedButton2.Enabled:=True;    
    Try
     TheSubThread.TheScrSocket.Disconnect;
     TheSubThread.Terminate;
    except
    end;     
    SpeedButton1.Down:=True;        
end;

procedure TRemoteCPCFm.SpeedButton1Click(Sender: TObject);
begin 
   SpeedButton2.Enabled:=True;
   SpeedButton1.Enabled:=False;
   Timer1.Enabled:=False;    
   Try
     TheSubThread.TheScrSocket.Disconnect;
     TheSubThread.Terminate;
   except
   end;           
end;

procedure TRemoteCPCFm.SpeedButton6Click(Sender: TObject);
begin
   SScrParamSetFm.ShowModal;
end;

procedure TRemoteCPCFm.FormCreate(Sender: TObject);
begin
   TheCacheBmp:=TBitmap.Create;//设置屏幕显示的内存影象bmp
   TheCacheBmp.Width:=800;
   TheCacheBmp.Height:=600;
   TheCacheBmp.PixelFormat:=pf32bit;  
   StringsLen:=0;
   SendStrings:=TStringList.Create;    
end;

procedure TRemoteCPCFm.FormDestroy(Sender: TObject);
begin
   TheCacheBmp.Free;//设置屏幕显示的内存影象bmp
end;

procedure TRemoteCPCFm.SpeedButton2Click(Sender: TObject);
var
   TheImgIndex        :integer;//图象类型jpg---bmp==1/0
   TheClorIndex       :integer;//像素颜色位格式
   TheCmpRatio        :integer;//如果是jpg 则为压缩质量
   TheAreaHeight      :integer;//传输块的高度   
   TheThreadPriority  :integer;//对应线程的优先级 
   
   TheCRec     :TConnectRec;
   TheOpt      :TConnectOpt;
begin
   if Form1.IdFTCPClient.Connected=False then
   begin
      beep;
      Panel2.Caption:='注意：网络还没有连接！';      
      exit; //如果网络开通则
   end;
   Try 
     Form1.IdFTCPClient.Write('屏幕信息'+EOL);//发送鼠标命令---1
     RemoteScreenWidth :=Form1.IdFTCPClient.ReadInteger; //获取屏幕宽度
     RemoteScreenHeight:=Form1.IdFTCPClient.ReadInteger; //获取屏幕高度        
   except
     Beep;
     Panel2.Caption:='注意：远程屏幕参数获取失败！';      
     exit;
   end; 

   SpeedButton1.Enabled:=True;
   SpeedButton2.Enabled:=False;
   TheCRec:=Form1.TheFileConnectRec;//设置同当前连接相同的连接参数
   TheOpt :=Form1.MyConnectOpt;     //设置同当前连接相同的连接安全参数
   
   TheImgIndex        :=SScrParamSetFm.RadioGroup1.ItemIndex;//图象类型jpg---bmp==1/0
   TheClorIndex       :=SScrParamSetFm.RadioGroup2.ItemIndex+1;//像素颜色位格式
   TheCmpRatio        :=SScrParamSetFm.SpinEdit1.Value;//如果是jpg 则为压缩质量
   TheAreaHeight      :=SScrParamSetFm.SpinEdit2.Value;//传输块的高度
   //用Self.Tag传递经计算得到的远程监视区域的宽度
   TheThreadPriority  :=SScrParamSetFm.ComboBox1.ItemIndex+1;//对应线程的优先级
   TheSubThread:=TCaptureSSSThread.Create(TheCRec,TheOpt,TheImgIndex,
                                             TheClorIndex,TheCmpRatio,
                                             TheAreaHeight,TheThreadPriority);                                                
   TheCacheBmp.Free;
   TheCacheBmp:=TBitmap.Create;//设置屏幕显示的内存影象bmp
   TheCacheBmp.Width:=800;
   TheCacheBmp.Height:=600;
   TheCacheBmp.PixelFormat:=pf32bit;  
   TheSubThread.Resume;    
end;

procedure TRemoteCPCFm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if SpeedButton4.Down=False then exit;  //如果鼠标标志置上则
  if Form1.IdFTCPClient.Connected=False then exit; //如果网络开通则  
  try        
    Form1.IdFTCPClient.Write('鼠标命令'+EOL);//发送鼠标命令---1
    StringsLen:=0;
    SendStrings.Clear;
    SendStrings.Append('鼠标按下');//发送鼠标参数---2    
    if Button=mbLeft then 
          SendStrings.Append('左键');//发送鼠标参数---3  
    if Button=mbMiddle then
          SendStrings.Append('中键');//发送鼠标参数---3           
    if Button=mbRight then 
          SendStrings.Append('右键');//发送鼠标参数---3 
                                     //发送鼠标参数---4
    SendStrings.Append(IntToStr((X*RemoteScreenWidth) div Screen.Width));
                                     //发送鼠标参数---5         
    SendStrings.Append(IntToStr((Y*RemoteScreenHeight) div Screen.Height));
    StringsLen:=Length(SendStrings.Text);
    Form1.IdFTCPClient.WriteInteger(StringsLen);
    Form1.IdFTCPClient.WriteStrings(SendStrings);     
  except     
      Panel2.Caption:='注意：鼠标命令失败！'; 
  end;           
end;

procedure TRemoteCPCFm.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if SpeedButton4.Down=False then exit;  //如果鼠标标志置上则
   if Form1.IdFTCPClient.Connected=False then exit; //如果网络开通则      
   Try
     Form1.IdFTCPClient.Write('鼠标命令'+EOL);//发送鼠标命令---1
    StringsLen:=0;
    SendStrings.Clear;
    SendStrings.Append('鼠标抬起');//发送鼠标参数---2    
    if Button=mbLeft then 
          SendStrings.Append('左键');//发送鼠标参数---3  
    if Button=mbMiddle then
          SendStrings.Append('中键');//发送鼠标参数---3           
    if Button=mbRight then 
          SendStrings.Append('右键');//发送鼠标参数---3 
                                     //发送鼠标参数---4
    SendStrings.Append(IntToStr((X*RemoteScreenWidth) div Screen.Width));
                                     //发送鼠标参数---5         
    SendStrings.Append(IntToStr((Y*RemoteScreenHeight) div Screen.Height));
    StringsLen:=Length(SendStrings.Text);
    Form1.IdFTCPClient.WriteInteger(StringsLen);
    Form1.IdFTCPClient.WriteStrings(SendStrings);
   except
     Panel2.Caption:='注意：鼠标命令失败！'; 
   end; 
end;

procedure TRemoteCPCFm.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
   if SpeedButton4.Down=False then exit;  //如果鼠标标志置上则
   if Form1.IdFTCPClient.Connected=False then exit; //如果网络开通则   
   try
     Form1.IdFTCPClient.Write('鼠标命令'+EOL);//发送鼠标命令---1
    StringsLen:=0;
    SendStrings.Clear;
    SendStrings.Append('鼠标移动');//发送鼠标参数---2    
    SendStrings.Append('随便');//数据对齐---3
                                     //发送鼠标参数---4
    SendStrings.Append(IntToStr((X*RemoteScreenWidth) div Screen.Width));
                                     //发送鼠标参数---5         
    SendStrings.Append(IntToStr((Y*RemoteScreenHeight) div Screen.Height));
    StringsLen:=Length(SendStrings.Text);
    Form1.IdFTCPClient.WriteInteger(StringsLen);
    Form1.IdFTCPClient.WriteStrings(SendStrings);
     sleep(10);     
   except
    Panel2.Caption:='注意：鼠标命令失败！'; 
   end;   
end;

procedure TRemoteCPCFm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if SpeedButton3.Down=False then exit;  //如果键盘标志置上则
   if Form1.IdFTCPClient.Connected=False then exit; //如果网络开通则
   try
     Form1.IdFTCPClient.Write('键盘命令'+EOL);//发送键盘命令---1
       StringsLen:=0;
       SendStrings.Clear;
       SendStrings.Append('键盘按下');   //发送键盘命令---2 
       SendStrings.Append(IntToStr(Key)); //发送键盘虚拟码参数---3 
                   
       StringsLen:=Length(SendStrings.Text);
       Form1.IdFTCPClient.WriteInteger(StringsLen);
       Form1.IdFTCPClient.WriteStrings(SendStrings);      
   except
      Panel2.Caption:='注意：键盘命令失败！';
   end;   
end;

procedure TRemoteCPCFm.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
12 下一页
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -