scrspy.pas

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

  FIFrameDelay:= 100;
// Create aggerated components
  FSFastRLE:= TSFastRLE.Create;
  FUDPSender:= TUDPSender.Create(Self);
  FScreenSpy:= TScreenSpy.Create(Self);
  FScreenSpy.OnScreenBitmap:= ScreenSpyOnScreenBitmap;
  FScreenSpy.OnFrameStart:= ScreenSpyOnFrameStart;
  FScreenSpy.OnFrameEnd:= ScreenSpyOnFrameEnd;
// default golbal value
  {Records}
  With RHeader do
  Begin
    dwSize:= SizeOfTftHeader;
    PackID:= RID_Header;
  End;
  With RFrameStart do
  Begin
    dwSize:= SizeOfTftFrameStart;
    PackID:= RID_FrameStart;
  End;
  With RFrameEnd do
  Begin
    dwSize:= SizeOfTftFrameEnd;
    PackID:= RID_FrameEnd;
  End;
  {Block}
  Blockptr:= nil;
  XorDataPtr[1]:= nil;
  MaxBlockSize:= FScreenSpy.MaxBlockSize;
end;

destructor TScreenEncoder.Destroy;
begin
  Active:= False;
  FScreenSpy.Free;
  FUDPSender.Free;
  FSFastRLE.Free;
  // Free golbal pointers
    If Assigned(Blockptr) then
      FreeMem(Blockptr);
    If Assigned(XorDataPtr[1]) then
      FreeMem(XorDataPtr[1]);
  inherited;
end;

procedure TScreenEncoder.ScreenSpyOnScreenBitmap(Sender: TObject;
  const Block: TScreenBlock; LastScanline: Pointer; IsIFrame: Boolean);
Var
  i, l: Integer;
  PackedSize: Integer;
  ptrNow, ptrLast: ^Byte;
  ptrXOR: array [1..4] of ^Byte; // Max 4 bytes per pixel
begin
  If IsIFrame then
  Begin // Send IFrame
    With Blockptr^ do
    Begin
      BlockIndex:= Block.BlockIndex;
      FrameStyle:= sdsRLENormal;
      //Compress
      PackedSize:= FSFastRLE.Pack(Block.ptr, @(Blockptr^.Data[0]), FScreenSpy.BMPBlockSize);
      If PackedSize>0 then
      Begin
        dwSize:= SizeofTftBlock-1+PackedSize;
        FUDPSender.SendBuf(Blockptr^, Blockptr^.dwSize);
        // Delay when Interval
        BlockIntervalCount:= (BlockIntervalCount+1) mod FBlockInterval;
        If BlockIntervalCount=0 then
          Sleep(FBlockDelay);
      End;
    End;
  End Else
  Begin // Send NON IFrame
    With FScreenSpy, Blockptr^ do
    Begin
      { Init Packet values }
      BlockIndex:= Block.BlockIndex;
      FrameStyle:= sdsRLEXor;
      { Xor }
      ptrNow:= Block.ptr;
      ptrLast:= LastScanLine;
      For i:=1 to BytesPerPixel do
        ptrXOR[i]:= XorDataPtr[i];
      For i:=1 to BlockSize do
      Begin
        // Move (R, G, B) to each area if (24bits), for better RLE compression.
        For l:=1 to BytesPerPixel do
        Begin
          ptrXOR[l]^:= ptrNow^ xor ptrLast^;   // XOR
          Inc(ptrNow);
          Inc(ptrLast);
          Inc(ptrXOR[l]);
        End;
      End;
      { Compress }
      PackedSize:= FSFastRLE.Pack(XorDataPtr[1], @(Blockptr^.Data[0]), BMPBlockSize);
      { Send }
      If PackedSize>0 then
      Begin
        dwSize:= SizeofTftBlock-1+PackedSize;
        FUDPSender.SendBuf(Blockptr^, Blockptr^.dwSize);
        // Delay when Interval
        BlockIntervalCount:= (BlockIntervalCount+1) mod FBlockInterval;
        If BlockIntervalCount=0 then
          Sleep(FBlockDelay);
      End;
    End;
  End;
end;

