scrspy.pas

DELPHI实现的快速屏幕截图并发送源代码

unit ScrSpy;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  BufferUDP;

Type
  TScreenBlock= record
    BlockIndex: Integer;
    BMP: TBitmap;
    ptr: Pointer;
    Bound: TRect;
  end;

type
  TScreenSpyBitmapEvent = procedure(Sender: TObject; const Block: TScreenBlock; LastScanline: Pointer; IsIFrame: Boolean) of object;
  TFrameStartEvent = procedure(Sender: TObject; const FrameCount: Cardinal; const IsIFrame: Boolean) of object;
  TFrameEndEvent = procedure(Sender: TObject; const FrameCount: Cardinal; const IsIFrame: Boolean; const HasBitmapEvent: Boolean) of object;

  TScreenSpy = class;
  EScrSpy = Exception;

  TScreenSpyThread = class(TThread)
  private
    // Properties
    FScreenSpy: TScreenSpy;
    // Golbal variable
    SBIndex: Integer; // ScreenBitmaps' Index
    IsIFrame: Boolean;
    TCWhenCapture: Cardinal;
  protected
    Procedure CaptureScreen; Virtual;
    procedure ScreenBitmap;
    Procedure FrameStart;
    Procedure FrameEnd;
    procedure Execute; override;
    property ScreenSpy: TScreenSpy read FScreenSpy write FScreenSpy;
  public
    constructor Create; reintroduce;
    destructor Destroy; override;
  end;

  TScreenSpy = class(TComponent)
  private
    { Private declarations }
    // Properties
    FIFrame: Cardinal;
    FActive: Boolean;
    FThreadPriority: TThreadPriority;
    FScreenCanvas: TCanvas;
    FScreenWidth: Word;
    FScreenHeight: Word;
    FBytesPerPixel: Byte;
    FPixelFormat: TPixelFormat;
    FMaxFrameRate: Byte;
    FMaxBlockSize: Integer;
    FBlockRowCount: Integer;
    FBlockColumnCount: Integer;
    FBlockCount: Integer;
    FBlockWidth: Integer;
    FBlockHeight: Integer;
    FBlockSize: Integer;
    FBlockBound: TRect; // Block size = (0, 0, BWidth, BHeight)
    FFrameCount: Cardinal;
    // Events
    FOnScreenBitmap: TScreenSpyBitmapEvent;
    FOnFrameStart: TFrameStartEvent;
    FOnFrameEnd: TFrameEndEvent;
    // Golbal private Variables
    HasBitmapEvent: Boolean;
    MaxDelayMilliseconds: Cardinal;
    ScreenBitmaps: array of TScreenBlock;
    LastScreen: array of Pointer;
    BMPBlockSize: Integer; // Size of Bitmap for one block
    MemoryAllowcated: Boolean;
    SCThread: TScreenSpyThread;
    Procedure SetActive(const Value: Boolean);
    Procedure SetThreadPriority(const Value: TThreadPriority);
    Procedure SetMaxBlockSize(const Value: Integer);
    Procedure SetMaxFrameRate(const Value: Byte);
    Procedure SetIFrame(const Value: Cardinal);
  protected
    { Protected declarations }
    procedure CalculateScreenData;
    procedure ReleaseScreenData;
    procedure DoScreenBitmap(ScreenBitmapIndex: Integer; IsIFrame: Boolean);
    procedure DoFrameStart(const IsIFrame: Boolean);
    procedure DoFrameEnd(const IsIFrame: Boolean);
  public
    { Public declarations }
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
    Property ScreenCanvas: TCanvas read FScreenCanvas;
    Property ScreenWidth: Word read FScreenWidth;
    Property ScreenHeight: Word read FScreenHeight;
    Property BytesPerPixel: Byte read FBytesPerPixel;
    Property PixelFormat: TPixelFormat read FPixelFormat;
    Property BlockCount: Integer read FBlockCount;
    Property BlockRowCount: Integer read FBlockRowCount;
    Property BlockColumnCount: Integer read FBlockColumnCount;
    Property BlockWidth: Integer read FBlockWidth;
    Property BlockHeight: Integer read FBlockHeight;
    Property BlockSize: Integer read FBlockSize;
    Property BlockBound: TRect read FBlockBound;
    Property FrameCount: Cardinal read FFrameCount;
  published
    { Published declarations }
    Property OnScreenBitmap: TScreenSpyBitmapEvent read FOnScreenBitmap write FOnScreenBitmap;
    Property OnFrameStart: TFrameStartEvent read FOnFrameStart write FOnFrameStart;
    Property OnFrameEnd: TFrameEndEvent read FOnFrameEnd write FOnFrameEnd;
    Property IFrame: Cardinal read FIFrame write SetIFrame default 30;
    Property ThreadPriority: TThreadPriority read FThreadPriority write SetThreadPriority default tpNormal;
    Property MaxBlockSize: Integer read FMaxBlockSize write SetMaxBlockSize default 30000;
    Property MaxFrameRate: Byte read FMaxFrameRate write SetMaxFrameRate default 10;
    Property Active : Boolean read FActive write SetActive default False;
  end;

  TSFastRLE = class(TObject)
  private
    t, s: Pointer;
    function PackSeg(Source, Target: Pointer; SourceSize: Word): Word;
    function UnPackSeg(Source, Target: Pointer; SourceSize: Word): Word;
  protected
  public
    Constructor Create;
    Destructor Destroy; override;
    function Pack(Source, Target: Pointer; SourceSize: LongInt): LongInt; { Return TargetSize }
    function UnPack(Source, Target: Pointer; SourceSize: LongInt): LongInt; {Return TargetSize }
    function PackString(Source: String): String;
    function UnPackString(Source: String): String;
    function PackFile(SourceFileName, TargetFileName: String): Boolean; { Return FALSE if IOError }
    function UnPackFile(SourceFileName, TargetFileName: String): Boolean; { Return FALSE if IOError }
  end;

