unit1.pas

经过研究本人初略的将原代码进行了模拟

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, ScktComp, StdCtrls, WinSock, comctrls, JPEG,
  ImgList, Commctrl, IniFiles, Buttons, ShellAPI, ToolWin, RzPanel,
  RzSplit, bmp2avi;

const
  WM_ICON           = WM_USER + 10;
type
  NetData = record
    Protocol: set of (K_SCR,
      K_MOUSE,
      K_KEY,
      K_KILL,
      K_CL,
      K_RM,
      K_CUT);
    ScrW, ScrH: integer;
    LInt, RInt, PixB: integer;
    Str: string[100];
  end;

  OffXY = record
    x1, x2, y1, y2: integer;
    vSize: integer;
  end;

type
  TfMain = class(TForm)
    PgCntrl: TPageControl;
    tscr: TTabSheet;
    tsys: TTabSheet;
    SocketSvr: TServerSocket;
    SocketScr: TServerSocket;
    MemoMsg: TMemo;
    StatusBar1: TStatusBar;
    ImageList1: TImageList;
    GrupBxScrSet: TGroupBox;
    CmdSave: TSpeedButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    TrckBrSd: TTrackBar;
    RdbtnL: TRadioButton;
    RdbtnH: TRadioButton;
    EdtPort: TEdit;
    TabSheet1: TTabSheet;
    sbx: TScrollBox;
    imgShow: TImage;
    pk: TPanel;
    Memo1: TMemo;
    Label4: TLabel;
    ePort: TEdit;
    Label5: TLabel;
    GroupBox1: TGroupBox;
    Label6: TLabel;
    UrlDown: TEdit;
    SendUrl: TSpeedButton;
    edt1: TEdit;
    btn1: TButton;
    btn2: TButton;
    cbb1: TComboBox;
    cbb2: TComboBox;
    lbl1: TLabel;
    lbl2: TLabel;
    lbl3: TLabel;
    TabSheet2: TTabSheet;
    ListBox1: TListBox;
    Button2: TButton;
    Button3: TButton;
    SpeedButton1: TSpeedButton;
    Panel1: TPanel;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    UnLink: TToolButton;
    ToolButton3: TToolButton;
    ShowScr: TToolButton;
    ScrKz: TToolButton;
    ToolButton6: TToolButton;
    ShutDown: TToolButton;
    Panel2: TPanel;
    ldrv: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure SocketSvrRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure SocketScrRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure SocketSvrError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: integer);
    procedure SocketSvrDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure imgShowMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure mCloseGameClick(Sender: TObject);
    procedure mCloseCPClick(Sender: TObject);
    procedure pkMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    procedure pkMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    procedure pkMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: integer);
    procedure SocketScrClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: integer);
    procedure SocketScrClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure SocketScrClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure TrckBrSdChange(Sender: TObject);
    procedure CmdSaveClick(Sender: TObject);
    procedure EdtPortKeyPress(Sender: TObject; var Key: Char);
    procedure UnLinkClick(Sender: TObject);
    procedure ShowScrClick(Sender: TObject);
    procedure ScrKzClick(Sender: TObject);
    procedure ShutDownClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SendUrlClick(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure SocketSvrAccept(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    sBB: TAvi;
    bS: Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

const
  tport             = 2008;             //主端口

var
  fMain             : TfMain;
  MyStream          : TMemorystream;    //内存流对象
  MySize            : Longint;          //图片大小
  MRect             : TRect;            //图片区域坐标
  jx                : integer;          //JPEG压缩率
  jxget             : boolean;          //是否连续截图片
  kongz             : boolean;          //是否控制
  lx, ly            : integer;
  move_b            : boolean;
implementation

{$R *.dfm}

procedure smsg(msg: string);
begin
  fMain.MemoMsg.Lines.Add('服务器消息 ' + msg);
end;

function GetFileSize(Path: string): integer;
var
  Sear              : TSearchRec;
begin
  if FindFirst(Path, SysUtils.faArchive, Sear) = 0 then
    Result := Sear.Size div 1024
  else
    Result := 0;
end;

procedure TfMain.FormCreate(Sender: TObject);
{建立窗口，初始化}
var
  inif              : TiniFile;
begin

  move_b := false;
  SocketSvr.Port := StrToInt(eport.Text);
  kongz := false;
  inif := TiniFile.Create(ExtractFilePath(Application.ExeName) + 'config.ini');
  try
    if inif.ReadString('SCR', 'BMPPIXBIT', 'LOW') = 'LOW' then
      RdbtnL.Checked := true
    else
      RdbtnH.Checked := true;
    TrckBrSd.Position := inif.ReadInteger('SCR', 'JPEGHEIG', 50);
    EdtPort.Text := inif.ReadString('SCR', 'PORT', '8112');
  finally
    inif.Free;
  end;
end;

procedure TfMain.SocketSvrAccept(Sender: TObject; Socket: TCustomWinSocket);
begin
  ldrv.Items.Add(Format('%-15s %d', [Socket.RemoteAddress,socket.SocketHandle]));
  Panel2.Caption := format('客户列表 %d',[ldrv.Items.Count]);
end;

procedure TfMain.SocketSvrRead(Sender: TObject; Socket: TCustomWinSocket);
var
  pd                : NetData;
begin
  Socket.ReceiveBuf(pd, SizeOf(pd));
  //屏幕控制
  if K_SCR in pd.Protocol then
  begin
    imgShow.Top := 0;
    imgShow.Left := 0;
    imgShow.Width := pd.ScrW;
    imgShow.Height := pd.ScrH;
  end;

  if K_RM in pd.Protocol then
    smsg(Format('%-15s 已连接 客户信息：%s', [Socket.RemoteAddress, pd.Str]));

  if K_KILL in pd.Protocol then
    if pd.LInt =2 then //返回进程列表
      ListBox1.Items.Add(pd.Str);

end;

procedure TfMain.SocketSvrError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: integer);
begin
  ErrorCode := 0;
end;

procedure TfMain.SocketScrClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
{SocketScr当有客户连接进来}
begin
  Socket.SendText('cap');
end;

procedure TfMain.SocketScrClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  MySize := 0;
end;

procedure TfMain.SocketScrRead(Sender: TObject; Socket: TCustomWinSocket);
var
  MyBuffer          : array[0..8192] of byte; {设置接收缓冲区}
  MyReceviceLength  : integer;
  MyJpg             : TJpegimage;
  bb                : TBitmap;
  bXY               : OffXY;
  VRect             : TRect;
begin

  if MySize = 0 then                    //MySize为服务端发送的字节数，如果为0表示为尚未开始图象接收
  begin
    StatusBar1.Panels[0].Text := '';
    Socket.ReceiveBuf(bXY, SizeOf(bXY));
    MySize := bXY.vSize;
    MRect := Rect(bXY.x1, bXY.y1, bXY.x2, bXY.y2);
    if MySize = 0 then
      Socket.SendText('ca1')
    else
      Socket.SendText('ready');         //发指令通知服务端开始发送图象
  end
  else
  begin                                 //以下为图象数据接收部分
    MyReceviceLength := Socket.ReceiveLength; //读出包长度
    Socket.ReceiveBuf(MyBuffer, MyReceviceLength);
    MyStream.Write(MyBuffer, MyReceviceLength);
    StatusBar1.Panels[0].Text := '正在接收数据...';

    if MyStream.Size >= MySize then
    begin
      StatusBar1.Panels[0].Text := '正在显示屏幕！';
      MyStream.Position := 0;
      MyJpg := TJpegimage.Create;
      bb := TBitmap.Create;
      try
        MyJpg.LoadFromStream(MyStream);
        bb.Assign(MyJpg);
        VRect.Left := 0;
        VRect.Top := 0;
        VRect.Right := bb.Width;
        VRect.Bottom := bb.Height;
        imgShow.Canvas.CopyRect(MRect, bb.Canvas, VRect);

        if bS then
          sBB.Add(imgShow.Picture.Bitmap); //开始录象
      finally                           //以下为清除工作
        bb.Free;
        MyJpg.Free;
        if jxget then
          Socket.SendText('ca1');       //连续抓屏
        if not jxget then
        begin
          if bS = false then
          begin
            bs := False;
            sBB.Destroy;
            btn1.Enabled := True;
            btn2.Enabled := False;
          end;
          Socket.SendText('exit');      //停止抓屏
          SocketScr.close;
          StatusBar1.Panels[0].Text := '停止接收数据...';
        end;
        MyStream.Clear;
        MySize := 0;
      end;
    end;
  end;

end;

procedure TfMain.SocketScrClientError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: integer);
begin
  ErrorCode := 0;
  MyStream.Free;
  MySize := 0;
  SocketScr.close;
end;

procedure TfMain.imgShowMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
var
  bb                : NetData;
begin
  if kongz = false then
    Exit;
  bb.Protocol := [K_MOUSE];
  bb.LInt := X;
  bb.RInt := Y;
  if (Button = mbleft) and not (ssCtrl in Shift) then
    bb.Str := 'left1';

  if (Button = mbright) and not (ssCtrl in Shift) then
    bb.Str := 'right1';