function TScreenEncoder.GetIFrame: Cardinal;
begin
  Result:= FScreenSpy.IFrame;
end;

function TScreenEncoder.GetMaxBlockSize: Integer;
begin
  Result:= FScreenSpy.MaxBlockSize;
end;

function TScreenEncoder.GetMaxFrameRate: Byte;
begin
  Result:= FScreenSpy.MaxFrameRate;
end;

function TScreenEncoder.GetRemoteHost: String;
begin
  Result:= FUDPSender.RemoteHost;
end;

function TScreenEncoder.GetRemoteIP: String;
begin
  Result:= FUDPSender.RemoteIP;
end;

function TScreenEncoder.GetRemotePort: Word;
begin
  Result:= FUDPSender.RemotePort;
end;

function TScreenEncoder.GetThreadPriority: TThreadPriority;
begin
  Result:= FScreenSpy.ThreadPriority;
end;

procedure TScreenEncoder.SetActive(Value: Boolean);
begin
  If Value<>FActive then
  try
    If Value then
    Begin
      // Init
      BlockIntervalCount:= 0;

      try
        FUDPSender.Active:= True; // Active UDP sender first
      except
        Value:= False;
        Raise;
      end;
      If Value then
        SendHeader;
      try
        FScreenSpy.Active:= Value;
      except
        Value:= False;
        Raise;
      end;
    End;

    If Not Value then
    Begin
      FScreenSpy.Active:= Value; // Deactive ScreenSpy first
      FUDPSender.Active:= Value;
    End;
  finally
    FActive:= Value;
  end;
end;

procedure TScreenEncoder.SetIFrame(const Value: Cardinal);
begin
  FScreenSpy.IFrame:= Value;
end;

procedure TScreenEncoder.SetMaxBlockSize(const Value: Integer);
Var
  i: Integer;
begin
  If Active then
    Raise EScrSpy.CreateRes(@ESSACTIVED);

  FScreenSpy.MaxBlockSize:= Value;
  try
    If Assigned(Blockptr) then
      FreeMem(Blockptr);
    If Assigned(XorDataPtr[1]) then
      FreeMem(XorDataPtr[1]);
  finally
    With FScreenSpy do
    Begin
      // GetBlock
      GetMem(Blockptr, SizeofTftBlock+BMPBlockSize+8);
      FillChar(Blockptr^, SizeofTftBlock+BMPBlockSize, 0);
      Blockptr^.PackID:= RID_BLOCK;
      // GetXor
      GetMem(XorDataPtr[1], BMPBlockSize);
      For i:=2 to BytesPerPixel do
        XorDataPtr[i]:= Pointer(Integer(XorDataPtr[1])+Integer(BlockSize)*(i-1));
    End;
  end;
end;

procedure TScreenEncoder.SetMaxFrameRate(const Value: Byte);
begin
  FScreenSpy.MaxFrameRate:= Value;
end;

procedure TScreenEncoder.SetRemoteHost(const Value: String);
begin
  FUDPSender.RemoteHost:= Value;
end;

procedure TScreenEncoder.SetRemoteIP(const Value: String);
begin
  FUDPSender.RemoteIP:= Value;
end;

procedure TScreenEncoder.SetRemotePort(const Value: Word);
begin
  FUDPSender.RemotePort:= Value;
end;

procedure TScreenEncoder.SetThreadPriority(const Value: TThreadPriority);
begin
  FScreenSpy.ThreadPriority:= Value;
end;

procedure TScreenEncoder.SendHeader;
begin
  If Not FScreenSpy.MemoryAllowcated then
    FScreenSpy.CalculateScreenData;

  With RHeader do
  Begin
    ScreenWidth:= FScreenSpy.ScreenWidth;
    ScreenHeight:= FScreenSpy.ScreenHeight;
    BytesPerPixel:= FScreenSpy.BytesPerPixel;
    BlockWidth:= FScreenSpy.BlockWidth;
    BlockHeight:= FScreenSpy.BlockHeight;
  End;
  FUDPSender.SendBuf(RHeader, RHeader.dwSize);
end;

procedure TScreenEncoder.SetBlockDelay(const Value: Cardinal);
begin
  FBlockDelay := Value;
end;

