各位，我對GDI這類非常少接觸到，所以最近需要開發個C/S遠程的程序，需要用到好的屏幕傳輸。
我網絡上找到了這個算法

想請教下這樣的算法還能如何再提高效率嗎？不好意思，由於沒接觸過GDI的東西,不熟悉


[code delphi]


{*******************************************}
{ DG Remote Screen - ScreenSpy }
{ Author:guanyueguan(BCB_DG) }
{ EMail: iamgyg@163.com }
{ QQ: 112275024 }
{ Blog: http://iamgyg.blog.163.com }
{*******************************************}
unit ScreenSpy;
interface
uses
Windows, Classes, SysUtils, Graphics, Math,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, ZLibEx;
const
DEF_STEP = 19;
OFF_SET = 24;
type
PCapCmd = ^TCapCmd;
TCapCmd = packed record
Cmd: Byte;
Size: Integer;
Width: Word;
Height: Word;
end;
PCtlCmd = ^TCtlCmd;
TCtlCmd = packed record
Cmd: Byte;
X, Y: Word;
end;
TScreenSpy = class(TThread)
private
FScrStream: TMemoryStream;
FSendStream: TMemoryStream;
FFullBmp, FLineBmp, FRectBmp: TBitmap;
FWidth, FHeight, FLine: Integer;
FRect: TRect;
FDC: HDC;
FSocket: TIdTCPClient;
FCmd: TCapCmd;
FPixelFormat: TPixelFormat;
FIncSize: Byte;
//
function CheckScr: Boolean;
function GetFirst: Boolean;
function GetNext: Boolean;
function Compress: Boolean;
function SendInfo: Boolean;
function SendData: Boolean;
procedure CopyRect(rt: TRect);
procedure SetPixelFormat(Value: TPixelFormat);
protected
procedure Execute; override;
public
constructor Create(Host: string; Port: Integer); reintroduce;
destructor Destroy; override;
//
property Socket: TIdTCPClient read FSocket;
property PixelFormat: TPixelFormat read FPixelFormat write SetPixelFormat;
end;
implementation
uses Main;
constructor TScreenSpy.Create(Host: string; Port: Integer);
begin
FreeOnTerminate := True;
FSocket := TIdTCPClient.Create(nil);
FSocket.Host := Host;
FSocket.Port := Port;
FScrStream := TMemoryStream.Create;
FSendStream := TMemoryStream.Create;
FFullBmp := TBitmap.Create;
FLineBmp := TBitmap.Create;
FRectBmp := TBitmap.Create;
FWidth := 0;
FHeight := 0;
FIncSize := 4;
FPixelFormat := pf8bit;
inherited Create(False);
end;
destructor TScreenSpy.Destroy;
begin
FSocket.Free;
FScrStream.Free;
FSendStream.Free;
FRectBmp.Free;
FFullBmp.Free;
FLineBmp.Free;
inherited;
end;
procedure TScreenSpy.Execute;
var
CmdBuf: array[0..SizeOf(TCtlCmd) - 1] of Byte;
pt: TPoint;
begin
try
FSocket.Connect;
FSocket.WriteSmallInt(2);
while (not Terminated) and (FSocket.Connected) do
begin
FSocket.ReadBuffer(CmdBuf, SizeOf(TCtlCmd));
if TCtlCmd(CmdBuf).Cmd in [1..5] then
begin
pt := Point(TCtlCmd(CmdBuf).X, TCtlCmd(CmdBuf).Y);
SetCursorPos(pt.X, pt.Y);
SetCapture(WindowFromPoint(pt));
end;
case TCtlCmd(CmdBuf).Cmd of
0: PixelFormat := TPixelFormat(TCtlCmd(CmdBuf).X);
1: ;//mouse move
2: mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
3: mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
4: mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0);
5: mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0);
6: keybd_event(Byte(TCtlCmd(CmdBuf).X), MapVirtualKey(Byte(TCtlCmd(CmdBuf).X), 0), 0, 0);
7: keybd_event(Byte(TCtlCmd(CmdBuf).X), MapVirtualKey(Byte(TCtlCmd(CmdBuf).X), 0), KEYEVENTF_KEYUP, 0);
8: if CheckScr then GetFirst else GetNext;
end;
end;
except
end;
end;
procedure TScreenSpy.SetPixelFormat(Value: TPixelFormat);
begin
if (FPixelFormat <> Value) then
begin
FPixelFormat := Value;
case FPixelFormat of
pf1bit: FIncSize := 32;
pf4bit: FIncSize := 8;
pf8bit: FIncSize := 4;
pf16bit: FIncSize := 2;
pf32bit: FIncSize := 1;
else
FPixelFormat := pf8bit;
FIncSize := 4;
end;
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.Canvas.Lock;
FLineBmp.Canvas.Lock;
FRectBmp.Canvas.Lock;
FFullBmp.Width := FWidth;
FFullBmp.Height := FHeight;
FLineBmp.Width := FWidth;
FLineBmp.Height := 1;
FFullBmp.PixelFormat := FPixelFormat;
FLineBmp.PixelFormat := FPixelFormat;
FRectBmp.PixelFormat := FPixelFormat;
FFullBmp.Canvas.Unlock;
FLineBmp.Canvas.Unlock;
FRectBmp.Canvas.Unlock;
FLine := 0;
Result := True;
end;
end;
function TScreenSpy.GetFirst: Boolean;
begin
Result := False;
FDC := GetDC(0);
FFullBmp.Canvas.Lock;
BitBlt(FFullBmp.Canvas.Handle, 0, 0, FWidth, FHeight, FDC, 0, 0, SRCCOPY);
FFullBmp.Canvas.Unlock;
ReleaseDC(0, FDC);
SetRect(FRect, 0, 0, FWidth, FHeight);
FScrStream.Clear;
FScrStream.WriteBuffer(FRect, SizeOf(TRect));
FFullBmp.SaveToStream(FScrStream);
if Compress and SendInfo then Result := SendData;
end;
procedure TScreenSpy.CopyRect(rt: TRect);
begin
FFullBmp.Canvas.Lock;
FRectBmp.Canvas.Lock;
try
FRectBmp.Width := rt.Right - rt.Left;
FRectBmp.Height := rt.Bottom - rt.Top;
BitBlt(FFullBmp.Canvas.Handle, rt.Left, rt.Top, FRectBmp.Width, FRectBmp.Height, FDC, rt.Left, rt.Top, SRCCOPY);
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;
FDC := GetDC(0);
i := FLine;
while i < FHeight do
begin
FLineBmp.Canvas.Lock;
BitBlt(FLineBmp.Canvas.Handle, 0, 0, FWidth, 1, FDC, 0, i, SRCCOPY);
FLineBmp.Canvas.Unlock;
p1 := FFullBmp.ScanLine[i];
p2 := FLineBmp.ScanLine[0];
SetRect(FRect, -1, i - DEF_STEP, -1, i DEF_STEP * 2);
j := 0;
while j < FWidth do
begin
if (p1^ <> p2^) then
begin
if (FRect.Right < 0) then FRect.Left := j - OFF_SET;
FRect.Right := j OFF_SET;
end;
Inc(p1);
Inc(p2);
Inc(j, FIncSize);
end;
if (FRect.Right > -1) then
begin
with FRect do
begin
Left := Max(Left, 0);
Top := Max(Top, 0);
Right := Min(Right, FWidth);
Bottom := Min(Bottom, FHeight);
end;
CopyRect(FRect);
Inc(i, DEF_STEP);
end;
Inc(i, DEF_STEP);
end;
ReleaseDC(0, FDC);
FLine := (FLine 3) mod DEF_STEP;
if (FScrStream.Position > 0) and Compress then Result := SendData;
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.WriteBuffer(FCmd, SizeOf(TCapCmd));
Result := True;
except
Result := False;
end;
end;
function TScreenSpy.SendData: Boolean;
begin
try
FCmd.Cmd := 2;
FCmd.Size := FSendStream.Size;
FSocket.WriteBuffer(FCmd, SizeOf(TCapCmd));
FSocket.WriteBuffer(FSendStream.Memory^, FSendStream.Size);
Result := True;
except
Result := False;
end;
end;
end.

