终于完成了一个有点难度的东东了。远端屏幕传输。就是效率不高 ( 积分: 5 )

哈哈，现在已经差不多OK了。

现在 局域网里 15fps ，CPU 占用40%.总得来说，比我想象中的还要好点。
现在还有几个小地方要完善一下

1, 色彩问题，第一帧图与后面的图调色板不一样。色彩有点变暗

2. 被控端如窗口拖动时，可能有些小部分图形有错误。可能与我的算法有关。过几天再验证一下我的算法

3.如同能证明我的算法正确，那可以用 MMX 指令来优化一下。现在也用嵌入式汇编的，不过一次处理 32位，用了MMX 后可以提高一倍，一次处理 64bit, 也就是8 个字节。但估计对性能提高用处不大。

4. 鼠标键盘的处理没有做。

差不多就这样了

QSmile 加油，希望你把算法公布出来，让大家都可以思考。

简单说一下上面都没提到一个地方， (我也是在网上看到的)

关于数据压缩的问题。数据压的越多，就越要更多的ＣＰＵ资源

但屏幕有个特点，就算你分了块了，一个块有变化，也不会是整个块在变。可能大部分都没变也有。
我的做法是把当前分块的内容与最后一次分块的内容做一次 XOR. XOR 后，相同的就成了 0了。如果变化的不多，那就可能是一大串 0，和少数几个数据。然后我再对数据做一个 RLE 压缩。再发。
这样一个分块，有时就只有几百个字节，有时还只有几十来个字节。
我用嵌入式汇编，XOR 就很快，MMX 指令里也刚好有个 XOR 命令。不过要做好字节对齐。

XOR是针对小变化有用的，在大变化时会更慢，这种做法还不合理。

呵呵,别人不研究,大家都不研究;一有人研究出来了,就全世界群起而研究.真不懂别人没公开的这几年大家干什么去了.丑陋的中国人.
不过我也一样希望看到公开代码.XI XI XI.

我认为还是做一下 XOR 比较好一点，就实际来看，流量要小一些

QSmile, 我發了個我寫的測試程序給你，是用我在盒子上公布的算法寫的測試程序，在我這邊還過得去(我這的機子配置都比較高，最少C2.4G以上，所以看不出效果)，不知你那裡如何。

你的那个速度相当快了， 好象每次发的数据是隔行了的，是不是

是隔行掃描的算法，算法代碼我貼在了盒子上：http://www.2ccc.com/article.asp?articleid=4081，現在正在改成矩形計算，但有點難度，所以進展緩慢。

to guanyueguan,

我加入那个群了。但好象我在线的时候你都没在线，真想与你好好讨论下技术性问题
我在里面叫 Delphi-Fox

期待

to guanyueguan:我用你的代码重新生成了程序(因为用下来的源程序不能编译),在本机上测试还可以,只是CPU占用达到50%多点,己经很不错了.但是,放在2000服务器上用PC控制就不行,第一屏勉强能出来,后来就死了,服务器双核几乎死机,控制端则程序假死.
是否有改进了?

我一般下午會在線一段時間，因為近期工作比較忙，所以上的少，但如果看到你在線的話，還是會討論的。

to xxagri，盒子上的代碼是肯定可以編譯的，可能是你的配置不一樣造成的，我測試的時候一般CPU在30%左右。隔行的小變化在5%左右，變化越大，CPU占用也越大。

to xxagri
我也有点惧怕双核，这个对多线程要求要高很多。过几天我把程序完善一下发给你帮我测测。
不过的确有这种情况。有的机上ＣＰＵ占用比较低，有在有些机上，很高，配置都差不多的。暂不明白是什么原因。

其实我用的方法也是隔行扫描。用 GetDIBits 来得到一行的数据，这样相比较。上面说到的用 BitBlt 不太一样。但原理是一样的。

横行比较时，也是间隔着的。与guanyueguan,的方法原理上一样

QSmile，發個你的程序過來看看。

搞清楚了,是我2000服务器性能太高,传到PC上的数据控制端处理不过来,一查控制端CPU占用90%多,而服务端CPU仅占用30%多.导致服务端与控制端不同步.这么说要把控制端代码修改一下,但我确找不出在哪下手,请
[red]guanyueguan和QSmile[/red]帮忙加个工或者提示一下.我把代码贴上,要整个源代码请给个邮箱,我一并奉上.
unit Unit1;
{*******************************************}
{ 图片传输客户端程序 }
{ 作者:guanyueguan }
{*******************************************}

//unit Main;
interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ZLIBEX, WSocket, Buttons;

const
DEF_BUFFER = 4096;