procedure TScreenEncoder.ScreenSpyOnFrameEnd(Sender: TObject;
  const FrameCount: Cardinal; const IsIFrame, HasBitmapEvent: Boolean);
begin
  DoFrameEnd(FrameCount, IsIFrame, HasBitmapEvent);
  If IsIFrame then
    Sleep(FIFrameDelay);
end;

procedure TScreenEncoder.DoFrameEnd(const FrameCount: Cardinal;
  const IsIFrame, HasBitmapEvent: Boolean);
begin
  RFrameEnd.FrameCount:= FrameCount;
  RFrameEnd.IsIFrame:= IsIFrame;
  RFrameEnd.HasBitmapEvent:= HasBitmapEvent;
  FUDPSender.SendBuf(RFrameEnd, RFrameEnd.dwSize);

  If Assigned(FOnFrameEnd) then
    FOnFrameEnd(Self, FrameCount, IsIFrame, HasBitmapEvent);
end;

procedure TScreenEncoder.DoFrameStart(const FrameCount: Cardinal;
  const IsIFrame: Boolean);
begin
  RFrameStart.FrameCount:= FrameCount;
  RFrameStart.IsIFrame:= IsIFrame;
  FUDPSender.SendBuf(RFrameStart, RFrameStart.dwSize);

  If Assigned(FOnFrameStart) then
    FOnFrameStart(Self, FrameCount, IsIFrame);
end;

procedure TScreenEncoder.ScreenSpyOnFrameStart(Sender: TObject;
  const FrameCount: Cardinal; const IsIFrame: Boolean);
begin
  DoFrameStart(FrameCount, IsIFrame);
end;

procedure TScreenEncoder.SetBlockInterval(const Value: Cardinal);
begin
  FBlockInterval := Value;
end;

procedure TScreenEncoder.SetIFrameDelay(const Value: Cardinal);
begin
  FIFrameDelay := Value;
end;

{ TScreenPlayer }

procedure TScreenPlayer.CalculateScreenData;
Var
  i: Integer;
begin
  If MemoryAllowcated then
    ReleaseScreenData;

  With Header do
  Begin
    FScreenWidth:= ScreenWidth;
    FScreenHeight:= ScreenHeight;
    FBytesPerPixel:= BytesPerPixel;
    FBlockWidth:= BlockWidth;
    FBlockHeight:= BlockHeight;
  End;
  Case FBytesPerPixel of
    1: FPixelFormat:= pf8Bit;
    2: FPixelFormat:= pf16Bit;
    3: FPixelFormat:= pf24Bit;
    4: FPixelFormat:= pf32Bit;
    Else FPixelFormat:= pf24Bit;
  End;{CASE}
  FBlockColumnCount:= FScreenWidth div FBlockWidth;
  FBlockRowCount:= FScreenHeight div FBlockHeight;
  FBlockCount:= FBlockColumnCount * FBlockRowCount;
  FBlockSize:= FBlockWidth * FBlockHeight;
  BMPBlockSize:= FBlockSize * FBytesPerPixel;

  // Get Buffer for Decode Screen block
  GetMem(XorDataPtr[1], BMPBlockSize);
  For i:=2 to BytesPerPixel do
    XorDataPtr[i]:= Pointer(Integer(XorDataPtr[1])+BlockSize*(i-1));

  // 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;

  MemoryAllowcated:= True;
end;

constructor TScreenPlayer.Create(AOwner: TComponent);
begin
  inherited;
  FSFastRLE := TSFastRLE.Create;
  FUDPReceiver:= TUDPReceiver.Create(Self);
  FUDPReceiver.OnUDPData:= UDPReceiverOnUDPData;
  MemoryAllowcated:= False;
end;

destructor TScreenPlayer.Destroy;
begin
  Active:= False;
  FUDPReceiver.Free;
  FSFastRLE.Free;
  ReleaseScreenData;
  inherited;
end;

procedure TScreenPlayer.DoHeaderUpdate;
begin
  If Assigned(FOnHeaderUpdate) then
    FOnHeaderUpdate(Self);
end;

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

function TScreenPlayer.GetActive: Boolean;
begin
  Result := FUDPReceiver.Active;
