屏幕传输ScreenSpy.pas单元加光标版

屏幕传输ScreenSpy.pas单元原本传输的屏幕图像中没有看见鼠标，小的只是加多了个可以看见鼠标进去，呵呵。



unit ScreenSpy;

interface

uses
  Windows, Classes, Variants, SysUtils, Graphics, Controls, Math, OverbyteIcsWSocket, Clipbrd, ZLibEx;

const
  DEF_STEP = 23;
  OFF_SET  = 24;

type
  PCapCmd = ^TCapCmd;
  TCapCmd = packed record
    Cmd:    Byte;
    Size:   Integer;
    Width:  Word;
    Height: Word;
  end;

  PCtlCmd = ^TCtlCmd;
  TCtlCmd = packed record
    Cmd:  Byte;
    X, Y: Word;
  end;

  TScreenSpy = class(TThread)
  private
    FScrStream: TMemoryStream;
    FSendStream: TMemoryStream;
    FFullBmp, FLineBmp, FRectBmp: TBitmap;
    FWidth, FHeight, FLine: Integer;
    FRect: TRect;
    FSocket: TWSocket;
    FCmd: TCapCmd;
    vCursor:HCURSOR;
    vDC:HDC;
    //
    function CheckScr: Boolean;
    function GetFirst: Boolean;
    function GetNext:  Boolean;
    function Compress: Boolean;
    function SendInfo: Boolean;
    function SendData: Boolean;
    procedure CopyRect(rt: TRect);
  protected
    procedure Execute; override;
  public
    constructor Create(ASocket: TWSocket); reintroduce;
    destructor Destroy; override;
  end;

implementation

constructor TScreenSpy.Create(ASocket: TWSocket);
begin
  FreeOnTerminate := True;
  FSocket := ASocket;
  FScrStream  := TMemoryStream.Create;
  FSendStream := TMemoryStream.Create;
  FFullBmp := TBitmap.Create;
  FLineBmp := TBitmap.Create;
  FRectBmp := TBitmap.Create;
  FWidth   := 0;
  FHeight  := 0;
  inherited Create(True);
end;

destructor TScreenSpy.Destroy;
begin
  FScrStream.Free;
  FSendStream.Free;
  FRectBmp.Destroy;
  FFullBmp.Destroy;
  FLineBmp.Destroy;
  inherited Destroy;
end;

procedure TScreenSpy.Execute;
begin
  while (not Terminated) and (FSocket.State = wsConnected) do
  begin
    if CheckScr then GetFirst else GetNext;
  end;
end;

function TScreenSpy.CheckScr: Boolean;
var
  nWidth, nHeight: Integer;
begin
  Result  := False;
  nWidth  := GetSystemMetrics(SM_CXSCREEN);
  nHeight := GetSystemMetrics(SM_CYSCREEN);
  if (nWidth <> FWidth) or (nHeight <> FHeight) then
  begin
    FWidth  := nWidth;
    FHeight := nHeight;
    FFullBmp.Width  := FWidth;
    FFullBmp.Height := FHeight;
    FLineBmp.Width  := FWidth;
    FLineBmp.Height := 1;
    FFullBmp.PixelFormat := pf15bit;
    FLineBmp.PixelFormat := pf15bit;
    FRectBmp.PixelFormat := pf15bit;
    FLine  := 0;
    Result := True;
  end;
end;

function TScreenSpy.GetFirst: Boolean;
begin
  SetCursor(LoadCursor(0,IDC_ARROW));
  vCursor:=GetCursor;
  vDC:=GetDC(0);
  FFullBmp.Canvas.Lock;
  BitBlt(FFullBmp.Canvas.Handle, 0, 0, FWidth, FHeight, vDC, 0, 0, SRCCOPY);
  DrawIcon(FFullBmp.Canvas.Handle,Mouse.CursorPos.X,Mouse.CursorPos.Y,vCursor);
  FFullBmp.Canvas.Unlock;
  ReleaseDC(0, vDC);
  SetRect(FRect, 0, 0, FWidth, FHeight);
  FScrStream.Clear;
  FScrStream.WriteBuffer(FRect, SizeOf(TRect));
  FFullBmp.SaveToStream(FScrStream);
  Result := Compress;
  if Result then
  begin
    SendInfo;
    Result := SendData;
  end;
