快速远程屏幕传输Indy10版

//主要思路是guanyueguan(BCB_DG)http://iamgyg.blog.163.com的高速屏传代码

这是其中主要的代码

unit UntMonitorThread;

interface

uses
IdTCPClient, Classes, windows,Graphics,ZLibEx,IdGlobal;

const
DEF_STEP = 19;
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;

TStripMonitorThread = class(TThread)
private
    FScrStream: TMemoryStream;
    FSendStream: TMemoryStream;
    FFullBmp, FLineBmp, FRectBmp: TBitmap;
    FWidth, FHeight, FLine: Integer;
    FRect: TRect;
    FDC: HDC;
    FSocket: TIdTCPClient;
    FCmd: TCapCmd;
    FPixelFormat: TPixelFormat;
    FIncSize: Byte;
    first:boolean;
    //
    function CheckScr: Boolean;
    function GetFirst: Boolean;
    function GetNext: Boolean;
    function Compress: Boolean;
    function SendInfo: Boolean;
    function SendData: Boolean;
    procedure CopyRect(rt: TRect);
    procedure SetPixelFormat(Value: TPixelFormat);

protected
    procedure Execute; override;
public
    constructor Create;
    destructor Destroy; override;
    property Socket: TIdTCPClient read FSocket;
    property PixelFormat: TPixelFormat read FPixelFormat write SetPixelFormat;
end;

implementation

uses Unit1,DisposalCmdUnit;

constructor TstripMonitorThread.Create;
begin
inherited Create(true);

FSocket:=TIdTCPClient.Create(nil);
//Fsocket.IOHandler.RecvBufferSize:= 4096;
// Fsocket.IOHandler.SendBufferSize:= 4096;
//Fsocket.ReadTimeout:=15000;
FScrStream   := TMemoryStream.Create;
FSendStream := TMemoryStream.Create;
FFullBmp := TBitmap.Create;
FLineBmp := TBitmap.Create;
FRectBmp := TBitmap.Create;
FWidth   := 0;
FHeight := 0;
FIncSize := 4;
//case ThisPicPixFmt of //转换的像素颜色位 1 2 4 8 16 24 32
FPixelFormat := pf8bit;
   // 5: FPixelFormat := pf32bit;
// else
   // FPixelFormat := pf32bit;
// end;
FreeOnTerminate := True; //主动释放，不是自动释放
Suspended := False; //立即执行
ScreenOver:=True;
end;

destructor TStripMonitorThread.Destroy;
begin
FSocket.Free;
ScreenOver:=false;
FScrStream.Free;
FSendStream.Free;
FRectBmp.Free;
FFullBmp.Free;
FLineBmp.Free;
inherited destroy;
end;

procedure TStripMonitorThread.Execute;
var
CmdBuf: array[0..SizeOf(TCtlCmd) - 1] of Byte;
pt: TPoint;
Request:string;
buf:TidBytes;
begin
   if form1.ConRpcport(FSocket) then
   begin
     try
       FSocket.IOHandler.Write('002'+EOL);
     except
       FSocket.Free;
       Exit;
     end;
     Request:=FSocket.IOHandler.ReadLn(EOL);
   end;
   if CheckScr then First :=true;
   try
     repeat
      FSocket.IOHandler.ReadBytes(buf, SizeOf(TCtlCmd));
      BytesToRaw(buf,CmdBuf,sizeof(TCtlCmd));
      if TCtlCmd(CmdBuf).Cmd in [1..5] then
      begin
        pt := Point(TCtlCmd(CmdBuf).X, TCtlCmd(CmdBuf).Y);
        SetCursorPos(pt.X, pt.Y);
        SetCapture(WindowFromPoint(pt));
      end;
      case TCtlCmd(CmdBuf).Cmd of
        8: if First then GetFirst else GetNext;
        0: PixelFormat := TPixelFormat(TCtlCmd(CmdBuf).X);
        1: ;//mouse move
        2: mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
        3: mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
        4: mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0);
        5: mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0);
        6: keybd_event(Byte(TCtlCmd(CmdBuf).X), MapVirtualKey(Byte(TCtlCmd(CmdBuf).X), 0), 0, 0);
        7: keybd_event(Byte(TCtlCmd(CmdBuf).X), MapVirtualKey(Byte(TCtlCmd(CmdBuf).X), 0), KEYEVENTF_KEYUP, 0);
      end;
     until FSocket.Connected=False;
   except
   end;
   FSocket.Disconnect;
end;

function TStripMonitorThread.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.Canvas.Lock;
    FLineBmp.Canvas.Lock;
    FRectBmp.Canvas.Lock;
    FFullBmp.Width := FWidth;