end;

function TScreenPlayer.GetMulticastIP: String;
begin
  Result := FUDPReceiver.MulticastIP;
end;

function TScreenPlayer.GetPort: Word;
begin
  Result := FUDPReceiver.Port;
end;

procedure TScreenPlayer.ReleaseScreenData;
Var
  i: Integer;
begin
  If MemoryAllowcated then
  Begin
    {If Active then
      Raise EScrSpy.CreateRes(@ESSACTIVED);{}
    MemoryAllowcated:= False;
    // Do release
    For i:=2 to BytesPerPixel do
      XorDataPtr[i]:= nil;
    FreeMem(XorDataPtr[1]);
    For i:=0 to BlockCount-1 do
    Begin
      ScreenBitmaps[i].ptr:= nil;
      ScreenBitmaps[i].BMP.Free;
    End;
    SetLength(ScreenBitmaps, 0);
  End;
end;

procedure TScreenPlayer.SetActive(const Value: Boolean);
begin
  FUDPReceiver.Active:= Value;
end;

procedure TScreenPlayer.SetMulticastIP(const Value: String);
begin
  FUDPReceiver.MulticastIP:= Value;
end;

procedure TScreenPlayer.SetPort(const Value: Word);
begin
  FUDPReceiver.Port:= Value;
end;

procedure TScreenPlayer.UDPReceiverOnUDPData(Sender: TObject;
  const Buffer: Pointer; const RecvSize: Integer; const Peer: string;
  const Port: Integer);
Var
  i, l: Integer;
  ScanLinePtr: ^Byte;  
  PtrXor: array [1..4] of ^Byte; // MAX 4 bytes per pixel
begin
  AnyPtr:= Buffer;
  If Anyptr.dwSize <> TRSize(RecvSize) then
    Exit; // Error

  Case AnyPtr.PackID of
    RID_HEADER:
      Begin
        Move(AnyPtr^, Header, AnyPtr^.dwSize);
        CalculateScreenData;
        DoHeaderUpdate;
      End;

    RID_BLOCK:
      If MemoryAllowcated then
      Begin
        BlockPtr:= Pointer(AnyPtr);
        With BlockPtr^ do
          Case FrameStyle of
            sdsRLENormal:
              Begin
                //decompress
                //FSFastRLE.UnPack(@(Data[0]), ScreenBitmaps[BlockIndex].ptr, dwSize+1-SizeofTftBlock);
                FSFastRLE.UnPack(@(Data[0]), XorDataPtr[1], dwSize+1-SizeofTftBlock);
                Move(XorDataPtr[1]^, ScreenBitmaps[BlockIndex].ptr^, BMPBlockSize);
                DoScreenBitmap(BlockIndex);
              End;

            sdsRLEXor:
              Begin
                FSFastRLE.UnPack(@(Data[0]), XorDataPtr[1], dwSize+1-SizeofTftBlock);
                // Init First Pointer for sequence XOR
                ScanLinePtr:= ScreenBitmaps[BlockIndex].ptr;
                For i:=0 to BytesPerPixel do
                  PtrXor[i]:= XorDataPtr[i];

                For i:=0 to BlockSize-1 do
                Begin
                  For l:=1 to BytesPerPixel do
                  Begin
                    ScanLinePtr^:= ScanLinePtr^ xor PtrXor[l]^;
                    Inc(ScanLinePtr);
                    Inc(PtrXor[l]);
                  End;
                End;
                DoScreenBitmap(BlockIndex);
              End;
          End;{CASE}
      End;

    RID_FrameStart:
      Begin
        FrameStartPtr:= Pointer(AnyPtr);
        If Assigned(FOnFrameStart) then
          FOnFrameStart(Self, FrameStartPtr^.FrameCount, FrameStartPtr^.IsIFrame);
      End;

    RID_FrameEnd:
      Begin
        FrameEndPtr:= Pointer(AnyPtr);
        If Assigned(FOnFrameEnd) then
          FOnFrameEnd(Self, FrameEndPtr^.FrameCount, FrameEndPtr^.IsIFrame, FrameEndPtr^.HasBitmapEvent);
      End;

    Else //Error
  End;{CASE}
end;

end.