{ Protocol }
Const
  RID_Invalid    = $00;
  RID_Header     = $02;
  RID_Block      = $04;
  RID_FrameStart = $06;
  RID_FrameEnd   = $08;
  RID_MousePos   = $0A;
  RID_Start      = $0C;
  RID_Stop       = $0E;

type
  TRID = Word;
  TRSize = Cardinal;
  TScreenDataStyle = (sdsUncompress, sdsRLENormal, sdsRLEXor);

Type // Data type for transmission pack
  TftAny= Packed Record
    dwSize: TRSize;
    PackID : TRID;
    Data: Array [0..0] of Byte;
  End;
  PftAny= ^TftAny;

  TftHeader= Packed Record
    dwSize: TRSize;
    PackID : TRID;
    ScreenWidth: Word;
    ScreenHeight: Word;
    BytesPerPixel: Byte;
    BlockWidth: Word;
    BlockHeight: Word;
  End;
  PftHeader = ^TftHeader;

  TftBlock = Packed Record
    dwSize: TRSize;
    PackID: TRID;
    BlockIndex: Cardinal;
    FrameStyle: TScreenDataStyle;
    Data: Array [0..0] of Byte;
  End;
  PftBlock = ^TftBlock;

  TftFrameStart = Packed Record
    dwSize: TRSize;
    PackID: TRID;
    FrameCount: Cardinal;
    IsIFrame: Boolean;
  End;
  PftFrameStart = ^TftFrameStart;

  TftFrameEnd = Packed Record
    dwSize: TRSize;
    PackID: TRID;
    FrameCount: Cardinal;
    IsIFrame: Boolean;
    HasBitmapEvent: Boolean;
  End;
  PftFrameEnd = ^TftFrameEnd;

Const
  SizeOfTftBlock = SizeOf(TftBlock);
  SizeOfTftHeader = SizeOf(TftHeader);
  SizeOfTftFrameStart = SizeOf(TftFrameStart);
  SizeOfTftFrameEnd = SizeOf(TftFrameEnd);