end;

procedure TScreenSpy.CopyRect(rt: TRect);
begin
  FFullBmp.Canvas.Lock;
  FRectBmp.Canvas.Lock;
  try
    SetCursor(LoadCursor(0,IDC_ARROW));
    vCursor:=GetCursor;
    vDC:=GetDC(0);
    FRectBmp.Width  := rt.Right  - rt.Left;
    FRectBmp.Height := rt.Bottom - rt.Top;
    BitBlt(FFullBmp.Canvas.Handle, rt.Left, rt.Top, FRectBmp.Width, FRectBmp.Height, vDC, rt.Left, rt.Top, SRCCOPY);
    DrawIcon(FFullBmp.Canvas.Handle,Mouse.CursorPos.X,Mouse.CursorPos.Y,vCursor);
    BitBlt(FRectBmp.Canvas.Handle, 0, 0, FRectBmp.Width, FRectBmp.Height, FFullBmp.Canvas.Handle, rt.Left, rt.Top, SRCCOPY);
    FScrStream.WriteBuffer(FRect, SizeOf(TRect));
    FRectBmp.SaveToStream(FScrStream);
  finally
    FFullBmp.Canvas.Unlock;
    FRectBmp.Canvas.Unlock;
  end;
end;

function TScreenSpy.GetNext: Boolean;
var
  p1, p2: PDWORD;
  i, j: Integer;
begin
  Result := False;
  FScrStream.Clear;
  vCursor:=GetCursor;
  vDC:=GetDC(0);
  i := FLine;
  FLineBmp.Canvas.Lock;
  while i < FHeight do
  begin
    BitBlt(FLineBmp.Canvas.Handle, 0, 0, FWidth, 1, vDC, 0, i, SRCCOPY);
    DrawIcon(FLineBmp.Canvas.Handle,Mouse.CursorPos.X,Mouse.CursorPos.Y,vCursor);
    p1 := FFullBmp.ScanLine[i];
    p2 := FLineBmp.ScanLine[0];
    SetRect(FRect, -1, Max(i - DEF_STEP, 0), -1, Min(i + DEF_STEP * 2, FHeight));
    j := 0;
    while j < FWidth do
    begin
      if (p1^ <> p2^) then
      begin
        if (FRect.Right < 0) then FRect.Left := Max(j - OFF_SET, 0);
        FRect.Right := Min(j + OFF_SET, FWidth);
      end;
      Inc(p1);
      Inc(p2);
      Inc(j, 2);
    end;
    if (FRect.Right > -1) then 
    begin
      CopyRect(FRect);
      SetRect(FRect, -1, -1, -1, -1);
      Inc(i, DEF_STEP);
    end;
    Inc(i, DEF_STEP);
  end;
  FLineBmp.Canvas.Unlock;
  FLine := (FLine + 3) mod DEF_STEP;
  if FScrStream.Position > 0 then
  begin
    Result := Compress;
    if Result then Result := SendData;
  end;
  ReleaseDC(0, vDC);
  Sleep(30);
end;

function TScreenSpy.Compress: Boolean;
begin
  Result := False;
  try
    FSendStream.Clear;
    FScrStream.Position := 0;
    ZCompressStream(FScrStream, FSendStream);
    FSendStream.Position := 0;
    Result := True;
  except
  end;
end;

function TScreenSpy.SendInfo: Boolean;
begin
  try
    FCmd.Cmd  := 1;
    FCmd.Size := 0;
    FCmd.Width  := FWidth;
    FCmd.Height := FHeight;
    FSocket.Send(@FCmd, SizeOf(TCapCmd));
    Result := True;
  except
    Result := False;
  end;
end;

function TScreenSpy.SendData: Boolean;
begin
  try
    FCmd.Cmd := 2;
    FCmd.Size := FSendStream.Size;
    FSocket.Send(@FCmd, SizeOf(TCapCmd));
    FSocket.Send(FSendStream.Memory, FSendStream.Size);
    Result := True;
  except
    Result := False;
  end;
end;

end.