100 分求远程屏幕监控好点的算法思想和源码(100分)

一个开源的代码可供学习，将屏幕分为n x m块，对比屏幕每个块的变化，从而节省发送时间。VNC是用hook来检测变化的区域，你也可以用Api hook来监测绘图的API来实现检测变化的区域，我见过有改写的VNC代码，加上SSE指令来快速的处理指令，速度还是可以的。jingtao总喜欢炫耀，就那么点东西吧，还遮遮掩掩的，弄跟骨头来调戏这么多人，素质啊，真够成问题的[]。

unit ScreenSpy;

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('Yalongsoft', [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, BMPBlockSize);
FillChar(LastScreen^, 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.BlockIndex:= i;
ScreenBitmaps.Bound:= Rect(0,0,BlockWidth,BlockHeight);
OffsetRect(ScreenBitmaps.Bound, (i mod FBlockColumnCount) * FBlockWidth, (i div FBlockColumnCount) * FBlockHeight);
{ScreenBitmaps.Bound:= Rect((i mod BlockWidth) * BMPBlockWidth, (i div BlockWidth) * BMPBlockHeight,
(i mod BlockWidth) * BMPBlockWidth + BMPBlockWidth, (i div BlockWidth) * BMPBlockHeight + BMPBlockHeight);{}
ScreenBitmaps.BMP:= TBitmap.Create;
With ScreenBitmaps.BMP do
Begin
Width:= BlockWidth;
Height:= BlockHeight;
PixelFormat:= FPixelFormat;
If Cardinal(ScanLine[0])<Cardinal(ScanLine[1]) then
ScreenBitmaps.ptr:= ScanLine[0]
Else
ScreenBitmaps.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);
MemoryAllowcated:= False;
// Do release
ReleaseDC(0, FScreenCanvas.Handle);
For i:=0 to BlockCount-1 do
FreeMem(LastScreen);
SetLength(LastScreen, 0);
For i:=0 to BlockCount-1 do
Begin
ScreenBitmaps.ptr:= nil;
ScreenBitmaps.BMP.Free;
End;
SetLength(ScreenBitmaps, 0);
End;
end;

procedure TScreenSpy.SetActive(const Value: Boolean);
begin
If FActive<>Value then
Begin
FActive:= Value;
If Not (csDesigning in ComponentState) then
Begin
If Value then
Begin
If Not MemoryAllowcated then
CalculateScreenData;
{// Init for new Frame
FFrameCount:= 0;
HasBitmapEvent:= False;{}
SCThread:= TScreenSpyThread.Create;
With SCThread do
Begin
ScreenSpy:= Self;
Priority:= FThreadPriority;
FreeOnTerminate:= True;
Resume;
End;{}
End Else
Begin
SCThread.Terminate;
SCThread.WaitFor;
//FSCThread:= nil;{}
End;
End;
End;
end;

procedure TScreenSpy.SetIFrame(const Value: Cardinal);
begin
If FIFrame<>Value then
Begin
if not (csLoading in ComponentState) and not (csDesigning in ComponentState) and
FActive then
Raise EScrSpy.CreateRes(@ESSACTIVED);
If Value = 0 then
Raise EScrSpy.CreateRes(@ESSINVALIDVALUE);
FIFrame:= Value;
End;
end;

procedure TScreenSpy.SetMaxBlockSize(const Value: Integer);
begin
If FMaxBlockSize<>Value then
Begin
if not (csLoading in ComponentState) and not (csDesigning in ComponentState) and
FActive then
Raise EScrSpy.CreateRes(@ESSACTIVED);

FMaxBlockSize:= Value;

if not (csLoading in ComponentState) and not (csDesigning in ComponentState) then
CalculateScreenData;
End;
end;

procedure TScreenSpy.SetMaxFrameRate(const Value: Byte);
begin
If FMaxFrameRate<>Value then
Begin
if not (csLoading in ComponentState) and not (csDesigning in ComponentState) and
FActive then
Raise EScrSpy.CreateRes(@ESSACTIVED);
If Value = 0 then
Raise EScrSpy.CreateRes(@ESSINVALIDVALUE);
FMaxFrameRate:= Value;
MaxDelayMilliseconds:= 1000 div FMaxFrameRate;
End;
end;

procedure TScreenSpy.SetThreadPriority(const Value: TThreadPriority);
begin
If FThreadPriority<>Value then
Begin
if not (csLoading in ComponentState) and not (csDesigning in ComponentState) and
FActive then
Raise EScrSpy.CreateRes(@ESSACTIVED);
FThreadPriority := Value;
End;
end;

{ TScreenSpyThread }

procedure TScreenSpyThread.CaptureScreen;
Var
i: Integer;
Begin
TCWhenCapture:= GetTickCount;
With FScreenSpy do
Begin
FFrameCount:= FFrameCount + 1;
For i:=0 to BlockCount-1 do
With ScreenBitmaps do
If BMP.Canvas.TryLock then
try
BMP.Canvas.CopyRect(BlockBound, ScreenCanvas, Bound);
finally
BMP.Canvas.Unlock;
end;
End;
end;

constructor TScreenSpyThread.Create;
begin
Inherited Create(True);
end;

destructor TScreenSpyThread.Destroy;
begin
inherited;
end;

procedure TScreenSpyThread.Execute;
Var
// BlockSame: Boolean;
TickCountLag: Integer;
begin
With FScreenSpy do
Begin
SBIndex:= 0;
IsIFrame:= True; // For Hide Complie message
FFrameCount:= 0;
// Init TickCounts
TCWhenCapture:= 0;
While FScreenSpy.Active and Not Terminated do
Begin
If SBIndex=0 then
Begin
IsIFrame:= (FFrameCount mod FIFrame)=0;
// Delay for MaxFrameRate!
TickCountLag:= MaxDelayMilliseconds- (GetTickCount-TCWhenCapture);
If TickCountLag>0 then
Sleep(TickCountLag);
Synchronize(CaptureScreen);
Synchronize(FrameStart);
End;

If IsIFrame or Not CompareMem(ScreenBitmaps[SBIndex].ptr, LastScreen[SBIndex], BMPBlockSize) then
{If IsIFrame then
BlockSame:= False
Else
BlockSame:= CompareMem(ScreenBitmaps[SBIndex].ptr, LastScreen[SBIndex], BMPBlockSize);
If Not BlockSame then{}
Begin
Synchronize(ScreenBitmap);
Move(ScreenBitmaps[SBIndex].ptr^, LastScreen[SBIndex]^, BMPBlockSize);
End;

SBIndex:= (SBIndex + 1) mod BlockCount;
If (SBIndex=0) then
Synchronize(FrameEnd);
End;
End;
end;

procedure TScreenSpyThread.FrameEnd;
begin
FScreenSpy.DoFrameEnd(IsIFrame);
end;

procedure TScreenSpyThread.FrameStart;
begin
FScreenSpy.HasBitmapEvent:= False;
FScreenSpy.DoFrameStart(IsIFrame);
end;

procedure TScreenSpyThread.ScreenBitmap;
begin
FScreenSpy.DoScreenBitmap(SBIndex, IsIFrame);
FScreenSpy.HasBitmapEvent:= True;
end;

{ TRLE }

Type
LongType = record
case Word of
0: (Ptr: Pointer);
1: (Long: LongInt);
2: (Lo: Word;
Hi: Word);
end;

constructor TSFastRLE.Create;
begin
inherited;
GetMem(s, $FFFF);
GetMem(t, $FFFF);
end;

destructor TSFastRLE.Destroy;
begin
FreeMem(t);
FreeMem(s);
inherited;
end;

function TSFastRLE.PackSeg(Source, Target: Pointer; SourceSize: Word): Word;
begin
asm
push esi
push edi
push eax
push ebx
push ecx
push edx

cld
xor ecx, ecx
mov cx, SourceSize
mov edi, Target

mov esi, Source
add esi, ecx
dec esi
lodsb
inc eax
mov [esi], al

mov ebx, edi
add ebx, ecx
inc ebx
mov esi, Source
add ecx, esi
add edi, 2
@CyclePack:
cmp ecx, esi
je @Konec
lodsw
stosb
dec esi
cmp al, ah
jne @CyclePack
cmp ax, [esi+1]
jne @CyclePack
cmp al, [esi+3]
jne @CyclePack
sub ebx, 2
push edi
sub edi, Target
mov [ebx], di
pop edi
mov edx, esi
add esi, 3
@Nimnul:
inc esi
cmp al, [esi]
je @Nimnul
mov eax, esi
sub eax, edx
or ah, ah
jz @M256
mov byte ptr [edi], 0
inc edi
stosw
jmp @CyclePack
@M256:
stosb
jmp @CyclePack
@Konec:
push ebx
mov ebx, Target
mov eax, edi
sub eax, ebx
mov [ebx], ax
pop ebx
inc ecx
cmp ebx, ecx
je @Lock1
mov esi, ebx
sub ebx, Target
sub ecx, Source
sub ecx, ebx
rep movsb
@Lock1:
sub edi, Target
mov Result, di

pop edx
pop ecx
pop ebx
pop eax
pop edi
pop esi
end;
end;

function TSFastRLE.UnPackSeg(Source, Target: Pointer; SourceSize: Word): Word;
begin
asm
push esi
push edi
push eax
push ebx
push ecx
push edx
cld
mov esi, Source
mov edi, Target
mov ebx, esi
xor edx, edx
mov dx, SourceSize
add ebx, edx
mov dx, word ptr [esi]
add edx, esi
add esi, 2
@UnPackCycle:
cmp edx, ebx
je @Konec2
sub ebx, 2
xor ecx, ecx
mov cx, word ptr [ebx]
add ecx, Source
sub ecx, esi
dec ecx
rep movsb
lodsb
mov cl, byte ptr [esi]
inc esi
or cl, cl
jnz @Low1
xor ecx, ecx
mov cx, word ptr [esi]
add esi, 2
@Low1:
inc ecx
rep stosb
jmp @UnPackCycle
@Konec2:
mov ecx, edx
sub ecx, esi
rep movsb
sub edi, Target
mov Result, di

pop edx
pop ecx
pop ebx
pop eax
pop edi
pop esi
end;
end;

function TSFastRLE.Pack(Source, Target: Pointer; SourceSize: Integer): LongInt;
var
w, tmp: Word;
Sourc, Targ: LongType;
begin
{ // Move
Move(Source^, Target^, SourceSize);
Result:= SourceSize;
Exit;{}

// RLE Compress
Sourc.Ptr := Source;
Targ.Ptr := Target;
Result := 0;
while SourceSize <> 0 do
begin
if SourceSize > $FFFA then tmp := $FFFA
else tmp := SourceSize;
dec(SourceSize, tmp);
move(Sourc.Ptr^, s^, tmp);
w := PackSeg(s, t, tmp);
inc(Sourc.Long, tmp);
Move(w, Targ.Ptr^, 2);
inc(Targ.Long, 2);
Move(t^, Targ.Ptr^, w);
inc(Targ.Long, w);
Result := Result + w + 2;
end;
end;

function TSFastRLE.PackFile(SourceFileName, TargetFileName: String): Boolean;
var
Source, Target: Pointer;
SourceFile, TargetFile: File;
RequiredMaxSize, TargetFSize, FSize: LongInt;
begin
AssignFile(SourceFile, SourceFileName);
Reset(SourceFile, 1);
FSize := FileSize(SourceFile);

RequiredMaxSize := FSize + (FSize div $FFFF + 1) * 2;
GetMem(Source, RequiredMaxSize);
GetMem(Target, RequiredMaxSize);

BlockRead(SourceFile, Source^, FSize);
CloseFile(SourceFile);

TargetFSize := Pack(Source, Target, FSize);

AssignFile(TargetFile, TargetFileName);
Rewrite(TargetFile, 1);
{ Also, you may put header }
BlockWrite(TargetFile, FSize, SizeOf(FSize)); { Original file size (Only from 3.0) }
BlockWrite(TargetFile, Target^, TargetFSize);
CloseFile(TargetFile);

FreeMem(Target, RequiredMaxSize);
FreeMem(Source, RequiredMaxSize);

Result := IOResult = 0;
end;

function TSFastRLE.PackString(Source: String): String;
var
PC, PC2: PChar;
SS, TS: Integer;
begin
SS := Length(Source);
GetMem(PC, SS);
GetMem(PC2, SS + 8); // If line can't be packed its size can be longer
Move(Source[1], PC^, SS);
TS := Pack(PC, PC2, SS);
SetLength(Result, TS + 4);
Move(SS, Result[1], 4);
Move(PC2^, Result[5], TS);
FreeMem(PC2);
FreeMem(PC);
end;

function TSFastRLE.UnPack(Source, Target: Pointer;
SourceSize: Integer): LongInt;
var
Increment, i: LongInt;
tmp: Word;
Swap: LongType;
begin
{ // Move
Move(Source^, Target^, SourceSize);
Result:= SourceSize;
Exit;{}

// RLE Decompress
Increment := 0;
Result := 0;
while SourceSize <> 0 do
begin
Swap.Ptr := Source;
inc(Swap.Long, Increment);
Move(Swap.Ptr^, tmp, 2);
inc(Swap.Long, 2);
dec(SourceSize, tmp + 2);
i := UnPackSeg(Swap.Ptr, t, tmp);
Swap.Ptr := Target;
inc(Swap.Long, Result);
inc(Result, i);
Move(t^, Swap.Ptr^, i);
inc(Increment, tmp + 2);
end;
end;

function TSFastRLE.UnPackFile(SourceFileName, TargetFileName: String): Boolean;
var
Source, Target: Pointer;
SourceFile, TargetFile: File;
OriginalFileSize, FSize: LongInt;
begin
AssignFile(SourceFile, SourceFileName);
Reset(SourceFile, 1);
FSize := FileSize(SourceFile) - SizeOf(OriginalFileSize);

{ Read header ? }
BlockRead(SourceFile, OriginalFileSize, SizeOf(OriginalFileSize));

GetMem(Source, FSize);
GetMem(Target, OriginalFileSize);

BlockRead(SourceFile, Source^, FSize);
CloseFile(SourceFile);

UnPack(Source, Target, FSize);

AssignFile(TargetFile, TargetFileName);
Rewrite(TargetFile, 1);
BlockWrite(TargetFile, Target^, OriginalFileSize);
CloseFile(TargetFile);

FreeMem(Target, OriginalFileSize);
FreeMem(Source, FSize);

Result := IOResult = 0;
end;

function TSFastRLE.UnPackString(Source: String): String;
var
PC, PC2: PChar;
SS, TS: Integer;
begin
SS := Length(Source) - 4;
GetMem(PC, SS);
Move(Source[1], TS, 4);
GetMem(PC2, TS);
Move(Source[5], PC^, SS);
TS := UnPack(PC, PC2, SS);
SetLength(Result, TS);
Move(PC2^, Result[1], TS);
FreeMem(PC2);
FreeMem(PC);
end;

{ TScreenEncoder }
constructor TScreenEncoder.Create(AOwner: TComponent);
begin
inherited;
// default properties value
FActive:= False;
FBlockInterval:= 1;
FBlockDelay:= 1;
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:= XorDataPtr;
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:= 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:= 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.BlockIndex:= i;
ScreenBitmaps.Bound:= Rect(0,0,BlockWidth,BlockHeight);
OffsetRect(ScreenBitmaps.Bound, (i mod FBlockColumnCount) * FBlockWidth, (i div FBlockColumnCount) * FBlockHeight);
{ScreenBitmaps.Bound:= Rect((i mod BlockWidth) * BMPBlockWidth, (i div BlockWidth) * BMPBlockHeight,
(i mod BlockWidth) * BMPBlockWidth + BMPBlockWidth, (i div BlockWidth) * BMPBlockHeight + BMPBlockHeight);{}
ScreenBitmaps.BMP:= TBitmap.Create;
With ScreenBitmaps.BMP do
Begin
Width:= BlockWidth;
Height:= BlockHeight;
PixelFormat:= FPixelFormat;
If Cardinal(ScanLine[0])<Cardinal(ScanLine[1]) then
ScreenBitmaps.ptr:= ScanLine[0]
Else
ScreenBitmaps.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:= nil;
FreeMem(XorDataPtr[1]);
For i:=0 to BlockCount-1 do
Begin
ScreenBitmaps.ptr:= nil;
ScreenBitmaps.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:= XorDataPtr;

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.

其它两个用到的模块。

unit BufferUDP;

interface

uses
Windows, SysUtils, Classes, WinSock, syncobjs;

type // Main class
TUDPDataEvent = procedure(Sender: TObject; const Buffer: Pointer; const RecvSize:Integer; const Peer: string; const Port: Integer) of object;
TUDPSender = class(TComponent)
private
{ Private declarations }
FHandle: TSocket;
FActive: Boolean;
FRemoteIP: String;
FRemoteHost: String;
FRemotePort: Word;
CS: TCriticalSection;
Procedure SetActive(const Value: Boolean);
Procedure SetRemoteIP(const Value: String);
Procedure SetRemoteHost(const Value: String);
Procedure SetRemotePort(const Value: Word);
protected
{ Protected declarations }
public
{ Public declarations }
Class function ResolveHost(const psHost: string; var psIP: string): u_long; virtual;
Class function ResolveIP(const psIP: string): string; virtual;
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
Procedure Connect;
Procedure Disconnect;
Function SendBuf(var Buffer; BufSize: Integer): Integer;
property Handle: TSocket read FHandle;
published
{ Published declarations }
property Active: Boolean read FActive write SetActive default False;
property RemoteIP: String read FRemoteIP write SetRemoteIP;
property RemoteHost: String read FRemoteHost write SetRemoteHost;
property RemotePort: Word read FRemotePort write SetRemotePort;
end;

TUDPReceiver = class;

TUDPReceiverThread = class(TThread)
protected
FReceiver: TUDPReceiver;
FBuffer: Pointer;
FRecvSize: Integer;
FPeer: string;
FPort: Integer;
FBufSize: Integer;
procedure SetBufSize(const Value: Integer);
public
procedure Execute; override;
procedure UDPRead;
published
Property BufSize: Integer read FBufSize write SetBufSize;
Property Receiver: TUDPReceiver read FReceiver write FReceiver;
end;

TUDPReceiver = class(TComponent)
private
{ Private declarations }
FHandle: TSocket;
FActive: Boolean;
FPort: Word;
FBufferSize: Integer;
FMulticastIP : String;
// FUDPBuffer: Pointer;
FOnUDPData: TUDPDataEvent;
FUDPReceiverThread: TUDPReceiverThread;
Procedure SetActive(const Value: Boolean);
Procedure SetPort(const Value: Word);
Procedure SetBufferSize(const Value: Integer);
procedure SetMulticastIP(const Value: String);
protected
{ Protected declarations }
public
{ Public declarations }
Class Function BindMulticast(const Socket: TSocket; const IP:String): LongInt; virtual;
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
Procedure Connect;
Procedure Disconnect;
procedure DoUDPRead(const Buffer: Pointer; const RecvSize:Integer; const Peer: string; const Port: Integer); virtual;
property Handle: TSocket read FHandle;
published
{ Published declarations }
property Active: Boolean read FActive write SetActive default False;
property Port: Word read FPort write SetPort;
property BufferSize: Integer read FBufferSize write SetBufferSize default 65000;
property OnUDPData: TUDPDataEvent read FOnUDPData write FOnUDPData;
property MulticastIP: String read FMulticastIP write SetMulticastIP;
end;

type // exception
EBufferUDP = Exception;

resourcestring
EUDPNOTACTIVE = 'UDP Socket not connected';
EUDPACTIVED = 'UDP Socket already connected';
EWSAError = 'Socket Error : %d';
EUNABLERESOLVEHOST = 'Unable to resolve host: %s';
EUNABLERESOLVEIP = 'Unable to resolve IP: %s';
EZEROBYTESEND = '0 bytes were sent.';
EPACKAGETOOBIG = 'Package Size Too Big: %d';
ENOREMOTESIDE = 'Remote Host/IP not identified!';
ESIZEOUTOFBOUNDARY = 'Size value is out of boundary!';
EWSAENOBUFS = 'An operation on a socket could not be performed because the system lacked sufficient buffer space or because a queue was full.';
EWSANOTINITIALISED = 'A successful WSAStartup must occur before using this function.';
EWSAENETDOWN = 'The network subsystem has failed.';
EWSAEFAULT = 'optval is not in a valid part of the process address space or optlen argument is too small.';
EWSAEINPROGRESS = 'A blocking Windows Sockets 1.1 call is in progress, or the service provider is still processing a callback function.';
EWSAEINVAL = 'level is not valid, or the information in optval is not valid.';
EWSAENETRESET = 'Connection has timed out when SO_KEEPALIVE is set.';
EWSAENOPROTOOPT = 'The option is unknown or unsupported for the specified provider.';
EWSAENOTCONN = 'Connection has been reset when SO_KEEPALIVE is set.';
EWSAENOTSOCK = 'The descriptor is not a socket.';
EWSAUNKNOW = 'Unknow socket error.';
implementation



Type
TIMR = Packed Record
imr_multiaddr: LongInt;
imr_interface: LongInt;
End;

{ TUDPSender }

procedure TUDPSender.Connect;
Var
Faddr: TSockAddrIn;
begin
CS.Enter;
try
If FActive then
Raise EBufferUDP.CreateRes(@EUDPACTIVED);

If ((FRemoteHost='') and (FRemoteIP='')) then
Raise EBufferUDP.CreateRes(@ENOREMOTESIDE);

If Not (csDesigning in ComponentState) then
Begin
FHandle:= WinSock.Socket(PF_INET, SOCK_DGRAM, IPPROTO_IP);
If FHandle = INVALID_SOCKET then
Raise EBufferUDP.CreateResFmt(@EWSAError, [WSAGetLastError]);

with faddr do begin
sin_family := PF_INET;
sin_port := WinSock.htons(FRemotePort);
// sin_addr.s_addr := WinSock.ResolveHost(fsHost, fsPeerAddress);
if length(FRemoteIP) > 0 then begin
sin_addr.s_addr := WinSock.inet_addr(PChar(FRemoteIP));
end;
end;
WinSock.connect(FHandle, faddr, Sizeof(faddr));
End;

FActive:= True;
finally
CS.Leave;
end;
end;

constructor TUDPSender.Create(AOwner: TComponent);
begin
inherited;
CS:= TCriticalSection.Create;
FActive:= False;
FHandle := INVALID_SOCKET;
// FReceiveTimeout := -1;
end;

destructor TUDPSender.Destroy;
begin
Active:= False;
CS.Free;
inherited;
end;

procedure TUDPSender.Disconnect;
Var
OldHandle: TSocket;
begin
CS.Enter;
try
If FActive then
Begin
OldHandle:= FHandle;
FHandle:= INVALID_SOCKET;
CloseSocket(OldHandle);
End;
finally
FActive:= False;
CS.Leave;
end;
end;

class function TUDPSender.ResolveHost(const psHost: string;
var psIP: string): u_long;
Var
pa: PChar;
sa: TInAddr;
aHost: PHostEnt;
begin
psIP := psHost;
// Sometimes 95 forgets who localhost is
if CompareText(psHost, 'LOCALHOST') = 0 then
begin
sa.S_un_b.s_b1 := #127;
sa.S_un_b.s_b2 := #0;
sa.S_un_b.s_b3 := #0;
sa.S_un_b.s_b4 := #1;
psIP := '127.0.0.1';
Result := sa.s_addr;
end else begin
// Done if is tranlated (ie There were numbers}
Result := inet_addr(PChar(psHost));
// If no translation, see if it resolves}
if Result = u_long(INADDR_NONE) then begin
aHost := Winsock.GetHostByName(PChar(psHost));
if aHost = nil then
begin
Result:= 0;
psIP:= '';
Exit;
//Raise EBufferUDP.CreateResFmt(@EUNABLERESOLVEHOST, [psHost]);
end else
begin
pa := aHost^.h_addr_list^;
sa.S_un_b.s_b1 := pa[0];
sa.S_un_b.s_b2 := pa[1];
sa.S_un_b.s_b3 := pa[2];
sa.S_un_b.s_b4 := pa[3];
psIP:= String(inet_ntoa(sa));
//psIP := TInAddrToString(sa);
end;
Result := sa.s_addr;
end;
end;
end;

class function TUDPSender.ResolveIP(const psIP: string): string;
var
i: Integer;
P: PHostEnt;
begin
result := '';
if CompareText(psIP, '127.0.0.1') = 0 then
begin
result := 'LOCALHOST';
end else
begin
i := Winsock.inet_addr(PChar(psIP));
P := Winsock.GetHostByAddr(@i, 4, PF_INET);
If P = nil then
Begin
Result:= '';
Exit;
// Raise EBufferUDP.CreateResFmt(@EUNABLERESOLVEIP, [psIP]);
//CheckForSocketError2(SOCKET_ERROR, [WSANO_DATA]);
End else
Begin
result := P.h_name;
End;
end;
end;

Function TUDPSender.SendBuf(var Buffer; BufSize: Integer): Integer;
begin
CS.Enter;
try
Result:= 0;
If BufSize<=0 then
Exit;
If Not FActive then
Raise EBufferUDP.CreateRes(@EUDPNOTACTIVE);

Result:= Winsock.send(FHandle, Buffer, BufSize, 0);
If Result<>BufSize then
Begin
Case Result of
0:
Raise EBufferUDP.CreateRes(@EZEROBYTESEND);
SOCKET_ERROR:
If WSAGetLastError = WSAEMSGSIZE then
Raise EBufferUDP.CreateResFmt(@EPACKAGETOOBIG, [BufSize])
End;{CASE}
End;
finally
CS.Leave;
end;
end;

procedure TUDPSender.SetActive(const Value: Boolean);
begin
If FActive<>Value then
Begin
If Value then
Connect
Else
Disconnect;
End;
end;

procedure TUDPSender.SetRemoteHost(const Value: String);
Var
IsConnected: Boolean;
begin
If FRemoteHost<>Value then
Begin
IsConnected:= Active;
Active:= False;
FRemoteHost:= Value;
If Not (csDesigning in ComponentState) then
ResolveHost(FRemoteHost, FRemoteIP);
// Resovle IP
Active:= IsConnected;
End;
end;

procedure TUDPSender.SetRemoteIP(const Value: String);
Var
IsConnected: Boolean;
begin
If FRemoteIP<>Value then
Begin
IsConnected:= Active;
Active:= False;
FRemoteIP:= Value;
// Resovle Host name
If Not (csDesigning in ComponentState) then
FRemoteHost:= ResolveIP(FRemoteIP);
Active:= IsConnected;
End;
end;

procedure TUDPSender.SetRemotePort(const Value: Word);
Var
IsConnected: Boolean;
begin
If FRemotePort<>Value then
Begin
IsConnected:= Active;
Active:= False;
FRemotePort:= Value;
Active:= IsConnected;
End;
end;

{ TUDPReceiver }

class function TUDPReceiver.BindMulticast(const Socket: TSocket;
const IP: String): LongInt;
Var
lpMulti: TIMR;
Begin
lpMulti.imr_multiaddr := inet_addr(PChar(IP));
lpMulti.imr_interface := 0;
Result:= SetSockOpt(Socket, IPPROTO_IP, IP_ADD_MEMBERSHIP, @lpMulti, Sizeof(lpMulti));
End;

procedure TUDPReceiver.Connect;
var
m_addr: TSockAddrIn;
begin
If FActive then
Raise EBufferUDP.CreateRes(@EUDPACTIVED);

If csDesigning in ComponentState then
Begin
FActive:= True;
Exit;
End;

// SOCKET
FHandle := Winsock.Socket(PF_INET, SOCK_DGRAM, IPPROTO_IP);
If FHandle = INVALID_SOCKET then
Raise EBufferUDP.CreateResFmt(@EWSAError, [WSAGetLastError]);

// BIND
With m_addr do begin
sin_family := PF_INET;
sin_port := Winsock.htons(FPort);
sin_addr.s_addr := INADDR_ANY;
End;
If WinSock.bind(FHandle, m_addr, Sizeof(m_addr))=SOCKET_ERROR then
Raise EBufferUDP.CreateResFmt(@EWSAError, [WSAGetLastError]);

// Bind Multicast
If FMulticastIP<>'' then
If BindMulticast(FHandle, FMulticastIP)=SOCKET_ERROR then
Case WSAGetLastError of
WSAENOBUFS: Raise EBufferUDP.CreateRes(@EWSAENOBUFS );
WSANOTINITIALISED: Raise EBufferUDP.CreateRes(@EWSANOTINITIALISED);
WSAENETDOWN: Raise EBufferUDP.CreateRes(@EWSAENETDOWN );
WSAEFAULT: Raise EBufferUDP.CreateRes(@EWSAEFAULT );
WSAEINPROGRESS: Raise EBufferUDP.CreateRes(@EWSAEINPROGRESS );
WSAEINVAL: Raise EBufferUDP.CreateRes(@EWSAEINVAL );
WSAENETRESET: Raise EBufferUDP.CreateRes(@EWSAENETRESET );
WSAENOPROTOOPT: Raise EBufferUDP.CreateRes(@EWSAENOPROTOOPT );
WSAENOTCONN: Raise EBufferUDP.CreateRes(@EWSAENOTCONN );
WSAENOTSOCK: Raise EBufferUDP.CreateRes(@EWSAENOTSOCK );
Else
Raise EBufferUDP.CreateRes(@EWSAUNKNOW);
End; {CASE}

// Thread read
FUDPReceiverThread := TUDPReceiverThread.Create(True);
With FUDPReceiverThread do
Begin
Receiver:= Self;
BufSize:= FBufferSize;
FreeOnTerminate := True;
Resume;
End;

FActive:= True;
end;

constructor TUDPReceiver.Create(AOwner: TComponent);
begin
inherited;
FHandle := INVALID_SOCKET;
FActive:= False;
FBufferSize:= 65000;
FMulticastIP:= '';
end;

destructor TUDPReceiver.Destroy;
begin
Active:= False;
inherited;
end;

procedure TUDPReceiver.Disconnect;
Var
OldHandle: TSocket;
begin
If Not FActive then
Exit;

try
OldHandle:= FHandle;
FHandle:= INVALID_SOCKET;
CloseSocket(OldHandle);
finally
FActive:= False;
end;

If FUDPReceiverThread <> nil then
Begin
FUDPReceiverThread.Terminate;
FUDPReceiverThread.WaitFor;
End;
end;

procedure TUDPReceiver.DoUDPRead(const Buffer: Pointer; const RecvSize:Integer;
const Peer: string; const Port: Integer);
begin
If Assigned(FOnUDPData) then begin
FOnUDPData(Self, Buffer, RecvSize, Peer, Port);
End;
end;

procedure TUDPReceiver.SetActive(const Value: Boolean);
begin
If FActive<>Value then
Begin
If Value then
Connect
Else
Disconnect;
End;
end;

procedure TUDPReceiver.SetBufferSize(const Value: Integer);
begin
If FBufferSize<>Value then
Begin
If ((Value>=1024) and (Value<=65000)) then
FBufferSize:= Value
Else
Raise EBufferUDP.CreateRes(@ESIZEOUTOFBOUNDARY);
End;
end;

procedure TUDPReceiver.SetMulticastIP(const Value: String);
Var
IsConnected: Boolean;
begin
If Value<>FMulticastIP then
Begin
IsConnected:= Active;
Active:= False;
FMulticastIP:= Value;
Active:= IsConnected;
End;
end;

procedure TUDPReceiver.SetPort(const Value: Word);
Var
IsConnected: Boolean;
begin
If FPort<>Value then
Begin
IsConnected:= Active;
Active:= False;
FPort:= Value;
Active:= IsConnected;
End;
end;

{ TUDPReceiverThread }

procedure TUDPReceiverThread.Execute;
var
i: Integer;
addr_remote: TSockAddrin;
arSize: Integer;
begin
GetMem(FBuffer, FBufSize);
arSize:= SizeOf(addr_remote);
while FReceiver.Active and not Terminated do
Begin
i := arSize;
FRecvSize := Winsock.RecvFrom(FReceiver.Handle, FBuffer^, FBufSize, 0, addr_remote, i);
If FReceiver.Active and (FRecvSize>0) then
Begin
//fsData := Copy(fListener.fsUDPBuffer, 1, iByteCount);
FPeer := String(inet_ntoa(addr_remote.sin_addr));
//FPeer := String(TWinshoe.TInAddrToString(addr_remote.sin_addr));
FPort := Winsock.NToHS(addr_remote.sin_port);
Synchronize(UDPRead);
End;
End;
FreeMem(FBuffer);
end;

procedure TUDPReceiverThread.SetBufSize(const Value: Integer);
begin
If FBufSize<> Value then
FBufSize:= Value;
end;

procedure TUDPReceiverThread.UDPRead;
begin
FReceiver.DoUDPRead(FBuffer, FRecvSize, FPeer, FPort);
end;

Var
GWSADATA: TWSADATA;
initialization
WSAStartup(MakeWord(2, 0), GWSADATA);
finalization
WSACleanup;
end.

unit MyScrCap;

interface

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

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;


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


{ 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, BMPBlockSize);
FillChar(LastScreen^, 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.BlockIndex:= i;
ScreenBitmaps.Bound:= Rect(0,0,BlockWidth,BlockHeight);
OffsetRect(ScreenBitmaps.Bound, (i mod FBlockColumnCount) * FBlockWidth, (i div FBlockColumnCount) * FBlockHeight);
{ScreenBitmaps.Bound:= Rect((i mod BlockWidth) * BMPBlockWidth, (i div BlockWidth) * BMPBlockHeight,
(i mod BlockWidth) * BMPBlockWidth + BMPBlockWidth, (i div BlockWidth) * BMPBlockHeight + BMPBlockHeight);{}
ScreenBitmaps.BMP:= TBitmap.Create;
With ScreenBitmaps.BMP do
Begin
Width:= BlockWidth;
Height:= BlockHeight;
PixelFormat:= FPixelFormat;
If Cardinal(ScanLine[0])<Cardinal(ScanLine[1]) then
ScreenBitmaps.ptr:= ScanLine[0]
Else
ScreenBitmaps.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);
MemoryAllowcated:= False;
// Do release
ReleaseDC(0, FScreenCanvas.Handle);
For i:=0 to BlockCount-1 do
FreeMem(LastScreen);
SetLength(LastScreen, 0);
For i:=0 to BlockCount-1 do
Begin
ScreenBitmaps.ptr:= nil;
ScreenBitmaps.BMP.Free;
End;
SetLength(ScreenBitmaps, 0);
End;
end;

procedure TScreenSpy.SetActive(const Value: Boolean);
begin
If FActive<>Value then
Begin
FActive:= Value;
If Not (csDesigning in ComponentState) then
Begin
If Value then
Begin
If Not MemoryAllowcated then
CalculateScreenData;
{// Init for new Frame
FFrameCount:= 0;
HasBitmapEvent:= False;{}
SCThread:= TScreenSpyThread.Create;
With SCThread do
Begin
ScreenSpy:= Self;
Priority:= FThreadPriority;
FreeOnTerminate:= True;
Resume;
End;{}
End Else
Begin
SCThread.Terminate;
SCThread.WaitFor;
//FSCThread:= nil;{}
End;
End;
End;
end;

procedure TScreenSpy.SetIFrame(const Value: Cardinal);
begin
If FIFrame<>Value then
Begin
if not (csLoading in ComponentState) and not (csDesigning in ComponentState) and
FActive then
Raise EScrSpy.CreateRes(@ESSACTIVED);
If Value = 0 then
Raise EScrSpy.CreateRes(@ESSINVALIDVALUE);
FIFrame:= Value;
End;
end;

procedure TScreenSpy.SetMaxBlockSize(const Value: Integer);
begin
If FMaxBlockSize<>Value then
Begin
if not (csLoading in ComponentState) and not (csDesigning in ComponentState) and
FActive then
Raise EScrSpy.CreateRes(@ESSACTIVED);

FMaxBlockSize:= Value;

if not (csLoading in ComponentState) and not (csDesigning in ComponentState) then
CalculateScreenData;
End;
end;

procedure TScreenSpy.SetMaxFrameRate(const Value: Byte);
begin
If FMaxFrameRate<>Value then
Begin
if not (csLoading in ComponentState) and not (csDesigning in ComponentState) and
FActive then
Raise EScrSpy.CreateRes(@ESSACTIVED);
If Value = 0 then
Raise EScrSpy.CreateRes(@ESSINVALIDVALUE);
FMaxFrameRate:= Value;
MaxDelayMilliseconds:= 1000 div FMaxFrameRate;
End;
end;

procedure TScreenSpy.SetThreadPriority(const Value: TThreadPriority);
begin
If FThreadPriority<>Value then
Begin
if not (csLoading in ComponentState) and not (csDesigning in ComponentState) and
FActive then
Raise EScrSpy.CreateRes(@ESSACTIVED);
FThreadPriority := Value;
End;
end;

{ TScreenSpyThread }

procedure TScreenSpyThread.CaptureScreen;
Var
i: Integer;
Begin
TCWhenCapture:= GetTickCount;
With FScreenSpy do
Begin
FFrameCount:= FFrameCount + 1;
For i:=0 to BlockCount-1 do
With ScreenBitmaps do
If BMP.Canvas.TryLock then
try
BMP.Canvas.CopyRect(BlockBound, ScreenCanvas, Bound);
finally
BMP.Canvas.Unlock;
end;
End;
end;

constructor TScreenSpyThread.Create;
begin
Inherited Create(True);
end;

destructor TScreenSpyThread.Destroy;
begin
inherited;
end;

procedure TScreenSpyThread.Execute;
Var
// BlockSame: Boolean;
TickCountLag: Integer;
begin
With FScreenSpy do
Begin
SBIndex:= 0;
IsIFrame:= True; // For Hide Complie message
FFrameCount:= 0;
// Init TickCounts
TCWhenCapture:= 0;
While FScreenSpy.Active and Not Terminated do
Begin
If SBIndex=0 then
Begin
IsIFrame:= (FFrameCount mod FIFrame)=0;
// Delay for MaxFrameRate!
TickCountLag:= MaxDelayMilliseconds- (GetTickCount-TCWhenCapture);
If TickCountLag>0 then
Sleep(TickCountLag);
Synchronize(CaptureScreen);
Synchronize(FrameStart);
End;

If IsIFrame or Not CompareMem(ScreenBitmaps[SBIndex].ptr, LastScreen[SBIndex], BMPBlockSize) then
{If IsIFrame then
BlockSame:= False
Else
BlockSame:= CompareMem(ScreenBitmaps[SBIndex].ptr, LastScreen[SBIndex], BMPBlockSize);
If Not BlockSame then{}
Begin
Synchronize(ScreenBitmap);
Move(ScreenBitmaps[SBIndex].ptr^, LastScreen[SBIndex]^, BMPBlockSize);
End;

SBIndex:= (SBIndex + 1) mod BlockCount;
If (SBIndex=0) then
Synchronize(FrameEnd);
End;
End;
end;

procedure TScreenSpyThread.FrameEnd;
begin
FScreenSpy.DoFrameEnd(IsIFrame);
end;

procedure TScreenSpyThread.FrameStart;
begin
FScreenSpy.HasBitmapEvent:= False;
FScreenSpy.DoFrameStart(IsIFrame);
end;

procedure TScreenSpyThread.ScreenBitmap;
begin
FScreenSpy.DoScreenBitmap(SBIndex, IsIFrame);
FScreenSpy.HasBitmapEvent:= True;
end;

{ TRLE }

Type
LongType = record
case Word of
0: (Ptr: Pointer);
1: (Long: LongInt);
2: (Lo: Word;
Hi: Word);
end;

constructor TSFastRLE.Create;
begin
inherited;
GetMem(s, $FFFF);
GetMem(t, $FFFF);
end;

destructor TSFastRLE.Destroy;
begin
FreeMem(t);
FreeMem(s);
inherited;
end;

function TSFastRLE.PackSeg(Source, Target: Pointer; SourceSize: Word): Word;
begin
asm
push esi
push edi
push eax
push ebx
push ecx
push edx

cld
xor ecx, ecx
mov cx, SourceSize
mov edi, Target

mov esi, Source
add esi, ecx
dec esi
lodsb
inc eax
mov [esi], al

mov ebx, edi
add ebx, ecx
inc ebx
mov esi, Source
add ecx, esi
add edi, 2
@CyclePack:
cmp ecx, esi
je @Konec
lodsw
stosb
dec esi
cmp al, ah
jne @CyclePack
cmp ax, [esi+1]
jne @CyclePack
cmp al, [esi+3]
jne @CyclePack
sub ebx, 2
push edi
sub edi, Target
mov [ebx], di
pop edi
mov edx, esi
add esi, 3
@Nimnul:
inc esi
cmp al, [esi]
je @Nimnul
mov eax, esi
sub eax, edx
or ah, ah
jz @M256
mov byte ptr [edi], 0
inc edi
stosw
jmp @CyclePack
@M256:
stosb
jmp @CyclePack
@Konec:
push ebx
mov ebx, Target
mov eax, edi
sub eax, ebx
mov [ebx], ax
pop ebx
inc ecx
cmp ebx, ecx
je @Lock1
mov esi, ebx
sub ebx, Target
sub ecx, Source
sub ecx, ebx
rep movsb
@Lock1:
sub edi, Target
mov Result, di

pop edx
pop ecx
pop ebx
pop eax
pop edi
pop esi
end;
end;

function TSFastRLE.UnPackSeg(Source, Target: Pointer; SourceSize: Word): Word;
begin
asm
push esi
push edi
push eax
push ebx
push ecx
push edx
cld
mov esi, Source
mov edi, Target
mov ebx, esi
xor edx, edx
mov dx, SourceSize
add ebx, edx
mov dx, word ptr [esi]
add edx, esi
add esi, 2
@UnPackCycle:
cmp edx, ebx
je @Konec2
sub ebx, 2
xor ecx, ecx
mov cx, word ptr [ebx]
add ecx, Source
sub ecx, esi
dec ecx
rep movsb
lodsb
mov cl, byte ptr [esi]
inc esi
or cl, cl
jnz @Low1
xor ecx, ecx
mov cx, word ptr [esi]
add esi, 2
@Low1:
inc ecx
rep stosb
jmp @UnPackCycle
@Konec2:
mov ecx, edx
sub ecx, esi
rep movsb
sub edi, Target
mov Result, di

pop edx
pop ecx
pop ebx
pop eax
pop edi
pop esi
end;
end;

function TSFastRLE.Pack(Source, Target: Pointer; SourceSize: Integer): LongInt;
var
w, tmp: Word;
Sourc, Targ: LongType;
begin
{ // Move
Move(Source^, Target^, SourceSize);
Result:= SourceSize;
Exit;{}

// RLE Compress
Sourc.Ptr := Source;
Targ.Ptr := Target;
Result := 0;
while SourceSize <> 0 do
begin
if SourceSize > $FFFA then tmp := $FFFA
else tmp := SourceSize;
dec(SourceSize, tmp);
move(Sourc.Ptr^, s^, tmp);
w := PackSeg(s, t, tmp);
inc(Sourc.Long, tmp);
Move(w, Targ.Ptr^, 2);
inc(Targ.Long, 2);
Move(t^, Targ.Ptr^, w);
inc(Targ.Long, w);
Result := Result + w + 2;
end;
end;

function TSFastRLE.PackFile(SourceFileName, TargetFileName: String): Boolean;
var
Source, Target: Pointer;
SourceFile, TargetFile: File;
RequiredMaxSize, TargetFSize, FSize: LongInt;
begin
AssignFile(SourceFile, SourceFileName);
Reset(SourceFile, 1);
FSize := FileSize(SourceFile);

RequiredMaxSize := FSize + (FSize div $FFFF + 1) * 2;
GetMem(Source, RequiredMaxSize);
GetMem(Target, RequiredMaxSize);

BlockRead(SourceFile, Source^, FSize);
CloseFile(SourceFile);

TargetFSize := Pack(Source, Target, FSize);

AssignFile(TargetFile, TargetFileName);
Rewrite(TargetFile, 1);
{ Also, you may put header }
BlockWrite(TargetFile, FSize, SizeOf(FSize)); { Original file size (Only from 3.0) }
BlockWrite(TargetFile, Target^, TargetFSize);
CloseFile(TargetFile);

FreeMem(Target, RequiredMaxSize);
FreeMem(Source, RequiredMaxSize);

Result := IOResult = 0;
end;

function TSFastRLE.PackString(Source: String): String;
var
PC, PC2: PChar;
SS, TS: Integer;
begin
SS := Length(Source);
GetMem(PC, SS);
GetMem(PC2, SS + 8); // If line can't be packed its size can be longer
Move(Source[1], PC^, SS);
TS := Pack(PC, PC2, SS);
SetLength(Result, TS + 4);
Move(SS, Result[1], 4);
Move(PC2^, Result[5], TS);
FreeMem(PC2);
FreeMem(PC);
end;

function TSFastRLE.UnPack(Source, Target: Pointer;
SourceSize: Integer): LongInt;
var
Increment, i: LongInt;
tmp: Word;
Swap: LongType;
begin
{ // Move
Move(Source^, Target^, SourceSize);
Result:= SourceSize;
Exit;{}

// RLE Decompress
Increment := 0;
Result := 0;
while SourceSize <> 0 do
begin
Swap.Ptr := Source;
inc(Swap.Long, Increment);
Move(Swap.Ptr^, tmp, 2);
inc(Swap.Long, 2);
dec(SourceSize, tmp + 2);
i := UnPackSeg(Swap.Ptr, t, tmp);
Swap.Ptr := Target;
inc(Swap.Long, Result);
inc(Result, i);
Move(t^, Swap.Ptr^, i);
inc(Increment, tmp + 2);
end;
end;

function TSFastRLE.UnPackFile(SourceFileName, TargetFileName: String): Boolean;
var
Source, Target: Pointer;
SourceFile, TargetFile: File;
OriginalFileSize, FSize: LongInt;
begin
AssignFile(SourceFile, SourceFileName);
Reset(SourceFile, 1);
FSize := FileSize(SourceFile) - SizeOf(OriginalFileSize);

{ Read header ? }
BlockRead(SourceFile, OriginalFileSize, SizeOf(OriginalFileSize));

GetMem(Source, FSize);
GetMem(Target, OriginalFileSize);

BlockRead(SourceFile, Source^, FSize);
CloseFile(SourceFile);

UnPack(Source, Target, FSize);

AssignFile(TargetFile, TargetFileName);
Rewrite(TargetFile, 1);
BlockWrite(TargetFile, Target^, OriginalFileSize);
CloseFile(TargetFile);

FreeMem(Target, OriginalFileSize);
FreeMem(Source, FSize);

Result := IOResult = 0;
end;

function TSFastRLE.UnPackString(Source: String): String;
var
PC, PC2: PChar;
SS, TS: Integer;
begin
SS := Length(Source) - 4;
GetMem(PC, SS);
Move(Source[1], TS, 4);
GetMem(PC2, TS);
Move(Source[5], PC^, SS);
TS := UnPack(PC, PC2, SS);
SetLength(Result, TS);
Move(PC2^, Result[1], TS);
FreeMem(PC2);
FreeMem(PC);
end;

{ TScreenEncoder }
constructor TScreenEncoder.Create(AOwner: TComponent);
begin
inherited;
// default properties value
FActive:= False;
FBlockInterval:= 1;
FBlockDelay:= 1;
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:= XorDataPtr;
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:= 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:= 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.BlockIndex:= i;
ScreenBitmaps.Bound:= Rect(0,0,BlockWidth,BlockHeight);
OffsetRect(ScreenBitmaps.Bound, (i mod FBlockColumnCount) * FBlockWidth, (i div FBlockColumnCount) * FBlockHeight);
{ScreenBitmaps.Bound:= Rect((i mod BlockWidth) * BMPBlockWidth, (i div BlockWidth) * BMPBlockHeight,
(i mod BlockWidth) * BMPBlockWidth + BMPBlockWidth, (i div BlockWidth) * BMPBlockHeight + BMPBlockHeight);{}
ScreenBitmaps.BMP:= TBitmap.Create;
With ScreenBitmaps.BMP do
Begin
Width:= BlockWidth;
Height:= BlockHeight;
PixelFormat:= FPixelFormat;
If Cardinal(ScanLine[0])<Cardinal(ScanLine[1]) then
ScreenBitmaps.ptr:= ScanLine[0]
Else
ScreenBitmaps.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:= nil;
FreeMem(XorDataPtr[1]);
For i:=0 to BlockCount-1 do
Begin
ScreenBitmaps.ptr:= nil;
ScreenBitmaps.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:= XorDataPtr;

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.

[]

这个Jingtao阿，找了一大堆“托”，目的就是卖弄它的东西，大家看过疯狂的石头吧，侮辱你的人格，还要侮辱你的智慧，跟车站那些集团骗子没有什么区别，那些都是等着分钱的马甲，大家认清楚了。

以前有SB上当，那个SB的帖子太在呢，现在还在找SB上当。

[]

to 王府井

陈经韬先生你都不认得，看来你是妄为程序员了

他还犯得着在这找托儿

我也很感兴趣这个问题,就是不知道从哪下手..

王兄,你对陈兄有仇吗,到处都作对..

唉,王府井你真是条疯狗.死咬不放.我算服了你了.看来这个贴子无法继续讨论下去了.否则又变成IOCP那贴一样.
我本身也不是个保守的人,如果有在QQ群415060呆的朋友应该知道,例如如何检测HOOK,如何写一个塞进BIOS运行的木马,我都详细回答过整个流程.但是从今天开始,我发誓以后也不会再上DFW,也不想再参加任何讨论了.说到做到!下班!

陈兄那个好快,
流口水..[]

这么多他的托，不心虚不要走啊，把木马写进bios有什么难度？emBootroot这种国外开源的多的去了，你就靠一个抄袭国外来蒙骗国外不懂得人来告看你，天天吹得不行啊。[]

to 全文检索：别人形象的高大源于你先弯下膝盖去仰视，马屁精有什么好处呢？

jingtao不要走啊，大家论技术嘛，不用换这么多马甲来骂人吧，事实上你还是有点智商的，就是情商太低。

这是2006年了，别人看不出你在传播木马，我还看不出来吗，你的程序里面内置了什么你应该比较清楚的，对不？我的汇编课程还是拿了A的[]

王府井 大哥能不能把你的软件源码发一份给我邮箱啊:hzjieking@163.com

我贴出来的就是完整的代码，你可以编译的，我不喜欢学jingtao前辈，放一个带木马的exe出来，要在国外论坛里面，放置木马抓住要坐牢的。唉，他什么时候才能长大呢？我都觉得惋惜啊！

说句公道话，偶也看jingtao不顺眼，在这里是讨论技术，遮遮掩掩算什么，还不如不说


建议大家下载VNC代码看看，虽然速度不是非常快，但满足一般应用是够了

to 王府井
我做人有我的原则，我敬仰那些站在技术高端的人。

更敬仰他们的品德。

马屁精有什么好处呢？

我不图他们给予技术上的支持和帮助。

N多牛人都在我的QQ好友列表里，当然也有经韬兄的。

但是我从来没有向他们索求过什么，一个问题也没有问过。

因为我知道他们也是很忙的。

弯下膝盖去仰视别人，说白了，我尊敬他们。他们是我的目标

不像你这种一人在上万人在下的处世态度,就算你到了独孤求败的水平，你的人际关系也不会好到那里去，这样做人快乐吗？ 自大狂

[]人际关系不楼上的担心，我在学校里和朋友玩得很开心啊。

两间余一卒，荷戟读彷徨，用鲁迅这个句诗来讲，我打假会承担一点孤单，但是和这些流氓斗争又其乐无穷。

修养这东西不是一两天弄出来的，地域的，家庭的，这些因素是流氓成为流氓的本质原因。

我觉得大富翁应该把大家的IP公开出来，这样很好辨识谁是马甲，谁是托，何必呢，君子爱财，取之有道，下三滥的手段只会让自己没有信誉，这些帖子不会删的，全世界人民都能瞻仰到中国骗子的风采。

TO 王府井
你上面的代码怎么调用啊?能否贴出个例子出来!

你这种人，做事轻挑，说话不经大脑。

任何一个情商再好的人看了你的话都会气不打一处出。

把jingtao兄赶走了，虽然不能完全怪你。但你得负上大部分责任。

相信损失最大的是DFW上的兄弟们。

??? 怎么了,大家不要这样子///

这里是讨论技术的,不是大家互相人身攻击的地方!
其实各人有各人做事的方法,犯不着为了看不惯某人而在坛子里大吼大叫了/
这样只能搞杂互相的心情,更重要的是影响大家讨论技术的氛围和坛子里的学习气氛//
当然我这里也不是指的某人,只是谈谈个人的看法而矣//
大家要做的应该是正经事!

说实话我喜欢Jingtao的交流方式
可以让我们自己独立思考

怕大家在这里继续吵了,结帖

多人接受答案了。