type
TCapCmd = record
Cmd: Byte;
Size: Integer;
Width: Integer;
Height: Integer;
end;

PBaseCmd = ^TBaseCmd;
TBaseCmd = record
Cmd: Byte;
X, Y: Integer;
Button: TMouseButton;
end;

PRecCmd = ^TRecCmd;
TRecCmd = record
PakHead: Boolean;
StartTime: Cardinal;
FramCount: Cardinal;
Rate: Cardinal;
FramSize: Integer;
RecSize: Integer;
RecBuf: array[0..DEF_BUFFER - 1] of Char;
end;

TfrmMain = class(TForm)
//pnlA: TPanel;
sbA: TScrollBox;
pbA: TPaintBox;
lblA: TLabel;
wsA: TWSocket;
chkA: TCheckBox;
btnConnect: TSpeedButton;
btnDisconnect: TSpeedButton;
btnWin: TSpeedButton;
pnlA: TPanel;
procedure btnConnectClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure pbAPaint(Sender: TObject);
procedure btnDisconnectClick(Sender: TObject);
procedure wsASessionConnected(Sender: TObject; ErrCode: Word);
procedure wsASessionClosed(Sender: TObject; ErrCode: Word);
procedure wsADataAvailable(Sender: TObject; ErrCode: Word);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure btnWinClick(Sender: TObject);
procedure pbAMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure pbADblClick(Sender: TObject);
procedure pbAMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pbAMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
FScrBmp: Graphics.TBitmap;
FRecStream: TMemoryStream;
FScrStream: TMemoryStream;
FRecBmp: Graphics.TBitmap;
FCCmd: TCapCmd;
FRCmd: TRecCmd;
FCmd: TBaseCmd;
FScrCmd: TBaseCmd;
FCmdBuf: array[0..SizeOf(TCapCmd) - 1] of Char;
FRect: TRect;
FHost: string;
//
procedure ShowScr;
procedure ShowRate;
procedure SendCmd(ACmd: TBaseCmd);
public
end;

var
frmMain: TfrmMain;

