ucapshow.pas

Delhpi远程屏幕传输 (差异截图)

unit uCapShow;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, ExtCtrls, StdCtrls;

type
  PakGet = record
    Fa: set of (GETCAP, GETUSB);
    Tag: Integer;
  end;

  PakSend = record
    Fa: set of (SENDCAP, SENDUSB);
    Tag: Integer;
    UsbList: string[255];
  end;
type
  TCapShow = class(TForm)
    Panel1: TPanel;
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    ComboBox1: TComboBox;
    Image1: TImage;
    SSck: TServerSocket;
    SSckCap: TServerSocket;
    Button3: TButton;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
    procedure SSckClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure SSckClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button3Click(Sender: TObject);
    procedure SSckClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure SSckCapClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure SSckCapClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  CapShow           : TCapShow;
  ms                : TMemorystream;
  MySize            : integer;
  bCap              : boolean;
implementation

{$R *.dfm}

procedure TCapShow.FormCreate(Sender: TObject);
//
begin
  SSck.Port := 3300;
  SSck.Active := true;
  MySize := 0;
end;

procedure TCapShow.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SSck.Close;
end;

procedure TCapShow.SSckClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  ErrorCode := 0;
end;

procedure TCapShow.SSckClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  listbox1.Items.Add(Socket.RemoteAddress);
end;

procedure TCapShow.Button3Click(Sender: TObject);
//获得USB设备
var
  GPak              : PakGet;
begin
  ComboBox1.Items.Clear;
  GPak.Fa := [GETUSB];
  SSck.Socket.Connections[listbox1.ItemIndex].SendBuf(GPak, SizeOf(GPak));
end;

procedure TCapShow.SSckClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  SPak              : PakSend;
begin
  if Socket.ReceiveBuf(SPak, SizeOf(SPak)) = -1 then
    Exit;
  if SENDUSB in SPak.Fa then            //获取USB设备
  begin
    ComboBox1.Items.Add(SPak.UsbList);
    Combobox1.ItemIndex := SPak.Tag;
  end;

  if SENDCAP in SPak.Fa then
  begin

  end;
end;

procedure TCapShow.Button1Click(Sender: TObject);
var
  GPak              : PakGet;
begin
  GPak.Fa := [GETCAP];
  GPak.Tag := ComboBox1.ItemIndex;
  SSck.Socket.Connections[ListBox1.ItemIndex].SendBuf(GPak, SizeOf(GPak));
  ms := TMemorystream.Create;
  ms.Position :=0;
  SSckCap.Port := 2008;
  SSckCap.Active := true;
  bCap:= true;
end;

procedure TCapShow.SSckCapClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Socket.SendText('cap');
end;

procedure TCapShow.SSckCapClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  MyBuffer          : array[0..8192] of byte; {设置接收缓冲区}
  MyReceviceLength  : integer;
  sb                : TBitmap;
begin
  if MySize = 0 then
  begin
    Mysize := StrToInt(socket.ReceiveText);
    if mysize=0 then
      socket.SendText('cap')
    else
      socket.SendText('ready');
  end
  else begin
    MyReceviceLength := Socket.ReceiveLength;
    Socket.ReceiveBuf(MyBuffer, MyReceviceLength);
    ms.Write(MyBuffer, MyReceviceLength);
    if ms.Size >= MySize then
    begin
      ms.Position :=0;
      sb:=TBitmap.Create;
      try
        sb.LoadFromStream(ms);
        Image1.Picture.Bitmap.Assign(sb);
      finally
        sb.Free;
        ms.Clear;
        MySize := 0;
        if bCap then
          Socket.SendText('cap')
        else begin
          Socket.SendText('exit');
          SSckCap.Close;
        end;
      end;
    end;

  end;
end;

procedure TCapShow.Button2Click(Sender: TObject);
begin
  bCap:=false;
end;

end.