{ TScreen Transfer}
Type
  TScreenEncoder = class(TComponent)
  private
    { Private declarations }
    // Properties
    FActive : Boolean;
    FBlockDelay : Cardinal;
    FBlockInterval: Cardinal;
    FIFrameDelay: Cardinal;
    // Events
    FOnFrameStart: TFrameStartEvent;
    FOnFrameEnd: TFrameEndEvent;
    // Golbal variables
    FScreenSpy : TScreenSpy;
    FUDPSender : TUDPSender;
    FSFastRLE : TSFastRLE;
    XorDataPtr: array [1..4] of Pointer; // MAX 4 bytes per pixel
    RHeader : TftHeader;
    RFrameStart: TftFrameStart;
    RFrameEnd: TftFrameEnd;
    Blockptr: PftBlock;
    BlockIntervalCount: Cardinal;
    function GetIFrame: Cardinal;
    function GetMaxBlockSize: Integer;
    function GetMaxFrameRate: Byte;
    function GetThreadPriority: TThreadPriority;
    procedure SetActive(Value: Boolean);
    procedure SetIFrame(const Value: Cardinal);
    procedure SetMaxBlockSize(const Value: Integer);
    procedure SetMaxFrameRate(const Value: Byte);
    procedure SetThreadPriority(const Value: TThreadPriority);
    function GetRemoteHost: String;
    function GetRemoteIP: String;
    function GetRemotePort: Word;
    procedure SetRemoteHost(const Value: String);
    procedure SetRemoteIP(const Value: String);
    procedure SetRemotePort(const Value: Word);
    procedure SetBlockDelay(const Value: Cardinal);
    procedure SetBlockInterval(const Value: Cardinal);
    procedure SetIFrameDelay(const Value: Cardinal);
  protected
    { Protected declarations }
    procedure ScreenSpyOnScreenBitmap(Sender: TObject; const Block: TScreenBlock; LastScanline: Pointer; IsIFrame: Boolean);
    procedure ScreenSpyOnFrameStart(Sender: TObject; const FrameCount: Cardinal; const IsIFrame: Boolean);
    procedure ScreenSpyOnFrameEnd(Sender: TObject; const FrameCount: Cardinal; const IsIFrame: Boolean; const HasBitmapEvent: Boolean);
    Procedure SendHeader;
    procedure DoFrameStart(const FrameCount: Cardinal; const IsIFrame: Boolean); virtual;
    procedure DoFrameEnd(const FrameCount: Cardinal; const IsIFrame: Boolean; const HasBitmapEvent: Boolean); virtual;
  public
    { Public declarations }
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
  published
    { Published declarations }
    Property OnFrameStart: TFrameStartEvent read FOnFrameStart write FOnFrameStart;
    Property OnFrameEnd: TFrameEndEvent read FOnFrameEnd write FOnFrameEnd;
    Property BlockInterval: Cardinal read FBlockInterval write SetBlockInterval default 10;
    Property BlockDelay: Cardinal read FBlockDelay write SetBlockDelay default 1;
    Property IFrameDelay: Cardinal read FIFrameDelay write SetIFrameDelay default 100;
    Property IFrame: Cardinal read GetIFrame write SetIFrame;
    Property ThreadPriority: TThreadPriority read GetThreadPriority write SetThreadPriority;
    Property MaxBlockSize: Integer read GetMaxBlockSize write SetMaxBlockSize;
    Property MaxFrameRate: Byte read GetMaxFrameRate write SetMaxFrameRate;
    property RemoteIP: String read GetRemoteIP write SetRemoteIP;
    property RemoteHost: String read GetRemoteHost write SetRemoteHost;
    property RemotePort: Word read GetRemotePort write SetRemotePort;
    Property Active : Boolean read FActive write SetActive default False;
  end;

  TScreenPlayerBitmapEvent = procedure(Sender: TObject; const Block: TScreenBlock) of object;
  TScreenPlayer = class(TComponent)
  private
    { Private declarations }
    // Properties
    FScreenWidth: Word;
    FScreenHeight: Word;
    FBytesPerPixel: Byte;
    FPixelFormat: TPixelFormat;
    FBlockRowCount: Integer;
    FBlockColumnCount: Integer;
    FBlockCount: Integer;
    FBlockWidth: Integer;
    FBlockHeight: Integer;
    FBlockSize: Integer;
    // Events
    FOnScreenBitmap: TScreenPlayerBitmapEvent;
    FOnHeaderUpdate: TNotifyEvent;
    FOnFrameEnd: TFrameEndEvent;
    FOnFrameStart: TFrameStartEvent;
    // Golbal Variables
    FUDPReceiver : TUDPReceiver;
    FSFastRLE : TSFastRLE;
    XorDataPtr: array [1..4] of Pointer; // MAX 4 bytes per pixel
    ScreenBitmaps: array of TScreenBlock;
    BMPBlockSize: Integer; // Size of Bitmap for one block
    MemoryAllowcated: Boolean;
    Header: TftHeader;
    AnyPtr: PftAny;
    BlockPtr: PftBlock;
    FrameStartPtr: PftFrameStart;
    FrameEndPtr: PftFrameEnd;
    function GetActive: Boolean;
    function GetMulticastIP: String;
    function GetPort: Word;
    procedure SetActive(const Value: Boolean);
    procedure SetMulticastIP(const Value: String);
    procedure SetPort(const Value: Word);
  protected
    { Protected declarations }
    procedure CalculateScreenData; virtual;
    procedure ReleaseScreenData; virtual;
    procedure DoScreenBitmap(ScreenBitmapIndex: Integer); virtual;
    procedure DoHeaderUpdate;
    procedure UDPReceiverOnUDPData(Sender: TObject; const Buffer: Pointer; const RecvSize:Integer; const Peer: string; const Port: Integer); virtual;
  public
    { Public declarations }
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
    Property ScreenWidth: Word read FScreenWidth;
    Property ScreenHeight: Word read FScreenHeight;
    Property BytesPerPixel: Byte read FBytesPerPixel;
    Property PixelFormat: TPixelFormat read FPixelFormat;
    Property BlockCount: Integer read FBlockCount;
    Property BlockRowCount: Integer read FBlockRowCount;
    Property BlockColumnCount: Integer read FBlockColumnCount;
    Property BlockWidth: Integer read FBlockWidth;
    Property BlockHeight: Integer read FBlockHeight;
    Property BlockSize: Integer read FBlockSize;
  published
    { Published declarations }
    Property OnScreenBitmap: TScreenPlayerBitmapEvent read FOnScreenBitmap write FOnScreenBitmap;
    Property OnHeaderUpdate: TNotifyEvent read FOnHeaderUpdate write FOnHeaderUpdate;
    Property OnFrameStart: TFrameStartEvent read FOnFrameStart write FOnFrameStart;
    Property OnFrameEnd: TFrameEndEvent read FOnFrameEnd write FOnFrameEnd;
    property Port: Word read GetPort write SetPort;
    property MulticastIP: String read GetMulticastIP write SetMulticastIP;
    property Active: Boolean read GetActive write SetActive default False;
  end;