[/code]
想從GetFirst部分修改，就是
BitBlt的時候分小部分，但是還是效率不好。誰能提高它的算法的望指點。

附加檔案：4807034554478_DGScreenSpy_0[1].1.1c.rar

編輯記錄

1.  建議用分塊比對，切太小花在比對時間太耗時。
2. 圖片比對時，應該自訂傳輸格式。定義那一塊需異動，並且傳輸該塊即可。
3. 建議轉成 JPEG 傳輸效率會比較好。(有損壓縮)

約略看一下覺得 GetNext 效率很低。常常搬來搬去，當畫圖不費工啊。

補充： Hook invalidate 也是一種很好方式。 有異動直接刷新該區塊。

編輯記錄

JPEG 在 SavetoStream 之前轉成 TJPEGImage 詳細查 Google 或本站

我是比較吹毛求疵。
對於這支程式認為邏輯重複的地方有很多。
例如已經 ScanLine 比對出不同的部分，直接將 SCanLine 的PByteArray轉存到Stream
不就得了。
還要摳圖摳來摳去，在我看來不是很有其必要性。
BitBlt 用得太多了。效率慢是看的出來。

實例自己用拼圖的精神把它拼出來吧！
這支程式要做到最好要花的功夫跟時間可不小。
實在沒有多餘的時間。
我自己都快火燒屁股了。

===================引 用 cyy0754 文 章===================

你可以参考 VNC 的 Source。