implementation
{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
DoubleBuffered := True;
FScrBmp := Graphics.TBitmap.Create;
FRecBmp := Graphics.TBitmap.Create;
FRecStream := TMemoryStream.Create;
FScrStream := TMemoryStream.Create;
FScrCmd.Cmd := 0;
FHost := '192.168.0.1';
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FScrBmp.Free;
FRecBmp.Free;
FRecStream.Free;
FScrStream.Free;
wsA.Close;
end;

procedure TfrmMain.btnConnectClick(Sender: TObject);
begin
if InputQuery('Host', 'Please Input Host:', FHost) and (StrLen(PChar(FHost)) > 0) then
begin
try
wsA.Addr := FHost;
wsA.Port := '9009';
wsA.Connect;
except on e: Exception do
lbla.Caption := e.Message;
end;
end;
end;

procedure TfrmMain.btnDisconnectClick(Sender: TObject);
begin
wsA.Close;
FRecStream.Clear;
FScrStream.Clear;
btnConnect.Enabled := true;
btnDisconnect.Enabled := false;
end;

procedure TfrmMain.wsASessionConnected(Sender: TObject; ErrCode: Word);
begin
if ErrCode <> 0 then
begin
ShowMessage('Connect Error!');
btnConnect.Enabled := true;
btnDisconnect.Enabled := false;
end
else
begin
btnConnect.Enabled := false;
btnDisconnect.Enabled := true;
FRCmd.StartTime := GetTickCount;
FRCmd.FramCount := 0;
FRCmd.PakHead := true;
end;
end;

procedure TfrmMain.wsASessionClosed(Sender: TObject; ErrCode: Word);
begin
btnConnect.Enabled := True;
btnDisconnect.Enabled := False;
lblA.Caption := 'Connect Closed!';
end;

procedure TfrmMain.wsADataAvailable(Sender: TObject; ErrCode: Word);
var
nLen: Integer;
begin
try
if FRCmd.PakHead then
begin
nLen := wsA.Receive(@FCmdBuf[0], sizeof(TCapCmd));
if nLen = sizeof(TCapCmd) then
begin
Move(FCmdBuf[0], FCCmd, sizeof(TCapCmd));
if FCCmd.Cmd = 1 then
begin
FScrBmp.Width := FCCmd.Width;
FScrBmp.Height := FCCmd.Height;
FRCmd.PakHead := True;
end
else if FCCmd.Cmd = 2 then
begin
FRCmd.FramSize := FCCmd.Size;
FRCmd.RecSize := 0;
FRecStream.Clear;
FRecStream.SetSize(FRCmd.FramSize);
FRCmd.PakHead := False;
end;
end;
Exit;
end;
if FRCmd.FramSize <= 0 then
begin
ShowRate;
FRCmd.PakHead := True;
Exit;
end;
if FRCmd.FramSize - FRCmd.RecSize > DEF_BUFFER then
nLen := DEF_BUFFER
else
nLen := FRCmd.FramSize - FRCmd.RecSize;
nLen := wsA.Receive(@FRCmd.RecBuf[0], nLen);
if nLen > 0 then
begin
FRecStream.WriteBuffer(FRCmd.RecBuf, nLen);
Inc(FRCmd.RecSize, nLen);
if FRCmd.RecSize >= FRCmd.FramSize then
begin
FScrStream.Clear;
FRecStream.Position := 0;
ZDecompressStream(FRecStream, FScrStream);
//FScrStream.SaveToFile('1.bmp');
FScrStream.Position := 0;
try
while FScrStream.Position < FScrStream.Size do
begin
FScrStream.Read(FRect, sizeof(TRect));
FRecBmp.Width := FRect.right - FRect.left;
FRecBmp.Height := FRect.bottom - FRect.top;
FRecBmp.LoadFromStream(FScrStream);
BitBlt(FScrBmp.Canvas.Handle, FRect.left, FRect.top, FRecBmp.Width, FRecBmp.Height, FRecBmp.Canvas.Handle, 0, 0, SRCCOPY);
end;
ShowScr;
ShowRate;
except on e: Exception do
lblA.Caption := e.Message;
end;
FRCmd.FramSize := 0;
FRCmd.RecSize := 0;
FRCmd.PakHead := True;
end;
end;
except on e: Exception do
lblA.Caption := e.Message;
end;
end;

procedure TfrmMain.pbAPaint(Sender: TObject);
begin
ShowScr();
end;

procedure TfrmMain.ShowScr;
begin
if (pbA.Width <> FScrBmp.Width) or (pba.Height <> FScrBmp.Height) then
begin
pbA.Left := 0;
pbA.Top := 0;
pbA.Width := FScrBmp.Width;
pbA.Height := FScrBmp.Height;
ClientWidth := FScrBmp.Width;
ClientHeight := FScrBmp.Height + pnlA.Height;
end;
BitBlt(pbA.Canvas.Handle, 0, 0, FScrBmp.Width, FScrBmp.Height, FScrBmp.Canvas.Handle, 0, 0, SRCCOPY);
end;

procedure TfrmMain.ShowRate;
begin
Inc(FRCmd.FramCount);
FRCmd.Rate := FRCmd.FramCount * 1000 div (GetTickCount - FRCmd.StartTime);
lblA.Caption := IntToStr(FRCmd.FramCount) + '/' + IntToStr(FRCmd.Rate);
frmMain.Caption:=inttostr(FRecStream.Size);
end;

procedure TfrmMain.SendCmd(ACmd: TBaseCmd);
begin
if chkA.Checked and (wsA.State = wsConnected) then
wsA.Send(@ACmd, SizeOf(TBaseCmd));
end;

procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
FCmd.Cmd := 10;
FCmd.X := Key;
//FCmd.Y := Shift;
SendCmd(FCmd);
end;

procedure TfrmMain.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
FCmd.Cmd := 11;
FCmd.X := Key;
//FCmd.Y := Shift;
SendCmd(FCmd);
end;

procedure TfrmMain.btnWinClick(Sender: TObject);
begin
FCmd.Cmd := 8;
SendCmd(FCmd);
end;

procedure TfrmMain.pbAMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
FCmd.Cmd := 1;
FCmd.X := X;
FCmd.Y := Y;
SendCmd(FCmd);
end;

procedure TfrmMain.pbADblClick(Sender: TObject);
begin
if FCmd.Button = mbLeft then
FCmd.Cmd := 6
else
FCmd.Cmd := 7;
SendCmd(FCmd);
end;

procedure TfrmMain.pbAMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FCmd.Button := Button;
FCmd.X := X;
FCmd.Y := Y;
if FCmd.Button = mbLeft then
FCmd.Cmd := 2
else
FCmd.Cmd := 4;
SendCmd(FCmd);
end;

procedure TfrmMain.pbAMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FCmd.Button := Button;
FCmd.X := X;
FCmd.Y := Y;
if FCmd.Button = mbLeft then
FCmd.Cmd := 3
else
FCmd.Cmd := 5;
SendCmd(FCmd);
end;

end.

你降低服務端的偵數不就行了.

本机上测试没问题是因为用的同一个CPU.

to guanyueguan,
这几天比较忙，过两天我把程序再处理下给你发，现在样子太难看了点