procedure Register;

resourcestring
  ESSACTIVED = 'Connot perform this action while component is in active!';
  ESSINVALIDVALUE = 'Invalid value assigned!';
implementation

procedure Register;
begin
  RegisterComponents('Samples', [TScreenSpy, TScreenEncoder, TScreenPlayer]);
end;

{ TScreenSpy }

procedure TScreenSpy.CalculateScreenData;
  //  e.g.: ANumber = 800, MaxRoot = 21; Result = 20 (800 mod 20=0)
  Function MultiRoot(ANumber, MaxRoot: Cardinal): Cardinal;
  Begin
    If MaxRoot>0 then
      While (ANumber mod MaxRoot)<>0 do
        MaxRoot:= MaxRoot-1;
    Result:= MaxRoot;
  End;
  //  e.g.: ANumber = 800, MinRoot=20, MaxRoot = 41; Result = 40 (800 mod 40=0)
  Function MaxRootOf(ANumber, MinRoot, MaxRoot: Cardinal): Cardinal;
  Begin
    If (MaxRoot>0) and (MinRoot>0) then
      While ((ANumber mod MaxRoot)<>0) and (MaxRoot>=MinRoot) do
        MaxRoot:= MaxRoot-1;

    If MaxRoot>=MinRoot then
      Result:= MaxRoot
    Else
      Result:= 0; // not found
  End;
Var
  i: Integer;
  BitsPerPixel: Integer;
begin
  If MemoryAllowcated then
    ReleaseScreenData;
  MemoryAllowcated:= True;

// Find system information for screen
  // Get ready to capture screen
  FScreenCanvas.Handle:= GetDC(0);
  // Get All information about screen
  FScreenWidth:= Screen.Width;
  FScreenHeight:= Screen.Height;
  BitsPerPixel := GetDeviceCaps(ScreenCanvas.Handle, BITSPIXEL);
  Case BitsPerPixel of
    8 :
      Begin
        FBytesPerPixel:= 1;
        FPixelFormat:= pf8bit;
      End;
    16:
      Begin
        FBytesPerPixel:= 2;
        FPixelFormat:= pf16bit;
      End;
    24:
      Begin
        FBytesPerPixel:= 3;
        FPixelFormat:= pf24bit;
      End;
    32:
      Begin
        FBytesPerPixel:= 4;
        FPixelFormat:= pf32bit;
      End;
    Else
      Begin
        FBytesPerPixel:= 3;
        FPixelFormat:= pf24bit;
      End;
  End;{CASE}

