www.pudn.com > laowaixiedechengxu.rar > ScrSpy.pas
unit ScrSpy;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
BufferUDP;
Type
TScreenBlock= record
BlockIndex: Integer;
BMP: TBitmap;
ptr: Pointer;
Bound: TRect;
end;
type
TScreenSpyBitmapEvent = procedure(Sender: TObject; const Block: TScreenBlock; LastScanline: Pointer; IsIFrame: Boolean) of object;
TFrameStartEvent = procedure(Sender: TObject; const FrameCount: Cardinal; const IsIFrame: Boolean) of object;
TFrameEndEvent = procedure(Sender: TObject; const FrameCount: Cardinal; const IsIFrame: Boolean; const HasBitmapEvent: Boolean) of object;
TScreenSpy = class;
EScrSpy = Exception;
TScreenSpyThread = class(TThread)
private
// Properties
FScreenSpy: TScreenSpy;
// Golbal variable
SBIndex: Integer; // ScreenBitmaps' Index
IsIFrame: Boolean;
TCWhenCapture: Cardinal;
protected
Procedure CaptureScreen; Virtual;
procedure ScreenBitmap;
Procedure FrameStart;
Procedure FrameEnd;
procedure Execute; override;
property ScreenSpy: TScreenSpy read FScreenSpy write FScreenSpy;
public
constructor Create; reintroduce;
destructor Destroy; override;
end;
TScreenSpy = class(TComponent)
private
{ Private declarations }
// Properties
FIFrame: Cardinal;
FActive: Boolean;
FThreadPriority: TThreadPriority;
FScreenCanvas: TCanvas;
FScreenWidth: Word;
FScreenHeight: Word;
FBytesPerPixel: Byte;
FPixelFormat: TPixelFormat;
FMaxFrameRate: Byte;
FMaxBlockSize: Integer;
FBlockRowCount: Integer;
FBlockColumnCount: Integer;
FBlockCount: Integer;
FBlockWidth: Integer;
FBlockHeight: Integer;
FBlockSize: Integer;
FBlockBound: TRect; // Block size = (0, 0, BWidth, BHeight)
FFrameCount: Cardinal;
// Events
FOnScreenBitmap: TScreenSpyBitmapEvent;
FOnFrameStart: TFrameStartEvent;
FOnFrameEnd: TFrameEndEvent;
// Golbal private Variables
HasBitmapEvent: Boolean;
MaxDelayMilliseconds: Cardinal;
ScreenBitmaps: array of TScreenBlock;
LastScreen: array of Pointer;
BMPBlockSize: Integer; // Size of Bitmap for one block
MemoryAllowcated: Boolean;
SCThread: TScreenSpyThread;
Procedure SetActive(const Value: Boolean);
Procedure SetThreadPriority(const Value: TThreadPriority);
Procedure SetMaxBlockSize(const Value: Integer);
Procedure SetMaxFrameRate(const Value: Byte);
Procedure SetIFrame(const Value: Cardinal);
protected
{ Protected declarations }
procedure CalculateScreenData;
procedure ReleaseScreenData;
procedure DoScreenBitmap(ScreenBitmapIndex: Integer; IsIFrame: Boolean);
procedure DoFrameStart(const IsIFrame: Boolean);
procedure DoFrameEnd(const IsIFrame: Boolean);
public
{ Public declarations }
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
Property ScreenCanvas: TCanvas read FScreenCanvas;
Property ScreenWidth: Word read FScreenWidth;
Property ScreenHeight: Word read FScreenHeight;
Property BytesPerPixel: Byte read FBytesPerPixel;
Property PixelFormat: TPixelFormat read FPixelFormat;
Property BlockCount: Integer read FBlockCount;
Property BlockRowCount: Integer read FBlockRowCount;
Property BlockColumnCount: Integer read FBlockColumnCount;
Property BlockWidth: Integer read FBlockWidth;
Property BlockHeight: Integer read FBlockHeight;
Property BlockSize: Integer read FBlockSize;
Property BlockBound: TRect read FBlockBound;
Property FrameCount: Cardinal read FFrameCount;
published
{ Published declarations }
Property OnScreenBitmap: TScreenSpyBitmapEvent read FOnScreenBitmap write FOnScreenBitmap;
Property OnFrameStart: TFrameStartEvent read FOnFrameStart write FOnFrameStart;
Property OnFrameEnd: TFrameEndEvent read FOnFrameEnd write FOnFrameEnd;
Property IFrame: Cardinal read FIFrame write SetIFrame default 30;
Property ThreadPriority: TThreadPriority read FThreadPriority write SetThreadPriority default tpNormal;
Property MaxBlockSize: Integer read FMaxBlockSize write SetMaxBlockSize default 30000;
Property MaxFrameRate: Byte read FMaxFrameRate write SetMaxFrameRate default 10;
Property Active : Boolean read FActive write SetActive default False;
end;
TSFastRLE = class(TObject)
private
t, s: Pointer;
function PackSeg(Source, Target: Pointer; SourceSize: Word): Word;
function UnPackSeg(Source, Target: Pointer; SourceSize: Word): Word;
protected
public
Constructor Create;
Destructor Destroy; override;
function Pack(Source, Target: Pointer; SourceSize: LongInt): LongInt; { Return TargetSize }
function UnPack(Source, Target: Pointer; SourceSize: LongInt): LongInt; {Return TargetSize }
function PackString(Source: String): String;
function UnPackString(Source: String): String;
function PackFile(SourceFileName, TargetFileName: String): Boolean; { Return FALSE if IOError }
function UnPackFile(SourceFileName, TargetFileName: String): Boolean; { Return FALSE if IOError }
end;
{ Protocol }
Const
RID_Invalid = $00;
RID_Header = $02;
RID_Block = $04;
RID_FrameStart = $06;
RID_FrameEnd = $08;
RID_MousePos = $0A;
RID_Start = $0C;
RID_Stop = $0E;
type
TRID = Word;
TRSize = Cardinal;
TScreenDataStyle = (sdsUncompress, sdsRLENormal, sdsRLEXor);
Type // Data type for transmission pack
TftAny= Packed Record
dwSize: TRSize;
PackID : TRID;
Data: Array [0..0] of Byte;
End;
PftAny= ^TftAny;
TftHeader= Packed Record
dwSize: TRSize;
PackID : TRID;
ScreenWidth: Word;
ScreenHeight: Word;
BytesPerPixel: Byte;
BlockWidth: Word;
BlockHeight: Word;
End;
PftHeader = ^TftHeader;
TftBlock = Packed Record
dwSize: TRSize;
PackID: TRID;
BlockIndex: Cardinal;
FrameStyle: TScreenDataStyle;
Data: Array [0..0] of Byte;
End;
PftBlock = ^TftBlock;
TftFrameStart = Packed Record
dwSize: TRSize;
PackID: TRID;
FrameCount: Cardinal;
IsIFrame: Boolean;
End;
PftFrameStart = ^TftFrameStart;
TftFrameEnd = Packed Record
dwSize: TRSize;
PackID: TRID;
FrameCount: Cardinal;
IsIFrame: Boolean;
HasBitmapEvent: Boolean;
End;
PftFrameEnd = ^TftFrameEnd;
Const
SizeOfTftBlock = SizeOf(TftBlock);
SizeOfTftHeader = SizeOf(TftHeader);
SizeOfTftFrameStart = SizeOf(TftFrameStart);
SizeOfTftFrameEnd = SizeOf(TftFrameEnd);
{ TScreen Transfer}
Type
TScreenEncoder = class(TComponent)
private
{ Private declarations }
// Properties
FActive : Boolean;
FBlockDelay : Cardinal;
FBlockInterval: Cardinal;
FIFrameDelay: Cardinal;
// Events
FOnFrameStart: TFrameStartEvent;
FOnFrameEnd: TFrameEndEvent;
// Golbal variables
FScreenSpy : TScreenSpy;
FUDPSender : TUDPSender;
FSFastRLE : TSFastRLE;
XorDataPtr: array [1..4] of Pointer; // MAX 4 bytes per pixel
RHeader : TftHeader;
RFrameStart: TftFrameStart;
RFrameEnd: TftFrameEnd;
Blockptr: PftBlock;
BlockIntervalCount: Cardinal;
function GetIFrame: Cardinal;
function GetMaxBlockSize: Integer;
function GetMaxFrameRate: Byte;
function GetThreadPriority: TThreadPriority;
procedure SetActive(Value: Boolean);
procedure SetIFrame(const Value: Cardinal);
procedure SetMaxBlockSize(const Value: Integer);
procedure SetMaxFrameRate(const Value: Byte);
procedure SetThreadPriority(const Value: TThreadPriority);
function GetRemoteHost: String;
function GetRemoteIP: String;
function GetRemotePort: Word;
procedure SetRemoteHost(const Value: String);
procedure SetRemoteIP(const Value: String);
procedure SetRemotePort(const Value: Word);
procedure SetBlockDelay(const Value: Cardinal);
procedure SetBlockInterval(const Value: Cardinal);
procedure SetIFrameDelay(const Value: Cardinal);
protected
{ Protected declarations }
procedure ScreenSpyOnScreenBitmap(Sender: TObject; const Block: TScreenBlock; LastScanline: Pointer; IsIFrame: Boolean);
procedure ScreenSpyOnFrameStart(Sender: TObject; const FrameCount: Cardinal; const IsIFrame: Boolean);
procedure ScreenSpyOnFrameEnd(Sender: TObject; const FrameCount: Cardinal; const IsIFrame: Boolean; const HasBitmapEvent: Boolean);
Procedure SendHeader;
procedure DoFrameStart(const FrameCount: Cardinal; const IsIFrame: Boolean); virtual;
procedure DoFrameEnd(const FrameCount: Cardinal; const IsIFrame: Boolean; const HasBitmapEvent: Boolean); virtual;
public
{ Public declarations }
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
published
{ Published declarations }
Property OnFrameStart: TFrameStartEvent read FOnFrameStart write FOnFrameStart;
Property OnFrameEnd: TFrameEndEvent read FOnFrameEnd write FOnFrameEnd;
Property BlockInterval: Cardinal read FBlockInterval write SetBlockInterval default 10;
Property BlockDelay: Cardinal read FBlockDelay write SetBlockDelay default 1;
Property IFrameDelay: Cardinal read FIFrameDelay write SetIFrameDelay default 100;
Property IFrame: Cardinal read GetIFrame write SetIFrame;
Property ThreadPriority: TThreadPriority read GetThreadPriority write SetThreadPriority;
Property MaxBlockSize: Integer read GetMaxBlockSize write SetMaxBlockSize;
Property MaxFrameRate: Byte read GetMaxFrameRate write SetMaxFrameRate;
property RemoteIP: String read GetRemoteIP write SetRemoteIP;
property RemoteHost: String read GetRemoteHost write SetRemoteHost;
property RemotePort: Word read GetRemotePort write SetRemotePort;
Property Active : Boolean read FActive write SetActive default False;
end;
TScreenPlayerBitmapEvent = procedure(Sender: TObject; const Block: TScreenBlock) of object;
TScreenPlayer = class(TComponent)
private
{ Private declarations }
// Properties
FScreenWidth: Word;
FScreenHeight: Word;
FBytesPerPixel: Byte;
FPixelFormat: TPixelFormat;
FBlockRowCount: Integer;
FBlockColumnCount: Integer;
FBlockCount: Integer;
FBlockWidth: Integer;
FBlockHeight: Integer;
FBlockSize: Integer;
// Events
FOnScreenBitmap: TScreenPlayerBitmapEvent;
FOnHeaderUpdate: TNotifyEvent;
FOnFrameEnd: TFrameEndEvent;
FOnFrameStart: TFrameStartEvent;
// Golbal Variables
FUDPReceiver : TUDPReceiver;
FSFastRLE : TSFastRLE;
XorDataPtr: array [1..4] of Pointer; // MAX 4 bytes per pixel
ScreenBitmaps: array of TScreenBlock;
BMPBlockSize: Integer; // Size of Bitmap for one block
MemoryAllowcated: Boolean;
Header: TftHeader;
AnyPtr: PftAny;
BlockPtr: PftBlock;
FrameStartPtr: PftFrameStart;
FrameEndPtr: PftFrameEnd;
function GetActive: Boolean;
function GetMulticastIP: String;
function GetPort: Word;
procedure SetActive(const Value: Boolean);
procedure SetMulticastIP(const Value: String);
procedure SetPort(const Value: Word);
protected
{ Protected declarations }
procedure CalculateScreenData; virtual;
procedure ReleaseScreenData; virtual;
procedure DoScreenBitmap(ScreenBitmapIndex: Integer); virtual;
procedure DoHeaderUpdate;
procedure UDPReceiverOnUDPData(Sender: TObject; const Buffer: Pointer; const RecvSize:Integer; const Peer: string; const Port: Integer); virtual;
public
{ Public declarations }
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
Property ScreenWidth: Word read FScreenWidth;
Property ScreenHeight: Word read FScreenHeight;
Property BytesPerPixel: Byte read FBytesPerPixel;
Property PixelFormat: TPixelFormat read FPixelFormat;
Property BlockCount: Integer read FBlockCount;
Property BlockRowCount: Integer read FBlockRowCount;
Property BlockColumnCount: Integer read FBlockColumnCount;
Property BlockWidth: Integer read FBlockWidth;
Property BlockHeight: Integer read FBlockHeight;
Property BlockSize: Integer read FBlockSize;
published
{ Published declarations }
Property OnScreenBitmap: TScreenPlayerBitmapEvent read FOnScreenBitmap write FOnScreenBitmap;
Property OnHeaderUpdate: TNotifyEvent read FOnHeaderUpdate write FOnHeaderUpdate;
Property OnFrameStart: TFrameStartEvent read FOnFrameStart write FOnFrameStart;
Property OnFrameEnd: TFrameEndEvent read FOnFrameEnd write FOnFrameEnd;
property Port: Word read GetPort write SetPort;
property MulticastIP: String read GetMulticastIP write SetMulticastIP;
property Active: Boolean read GetActive write SetActive default False;
end;
procedure Register;
resourcestring
ESSACTIVED = 'Connot perform this action while component is in active!';
ESSINVALIDVALUE = 'Invalid value assigned!';
implementation
procedure Register;
begin
RegisterComponents('Samples', [TScreenSpy, TScreenEncoder, TScreenPlayer]);
end;
{ TScreenSpy }
procedure TScreenSpy.CalculateScreenData;
// e.g.: ANumber = 800, MaxRoot = 21; Result = 20 (800 mod 20=0)
Function MultiRoot(ANumber, MaxRoot: Cardinal): Cardinal;
Begin
If MaxRoot>0 then
While (ANumber mod MaxRoot)<>0 do
MaxRoot:= MaxRoot-1;
Result:= MaxRoot;
End;
// e.g.: ANumber = 800, MinRoot=20, MaxRoot = 41; Result = 40 (800 mod 40=0)
Function MaxRootOf(ANumber, MinRoot, MaxRoot: Cardinal): Cardinal;
Begin
If (MaxRoot>0) and (MinRoot>0) then
While ((ANumber mod MaxRoot)<>0) and (MaxRoot>=MinRoot) do
MaxRoot:= MaxRoot-1;
If MaxRoot>=MinRoot then
Result:= MaxRoot
Else
Result:= 0; // not found
End;
Var
i: Integer;
BitsPerPixel: Integer;
begin
If MemoryAllowcated then
ReleaseScreenData;
MemoryAllowcated:= True;
// Find system information for screen
// Get ready to capture screen
FScreenCanvas.Handle:= GetDC(0);
// Get All information about screen
FScreenWidth:= Screen.Width;
FScreenHeight:= Screen.Height;
BitsPerPixel := GetDeviceCaps(ScreenCanvas.Handle, BITSPIXEL);
Case BitsPerPixel of
8 :
Begin
FBytesPerPixel:= 1;
FPixelFormat:= pf8bit;
End;
16:
Begin
FBytesPerPixel:= 2;
FPixelFormat:= pf16bit;
End;
24:
Begin
FBytesPerPixel:= 3;
FPixelFormat:= pf24bit;
End;
32:
Begin
FBytesPerPixel:= 4;
FPixelFormat:= pf32bit;
End;
Else
Begin
FBytesPerPixel:= 3;
FPixelFormat:= pf24bit;
End;
End;{CASE}
// Calculate Block information
// Max block area for avaliable block size
i:= FMaxBlockSize div FBytesPerPixel;
FBlockHeight:= Trunc(sqrt(i));
FBlockHeight:= MultiRoot(ScreenHeight, FBlockHeight);
FBlockWidth:= i div FBlockHeight;
FBlockWidth:= MultiRoot(ScreenWidth, FBlockWidth);
FBlockHeight:= MaxRootOf(ScreenHeight, FBlockHeight, i div FBlockWidth);
FBlockSize:= BlockWidth * FBlockHeight;
BMPBlockSize := BlockSize * BytesPerPixel;
FBlockColumnCount:= FScreenWidth div FBlockWidth;
FBlockRowCount:= FScreenHeight div FBlockHeight;
FBlockCount:= FBlockColumnCount * FBlockRowCount;
// Re-Allocate memory
// Create off-screen memory for store last screen
SetLength(LastScreen, BlockCount);
For i:=0 to BlockCount-1 do
Begin
GetMem(LastScreen[i], BMPBlockSize);
FillChar(LastScreen[i]^, BMPBlockSize, $0);
End;
// Get buffer for send-data
// GetMem(ScreenBlockPtr, SizeOf(TScreenBlock)+BMPBlockSize+8);
//ScreenBlockPtr^.UNID:= 0; // In fact it is a user defined value
//ScreenBlockDataPtr:= @(ScreenBlockPtr^.Data[0]); // Why use it?
FBlockBound:= Rect(0, 0, FBlockWidth, FBlockHeight);
// Create temp bitmap for copy a pice of desktop image
SetLength(ScreenBitmaps, BlockCount);
For i:=0 to BlockCount-1 do
Begin
ScreenBitmaps[i].BlockIndex:= i;
ScreenBitmaps[i].Bound:= Rect(0,0,BlockWidth,BlockHeight);
OffsetRect(ScreenBitmaps[i].Bound, (i mod FBlockColumnCount) * FBlockWidth, (i div FBlockColumnCount) * FBlockHeight);
{ScreenBitmaps[i].Bound:= Rect((i mod BlockWidth) * BMPBlockWidth, (i div BlockWidth) * BMPBlockHeight,
(i mod BlockWidth) * BMPBlockWidth + BMPBlockWidth, (i div BlockWidth) * BMPBlockHeight + BMPBlockHeight);{}
ScreenBitmaps[i].BMP:= TBitmap.Create;
With ScreenBitmaps[i].BMP do
Begin
Width:= BlockWidth;
Height:= BlockHeight;
PixelFormat:= FPixelFormat;
If Cardinal(ScanLine[0])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[i] 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[i]:= XorDataPtr[i];
For i:=1 to BlockSize do
Begin
// Move (R, G, B) to each area if (24bits), for better RLE compression.
For l:=1 to BytesPerPixel do
Begin
ptrXOR[l]^:= ptrNow^ xor ptrLast^; // XOR
Inc(ptrNow);
Inc(ptrLast);
Inc(ptrXOR[l]);
End;
End;
{ Compress }
PackedSize:= FSFastRLE.Pack(XorDataPtr[1], @(Blockptr^.Data[0]), BMPBlockSize);
{ Send }
If PackedSize>0 then
Begin
dwSize:= SizeofTftBlock-1+PackedSize;
FUDPSender.SendBuf(Blockptr^, Blockptr^.dwSize);
// Delay when Interval
BlockIntervalCount:= (BlockIntervalCount+1) mod FBlockInterval;
If BlockIntervalCount=0 then
Sleep(FBlockDelay);
End;
End;
End;
end;
function TScreenEncoder.GetIFrame: Cardinal;
begin
Result:= FScreenSpy.IFrame;
end;
function TScreenEncoder.GetMaxBlockSize: Integer;
begin
Result:= FScreenSpy.MaxBlockSize;
end;
function TScreenEncoder.GetMaxFrameRate: Byte;
begin
Result:= FScreenSpy.MaxFrameRate;
end;
function TScreenEncoder.GetRemoteHost: String;
begin
Result:= FUDPSender.RemoteHost;
end;
function TScreenEncoder.GetRemoteIP: String;
begin
Result:= FUDPSender.RemoteIP;
end;
function TScreenEncoder.GetRemotePort: Word;
begin
Result:= FUDPSender.RemotePort;
end;
function TScreenEncoder.GetThreadPriority: TThreadPriority;
begin
Result:= FScreenSpy.ThreadPriority;
end;
procedure TScreenEncoder.SetActive(Value: Boolean);
begin
If Value<>FActive then
try
If Value then
Begin
// Init
BlockIntervalCount:= 0;
try
FUDPSender.Active:= True; // Active UDP sender first
except
Value:= False;
Raise;
end;
If Value then
SendHeader;
try
FScreenSpy.Active:= Value;
except
Value:= False;
Raise;
end;
End;
If Not Value then
Begin
FScreenSpy.Active:= Value; // Deactive ScreenSpy first
FUDPSender.Active:= Value;
End;
finally
FActive:= Value;
end;
end;
procedure TScreenEncoder.SetIFrame(const Value: Cardinal);
begin
FScreenSpy.IFrame:= Value;
end;
procedure TScreenEncoder.SetMaxBlockSize(const Value: Integer);
Var
i: Integer;
begin
If Active then
Raise EScrSpy.CreateRes(@ESSACTIVED);
FScreenSpy.MaxBlockSize:= Value;
try
If Assigned(Blockptr) then
FreeMem(Blockptr);
If Assigned(XorDataPtr[1]) then
FreeMem(XorDataPtr[1]);
finally
With FScreenSpy do
Begin
// GetBlock
GetMem(Blockptr, SizeofTftBlock+BMPBlockSize+8);
FillChar(Blockptr^, SizeofTftBlock+BMPBlockSize, 0);
Blockptr^.PackID:= RID_BLOCK;
// GetXor
GetMem(XorDataPtr[1], BMPBlockSize);
For i:=2 to BytesPerPixel do
XorDataPtr[i]:= Pointer(Integer(XorDataPtr[1])+Integer(BlockSize)*(i-1));
End;
end;
end;
procedure TScreenEncoder.SetMaxFrameRate(const Value: Byte);
begin
FScreenSpy.MaxFrameRate:= Value;
end;
procedure TScreenEncoder.SetRemoteHost(const Value: String);
begin
FUDPSender.RemoteHost:= Value;
end;
procedure TScreenEncoder.SetRemoteIP(const Value: String);
begin
FUDPSender.RemoteIP:= Value;
end;
procedure TScreenEncoder.SetRemotePort(const Value: Word);
begin
FUDPSender.RemotePort:= Value;
end;
procedure TScreenEncoder.SetThreadPriority(const Value: TThreadPriority);
begin
FScreenSpy.ThreadPriority:= Value;
end;
procedure TScreenEncoder.SendHeader;
begin
If Not FScreenSpy.MemoryAllowcated then
FScreenSpy.CalculateScreenData;
With RHeader do
Begin
ScreenWidth:= FScreenSpy.ScreenWidth;
ScreenHeight:= FScreenSpy.ScreenHeight;
BytesPerPixel:= FScreenSpy.BytesPerPixel;
BlockWidth:= FScreenSpy.BlockWidth;
BlockHeight:= FScreenSpy.BlockHeight;
End;
FUDPSender.SendBuf(RHeader, RHeader.dwSize);
end;
procedure TScreenEncoder.SetBlockDelay(const Value: Cardinal);
begin
FBlockDelay := Value;
end;
procedure TScreenEncoder.ScreenSpyOnFrameEnd(Sender: TObject;
const FrameCount: Cardinal; const IsIFrame, HasBitmapEvent: Boolean);
begin
DoFrameEnd(FrameCount, IsIFrame, HasBitmapEvent);
If IsIFrame then
Sleep(FIFrameDelay);
end;
procedure TScreenEncoder.DoFrameEnd(const FrameCount: Cardinal;
const IsIFrame, HasBitmapEvent: Boolean);
begin
RFrameEnd.FrameCount:= FrameCount;
RFrameEnd.IsIFrame:= IsIFrame;
RFrameEnd.HasBitmapEvent:= HasBitmapEvent;
FUDPSender.SendBuf(RFrameEnd, RFrameEnd.dwSize);
If Assigned(FOnFrameEnd) then
FOnFrameEnd(Self, FrameCount, IsIFrame, HasBitmapEvent);
end;
procedure TScreenEncoder.DoFrameStart(const FrameCount: Cardinal;
const IsIFrame: Boolean);
begin
RFrameStart.FrameCount:= FrameCount;
RFrameStart.IsIFrame:= IsIFrame;
FUDPSender.SendBuf(RFrameStart, RFrameStart.dwSize);
If Assigned(FOnFrameStart) then
FOnFrameStart(Self, FrameCount, IsIFrame);
end;
procedure TScreenEncoder.ScreenSpyOnFrameStart(Sender: TObject;
const FrameCount: Cardinal; const IsIFrame: Boolean);
begin
DoFrameStart(FrameCount, IsIFrame);
end;
procedure TScreenEncoder.SetBlockInterval(const Value: Cardinal);
begin
FBlockInterval := Value;
end;
procedure TScreenEncoder.SetIFrameDelay(const Value: Cardinal);
begin
FIFrameDelay := Value;
end;
{ TScreenPlayer }
procedure TScreenPlayer.CalculateScreenData;
Var
i: Integer;
begin
If MemoryAllowcated then
ReleaseScreenData;
With Header do
Begin
FScreenWidth:= ScreenWidth;
FScreenHeight:= ScreenHeight;
FBytesPerPixel:= BytesPerPixel;
FBlockWidth:= BlockWidth;
FBlockHeight:= BlockHeight;
End;
Case FBytesPerPixel of
1: FPixelFormat:= pf8Bit;
2: FPixelFormat:= pf16Bit;
3: FPixelFormat:= pf24Bit;
4: FPixelFormat:= pf32Bit;
Else FPixelFormat:= pf24Bit;
End;{CASE}
FBlockColumnCount:= FScreenWidth div FBlockWidth;
FBlockRowCount:= FScreenHeight div FBlockHeight;
FBlockCount:= FBlockColumnCount * FBlockRowCount;
FBlockSize:= FBlockWidth * FBlockHeight;
BMPBlockSize:= FBlockSize * FBytesPerPixel;
// Get Buffer for Decode Screen block
GetMem(XorDataPtr[1], BMPBlockSize);
For i:=2 to BytesPerPixel do
XorDataPtr[i]:= Pointer(Integer(XorDataPtr[1])+BlockSize*(i-1));
// Create temp bitmap for copy a pice of desktop image
SetLength(ScreenBitmaps, BlockCount);
For i:=0 to BlockCount-1 do
Begin
ScreenBitmaps[i].BlockIndex:= i;
ScreenBitmaps[i].Bound:= Rect(0,0,BlockWidth,BlockHeight);
OffsetRect(ScreenBitmaps[i].Bound, (i mod FBlockColumnCount) * FBlockWidth, (i div FBlockColumnCount) * FBlockHeight);
{ScreenBitmaps[i].Bound:= Rect((i mod BlockWidth) * BMPBlockWidth, (i div BlockWidth) * BMPBlockHeight,
(i mod BlockWidth) * BMPBlockWidth + BMPBlockWidth, (i div BlockWidth) * BMPBlockHeight + BMPBlockHeight);{}
ScreenBitmaps[i].BMP:= TBitmap.Create;
With ScreenBitmaps[i].BMP do
Begin
Width:= BlockWidth;
Height:= BlockHeight;
PixelFormat:= FPixelFormat;
If Cardinal(ScanLine[0]) TRSize(RecvSize) then
Exit; // Error
Case AnyPtr.PackID of
RID_HEADER:
Begin
Move(AnyPtr^, Header, AnyPtr^.dwSize);
CalculateScreenData;
DoHeaderUpdate;
End;
RID_BLOCK:
If MemoryAllowcated then
Begin
BlockPtr:= Pointer(AnyPtr);
With BlockPtr^ do
Case FrameStyle of
sdsRLENormal:
Begin
//decompress
//FSFastRLE.UnPack(@(Data[0]), ScreenBitmaps[BlockIndex].ptr, dwSize+1-SizeofTftBlock);
FSFastRLE.UnPack(@(Data[0]), XorDataPtr[1], dwSize+1-SizeofTftBlock);
Move(XorDataPtr[1]^, ScreenBitmaps[BlockIndex].ptr^, BMPBlockSize);
DoScreenBitmap(BlockIndex);
End;
sdsRLEXor:
Begin
FSFastRLE.UnPack(@(Data[0]), XorDataPtr[1], dwSize+1-SizeofTftBlock);
// Init First Pointer for sequence XOR
ScanLinePtr:= ScreenBitmaps[BlockIndex].ptr;
For i:=0 to BytesPerPixel do
PtrXor[i]:= XorDataPtr[i];
For i:=0 to BlockSize-1 do
Begin
For l:=1 to BytesPerPixel do
Begin
ScanLinePtr^:= ScanLinePtr^ xor PtrXor[l]^;
Inc(ScanLinePtr);
Inc(PtrXor[l]);
End;
End;
DoScreenBitmap(BlockIndex);
End;
End;{CASE}
End;
RID_FrameStart:
Begin
FrameStartPtr:= Pointer(AnyPtr);
If Assigned(FOnFrameStart) then
FOnFrameStart(Self, FrameStartPtr^.FrameCount, FrameStartPtr^.IsIFrame);
End;
RID_FrameEnd:
Begin
FrameEndPtr:= Pointer(AnyPtr);
If Assigned(FOnFrameEnd) then
FOnFrameEnd(Self, FrameEndPtr^.FrameCount, FrameEndPtr^.IsIFrame, FrameEndPtr^.HasBitmapEvent);
End;
Else //Error
End;{CASE}
end;
end.