// Calculate Block information
  // Max block area for avaliable block size
  i:= FMaxBlockSize div FBytesPerPixel;
  FBlockHeight:= Trunc(sqrt(i));
  FBlockHeight:= MultiRoot(ScreenHeight, FBlockHeight);
  FBlockWidth:= i div FBlockHeight;
  FBlockWidth:= MultiRoot(ScreenWidth, FBlockWidth);
  FBlockHeight:= MaxRootOf(ScreenHeight, FBlockHeight, i div FBlockWidth);
  FBlockSize:= BlockWidth * FBlockHeight;
  BMPBlockSize := BlockSize * BytesPerPixel;
  FBlockColumnCount:= FScreenWidth div FBlockWidth;
  FBlockRowCount:= FScreenHeight div FBlockHeight;
  FBlockCount:= FBlockColumnCount * FBlockRowCount;

// Re-Allocate memory
  // Create off-screen memory for store last screen
  SetLength(LastScreen, BlockCount);
  For i:=0 to BlockCount-1 do
  Begin
    GetMem(LastScreen[i], BMPBlockSize);
    FillChar(LastScreen[i]^, BMPBlockSize, $0);
  End;

  // Get buffer for send-data
  // GetMem(ScreenBlockPtr, SizeOf(TScreenBlock)+BMPBlockSize+8);
  //ScreenBlockPtr^.UNID:= 0; // In fact it is a user defined value
  //ScreenBlockDataPtr:= @(ScreenBlockPtr^.Data[0]); // Why use it?

  FBlockBound:= Rect(0, 0, FBlockWidth, FBlockHeight);
  // Create temp bitmap for copy a pice of desktop image
  SetLength(ScreenBitmaps, BlockCount);
  For i:=0 to BlockCount-1 do
  Begin
    ScreenBitmaps[i].BlockIndex:= i;
    ScreenBitmaps[i].Bound:= Rect(0,0,BlockWidth,BlockHeight);
    OffsetRect(ScreenBitmaps[i].Bound, (i mod FBlockColumnCount) * FBlockWidth, (i div FBlockColumnCount) * FBlockHeight);
    {ScreenBitmaps[i].Bound:= Rect((i mod BlockWidth) * BMPBlockWidth, (i div BlockWidth) * BMPBlockHeight,
                                  (i mod BlockWidth) * BMPBlockWidth + BMPBlockWidth, (i div BlockWidth) * BMPBlockHeight + BMPBlockHeight);{}
    ScreenBitmaps[i].BMP:= TBitmap.Create;
    With ScreenBitmaps[i].BMP do
    Begin
      Width:= BlockWidth;
      Height:= BlockHeight;
      PixelFormat:= FPixelFormat;
      If Cardinal(ScanLine[0])<Cardinal(ScanLine[1]) then
        ScreenBitmaps[i].ptr:= ScanLine[0]
      Else
        ScreenBitmaps[i].ptr:= ScanLine[Height-1];
    End;
  End;
end;

constructor TScreenSpy.Create(AOwner: TComponent);
begin
  inherited;
  // Init default properties
  FMaxBlockSize := 30000;
  FMaxFrameRate := 0;
  MaxFrameRate := 10;
  FIFrame := 30;
  FActive:= False;
  FThreadPriority:= tpNormal;
  FScreenCanvas:= TCanvas.Create;
  // Calculate information of screen
  MemoryAllowcated:= False;
  if not (csLoading in ComponentState) and not (csDesigning in ComponentState) then
    CalculateScreenData;
end;

destructor TScreenSpy.Destroy;
begin
  Active:= False;
  ReleaseScreenData;
  FScreenCanvas.Free;
  inherited;
end;

procedure TScreenSpy.DoFrameEnd(const IsIFrame: Boolean);
begin
  If Assigned(FOnFrameEnd) then
    FOnFrameEnd(Self, FrameCount, IsIFrame, HasBitmapEvent);
end;

procedure TScreenSpy.DoFrameStart(const IsIFrame: Boolean);
begin
  If Assigned(FOnFrameStart) then
    FOnFrameStart(Self, FrameCount, IsIFrame);
end;

procedure TScreenSpy.DoScreenBitmap(ScreenBitmapIndex: Integer;
  IsIFrame: Boolean);
begin
  If Assigned(FOnScreenBitmap) then
  try
    FOnScreenBitmap(Self, ScreenBitmaps[ScreenBitmapIndex], LastScreen[ScreenBitmapIndex], IsIFrame);
  except
    FOnScreenBitmap:= nil;
  end;
end;

procedure TScreenSpy.ReleaseScreenData;
Var
  i: Integer;
begin
  If MemoryAllowcated then
  Begin
    If FActive then
      Raise EScrSpy.CreateRes(@ESSACTIVED);