150分求“每秒抓超过7次的整屏图像到文件中(仅80060016M色就可以了)”(50分)

jingtao · 2002-06-21

http://www.138soft.com/htm/broadcast.zip

xwings · 2002-06-21

jingTao 你好.

你的例子我看了.速度是不错. 可是客户端显示花屏现象严重. 不过这个好解决. 我对你的抓屏方式比较感兴趣.
因为感觉它速度比较快.CPU占用小.我估计可能用了分块. 不知道是不是用VNC的Hook Msg方式?还是直接bitblt DC ?
很想知道如何提高速度,可否简单介绍一下? 有必要的话可以把我的一些小研究和你讨论一下;[

]

pyh_jerry · 2002-06-21

硬盘文件估计可能是来不及的：）

jingtao · 2002-06-21

花屏是重新刷新没有处理好.
改变窗口大小即可改变此状况.
VNC的HOOK其实很大一部分代码是没有用处的.
至于CPU占用率,主要取决于压缩算法.
我对你的研究很感兴趣啊.具体是什么?

xwings · 2002-06-22

不谈压缩.就是讨论如何做到取屏幕数据的时候CPU占用率小. 不知道你是不是用了类似VNC的方法,
我发现你好像是用分块处理的. 每个子块内有变化的时候才抓取这个子块. 不过当变化区域比较多的时候
要抓的子块还是很多. 这样速度和CPU又不理想了. 你有没有试过800*600整屏或者400*300面积都变化时候抓取速度?
不考虑压缩.和存储.

我在研究如何用dx的硬件机能提高抓屏速度. 以及试验如何提高压缩率.

jingtao · 2002-06-22

涉及到压缩肯定占用CPU.
抓取屏幕的时候好像CPU不会怎么样吧?
我没压缩,只不过是简单用RLE处理了一下.
VNC的代码很累赘.它用以下方法:
1:把每个窗口作为一块.比如说有个窗口坐标为(90,80).然后移动到(30,60).那么只要发送
这个坐标即可.
2:比较变化区域.发送变化部分.
我朋友的这个程序http://www.sopeman.com/eos/就是这样来的.

很多多媒体教室是用MEDIAPLAY SDK来做的.只要创建一个输入和一个输出句柄即可.
这种东西讨论也没有什么用处.真正有这个技术的人他不可能拿出来跟你讨论的.
天下没有免费的午餐.那些做游戏的人在此方面才是高手啊.

xwings · 2002-06-22

呵呵,不知道你说的抓屏不占CPU是怎么回事?
我试验的结果是直接取大块的屏幕图象数据的时候CPU占用率是很高的.
我的方法不是仅仅blt 屏幕DC到Bitmap .而是开辟一个内存缓冲. 把屏幕数据copy进去.
你可以试试写一个程序抓取400*300 16bit的速度.一定要copy数据到内存中才算.
我的速度只有20-30帧,此时CPU占用有80%多.
不知道 JingTao有没有测试过.请不要吝惜,多多指点一下啦..

wql · 2002-07-08

继续发招阿 !

发一些有用的! 谢谢各位！

tl_lyq · 2002-07-25

一顿美餐。，。

liujinwu · 2002-07-25

xwings · 2002-07-26

JingTao 大侠怎么不说话了？讨论一点理论性的东西都不肯呀？ [

]

GGCAT · 2002-07-30

帮你up一下这拷贝的速度和硬件平台很有关系的
呵呵
所以你要按照最坏情况设计
另更正前面贴的程序中获取cursor的一段：
使用 attachthreadinput 很容易使鼠标的dblclick 失效
应该采用系统playback钩子来做

xwings · 2002-07-30

多谢GGCAT 请问如何用playback钩子..[

][

]

未来107 · 2002-08-06

to xwings
能不能将你的directx抓图例子发给我。
hlzee@163.com

xwings · 2002-08-06

帖子里有啊。你copy下去看看就可以了。

wql · 2002-08-29

go>>>

wql · 2002-09-26

tg:
可以把你的UDP传输部分贴出来看看吗?
或email: wqlem@km169.net

xwings · 2002-09-26

我写的UDP传输的代码比较乱.而且效果也不好.很多细节没有考虑到.
另外 to GGCAT. 鼠标hook如何做? 我直接attachthreadinput.的确会使双击失效.

jingtao有个方法可以较好的检测屏幕变化区域.但是他不肯单买这个技术给我

整个买又贵了点. 唉...

=====================UDP=========================
{-----------------------------------------------------------------------------
Unit Name: RTPTheadSend
Author: xwing
Purpose: 接受缓冲区内容,发送RTP数据包,一个线程负责生成RTP包. 一个线程负责发送
History:
-----------------------------------------------------------------------------}
unit RTPThreadSend;

interface
{-$DEFINE MMDEBUG}
uses
Windows, Messages, SysUtils, Classes, mmsystem, forms,math
, IdBaseComponent
, IdComponent
, IdUDPBase
, IdUDPClient
, MyBaseThread
, Framebuffer
, RTPBuffer
, AvgCalculator
, GlobalUnit
{$IFDEF MMDEBUG}
, MMdebug
{$ENDIF}

type
TRTPSender = class;
{------------------------------------------------------------------------------}
{分割Frame到RTP包线程}
TSplitThread = class(TMyBaseThread)
private
FInBuffer : TFrameBuffer;
FOutBuffer : TRTPBuffer;
FParentObj : TRTPSender;

FPFHdr : PScrFrameHeader;
FPRTPPak : PNetRTPHeader;
FOldTime : DWORD;
FDelayTime : Integer;
FRTPCount : Integer;
protected
FFrameCount : Integer;
FBlockCount : Integer;

procedure OnData(Sender: TObject);
procedure BeforeRun;override;
proceduredo
Run;
override;
procedure AfterRun;override;
procedure FrameToRTP;
public
constructor Create(InBuffer: TFrameBuffer;OutBuffer: TRTPBuffer);
end;

{------------------------------------------------------------------------------}
{发送RTP包线程}
TSendThread = class(TMyBaseThread)
private
FParentObj : TRTPSender;
FInBuffer : TRTPBuffer;
FPRTPHdr : PNetRTPHeader;
FGroupCount : Integer;
FOldTime : DWORD;
protected
FRTPCount : Integer;
FDelayTime : Integer;

procedure OnData(Sender: TObject);
procedure BeforeRun;
override;
proceduredo
Run;
override;
procedure AfterRun;
override;
procedure UnInit;override;
public
UDPObj : TIdUDPClient;
constructor Create(InBuffer: TRTPBuffer);
end;

{------------------------------------------------------------------------------}
TRTPSender = class
private
FActive : Boolean;
Fport : Integer;
{输出端口}
FHost : string;
{发送地址}
FRTPBufSize : Integer;
{RTP缓冲大小}

FSplitThread : TSplitThread;
FSendThread : TSendThread;
FRTPBuffer : TRTPBuffer;
{RTP包缓存}
FAvgDelay : TAvgCalculator;
{计算平均延时}

procedure SetHost(const Value: string);
procedure SetPort(const Value: Integer);
procedure SetRTPBufSize(const Value: Integer);
procedure WaitForRTPFlush;
{等待RTP发送完毕}

function GetRTPBufUse: Integer;
function GetFrameCount: Integer;
function GetRTPCount: Integer;
function GetBlockCount: Integer;
function GetDelay: Integer;

public
constructor Create(InBuffer: TFrameBuffer);
destructor Destroy;
override;

procedure Start;
procedure Stop;

property Active : Boolean read FActive;
property Host : string read FHost write SetHost;
property Port : Integer read Fport write SetPort;
property SendBufNum : Integer read FRTPBufSize Write SetRTPBufSize;
property RTPBufUse : Integer read GetRTPBufUse;

property FrameCount : Integer read GetFrameCount;
property BlockCount : Integer read GetBlockCount;
property RTPCount : Integer read GetRTPCount;
property DelayTime : Integer read GetDelay;
end;

implementation
////////////////////////////////////////////////////////////////////////////////
{ TRTPSender }
////////////////////////////////////////////////////////////////////////////////
constructor TRTPSender.Create(InBuffer: TFrameBuffer);
begin

{设置缓冲区}
FRTPBuffer:=TRTPBuffer.Create;
FRTPBufSize:=2500;
FRTPBuffer.SetBufferNum(FRTPBufSize);
{TODO FULL Wait 有问题. 要改进}
FAvgDelay:=TAvgCalculator.Create;
FAvgDelay.WindowSize:=10;
{设置线程}
FSplitThread:=TSplitThread.Create(InBuffer,FRTPBuffer);
FSplitThread.FParentObj:=Self;
FSendThread:=TSendThread.Create(FRTPBuffer);
FSendThread.FParentObj := Self;
FActive:=False;
SetHost('127.0.0.1');
SetPort(8000);
end;

{------------------------------------------------------------------------------}
destructor TRTPSender.Destroy;
begin

inherited;
FSplitThread.Stop;
FActive:=False;
FSplitThread.Terminate;
{等待RTP数据发送完毕}
WaitForRTPFlush;
FSendThread.Terminate;
FRTPBuffer.Free;
FAvgDelay.Free;
end;

////////////////////////////////////////////////////////////////////////////////
procedure TRTPSender.Start;
begin

if FActive then
Exit;
FSplitThread.FFrameCount:=0;
FSplitThread.FBlockCount:=0;
FSplitThread.Start;
FSendThread.FRTPCount:=0;
FSendThread.Pause;
FActive:=True;
end;

procedure TRTPSender.Stop;
begin

if not FActive then
Exit;
FSplitThread.Stop;
FActive:=False;
end;

////////////////////////////////////////////////////////////////////////////////
procedure TRTPSender.WaitForRTPFlush;
begin

Sleep(1000);
end;

////////////////////////////////////////////////////////////////////////////////
procedure TRTPSender.SetHost(const Value: string);
begin

if FActive then
Exit;
FHost:=Value;
FSendThread.UDPObj.Host:=FHost;
end;

{------------------------------------------------------------------------------}
procedure TRTPSender.SetPort(const Value: Integer);
begin

if FActive then
Exit;
Fport:=Value;
FSendThread.UDPObj.Port:=Fport;
end;

{------------------------------------------------------------------------------}
procedure TRTPSender.SetRTPBufSize(const Value: Integer);
begin

if not FActive then

begin

FRTPBufSize := Value;
FRTPBuffer.SetBufferNum(FRTPBufSize);
end;

end;

////////////////////////////////////////////////////////////////////////////////
function TRTPSender.GetRTPBufUse: Integer;
begin

Result:=FRTPBuffer.BufferUsage;
end;

{------------------------------------------------------------------------------}
function TRTPSender.GetFrameCount: Integer;
begin

Result:= FSplitThread.FFrameCount;
end;

{------------------------------------------------------------------------------}
function TRTPSender.GetRTPCount: Integer;
begin

Result:=FSendThread.FRTPCount;
end;

{------------------------------------------------------------------------------}
function TRTPSender.GetBlockCount: Integer;
begin

Result:=FSplitThread.FBlockCount;
end;

////////////////////////////////////////////////////////////////////////////////
{ TSplitThread }
////////////////////////////////////////////////////////////////////////////////
constructor TSplitThread.Create(InBuffer: TFrameBuffer;
OutBuffer: TRTPBuffer);
begin

inherited Create(True);
FInBuffer :=InBuffer;
FOutBuffer :=OutBuffer;
FOutBuffer.FullWait := True;
FInBuffer.OnData :=OnData;

end;

{------------------------------------------------------------------------------}
procedure TSplitThread.BeforeRun;
begin

end;

{------------------------------------------------------------------------------}
procedure TSplitThread.doRun;
begin

if FInBuffer.isEmpty then

begin

pause;
Exit;
end;

FOldTime := timeGetTime;
FRTPCount := 0;
FInBuffer.GetDataBuffer(FPFHdr);
Inc(FFrameCount);
FrameToRTP;
FInBuffer.ReleaseBuffer;
FDelayTime := (timeGetTime - FOldTime)*10 div (FRTPCount + 1);
FParentObj.FAvgDelay.AddItem(FDelayTime);
end;

{------------------------------------------------------------------------------}
procedure TSplitThread.AfterRun;
begin

if FState <> TSPaused then

begin

FOutBuffer.FlushBuffer
fparentobj.FAvgDelay.Reset;
end;

end;

{------------------------------------------------------------------------------}
procedure TSplitThread.OnData(Sender: TObject);
begin

if FState=TSPaused then
start;
end;

{------------------------------------------------------------------------------}
procedure TSplitThread.FrameToRTP;
var
i,j :Integer;
PacketCount :Integer;
FBlock

BlockHeader;
PData

ointer;
begin

try
{Frame内没有图象块}
if FPFHdr^.BlockNum = 0 then
Exit;
{计算第一个图象块的地址}
FBlock:=Pointer(Integer(FPFHdr)+SizeOf(TScrFrameHeader));
for i := 1 to FPFHdr^.BlockNum do

begin

Inc(FBlockCount);
Sleep(1);
{计算当前Block可分成的RTP包个数}
PacketCount := (FBlock^.BlockSize+RTP_PAK_SIZE-1) div RTP_PAK_SIZE;
{图象块大小为零}
if PacketCount = 0 then
Continue;
PData := FBlock;
{分包发送RTP数据}
for j:=1 to PacketCount-1do

begin

{写入RTP缓冲区}
FOutBuffer.AllocBuffer(FPRTPPak);
if FPRTPPak <> nil then

with FPRTPPak^do

begin

Byte0 := Lo(FPFHdr^.KeyFrame);
{关键帧标记}
FTC := FPFHdr^.TC;
{TC时间}
ImgBlkNum := i;
{图象块序号}
PakCount := PacketCount;
{当前块包含的包数量}
PakNum := j;
{当前包序号}
Move(pData^,data,RTP_PAK_SIZE);
{copy实际块数据}
Inc(Integer(PData),RTP_PAK_SIZE);
{移动数据指针}
Inc(FRTPCount);
end
else

foutbuffer.FlushBuffer;
FOutBuffer.RestoreBuffer;
end;

{处理当前块的最后一个RTP包}
FOutBuffer.AllocBuffer(FPRTPPak);
if FPRTPPak <> nil then

with FPRTPPak^do

begin

Byte0 := Lo(FPFHdr^.KeyFrame);
FTC := FPFHdr^.TC;
ImgBlkNum := i;
PakCount := PacketCount;
PakNum := PacketCount;
//j+1;
Move(pData^,data,FBlock^.BlockSize-dword((PacketCount-1)*RTP_PAK_SIZE));
Inc(FRTPCount);
end
else

foutbuffer.FlushBuffer;
FOutBuffer.RestoreBuffer;
{移动到下一个图象块}
FBlock:=Pointer(dword(FBlock) +FBlock^.BlockSize);
end;

except

end;

end;

////////////////////////////////////////////////////////////////////////////////
{ TSendThread }
////////////////////////////////////////////////////////////////////////////////
constructor TSendThread.Create(InBuffer: TRTPBuffer);
begin

inherited Create(True);
FInBuffer :=InBuffer;
FInBuffer.WaitHalf :=False;
FInBuffer.OnData :=OnData;
FDelayTime := 1;
UDPObj:=TIdUDPClient.Create(nil);
end;

{------------------------------------------------------------------------------}
procedure TSendThread.BeforeRun;
begin

UDPObj.Active:=True;
FGroupCount := 0;
FOldTime := timeGetTime
end;

{------------------------------------------------------------------------------}
procedure TSendThread.doRun;
begin

if FInBuffer.isEmpty then

begin

pause;
Exit;
end;

FInBuffer.GetDataBuffer(FPRTPHdr);
UDPObj.SendBuffer(FPRTPHdr^,SizeOf(TNetRTPHeader));
Inc(FRTPCount);
Inc(FGroupCount);
if FGroupCount >= 2 then

begin

FGroupCount:= 0;
{TODO 延时的计算要改进}
FDelayTime := FParentObj.FAvgDelay.AvgSize;
FDelayTime :=MinMax(2,FDelayTime-(timeGetTime - FOldTime),5);
Sleep(FDelayTime);
FOldTime := timeGetTime
end;

FInBuffer.ReleaseBuffer;
end;

{------------------------------------------------------------------------------}
procedure TSendThread.AfterRun;
begin

UDPObj.Active:=False;
end;

{------------------------------------------------------------------------------}
procedure TSendThread.UnInit;
begin

UDPObj.Free;
end;

{------------------------------------------------------------------------------}
procedure TSendThread.OnData(Sender: TObject);
begin

start;
end;

////////////////////////////////////////////////////////////////////////////////
function TRTPSender.GetDelay: Integer;
begin

Result :=FSendThread.FDelayTime;
end;

end.

=============================================================================
unit RTPThreadSink;

interface
{$DEFINE MMDebug}
uses
Windows, Messages, SysUtils, Classes, mmsystem
, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer, IdSocketHandle
, GlobalUnit,StaticFrame
, FrameBuffer
, RTPBuffer
, AvgCalculator
, MyBaseThread
{$IFDEF MMdebug}
, MMDebug
{$ENDIF}

type
TRTPSink = class;

{------------------------------------------------------------------------------}
TRTPCombThread = class(TMyBaseThread)
private
FParentObj : TRTPSink;
FInBuffer : TRTPBuffer;
FOutBuffer : TFrameBuffer;
{Pointer}
FPRTPPak : PNetRTPHeader;
{静态结构}
FSFrameList : array[0..1] of TScvFrameTree;
FCurFrameHdr: TScrFrameHeader;
FBakFrameHdr: TScrFrameHeader;
FCurFrame : Integer;
FBakFrame : Integer;
FRepCount : Integer;
protected
procedure OnData(Sender: TObject);
proceduredo
Run;
override;
procedure UnInit;
override;

procedure RTPToFrame(var PRTPPak

NetRTPHeader);
public
constructor Create(InBuffer: TRTPBuffer;
OutBuffer: TFrameBuffer);

end;

{------------------------------------------------------------------------------}
TRTPSink = class
private
FActive : Boolean;
FPRTPPak : PNetRTPHeader;
FRTPCount : DWORD;
FFrameCount : DWORD;

FRTPBuffer : TRTPBuffer;
FFrameBuffer: TFrameBuffer;
FUDPObj : TIdUDPServer;
FCombThread : TRTPCombThread;

proceduredo
UDPRead(Sender: TObject;
AData: TStream;
ABinding: TIdSocketHandle);
function GetPort: Integer;
procedure SetPort(const Value: Integer);

public
DropedBlk : DWORD;
DropedRTP : DWORD;

constructor Create(FOutBuffer:TframeBuffer);
destructor Destroy;
override;

procedure Start;
procedure Stop;

property Active : Boolean read FActive;
property FrameBuffer: TFrameBuffer read FFrameBuffer;
property RTPBuffer : TRTPBuffer read FRTPBuffer;
property FrameCount : DWORD read FFrameCount;
property RTPCount : DWORD read FRTPCount;
property Port : Integer read GetPort Write SetPort;
end;

implementation
////////////////////////////////////////////////////////////////////////////////
{ TRTPCombThread }
////////////////////////////////////////////////////////////////////////////////
constructor TRTPCombThread.Create(InBuffer: TRTPBuffer;
OutBuffer: TFrameBuffer);
begin

inherited Create;
FInBuffer := InBuffer;
FOutBuffer := OutBuffer;
FInBuffer.WaitHalf := False;
FInBuffer.OnData := OnData;
FCurFrame := 0;
FBakFrame := 1;
FRepCount := 0;
ZeroMemory(@FCurFrameHdr,SizeOf(TScrFrameHeader));
ZeroMemory(@FBakFrameHdr,SizeOf(TScrFrameHeader));
FSFrameList[0] :=TScvFrameTree.Create;
FSFrameList[1] :=TScvFrameTree.Create;
end;

////////////////////////////////////////////////////////////////////////////////
procedure TRTPCombThread.doRun;
begin

if FInBuffer.isEmpty then

begin

pause;
Exit;
end;

Sleep(4);
FInBuffer.GetDataBuffer(FPRTPPak);
RTPToFrame(FPRTPPak);
FInBuffer.ReleaseBuffer;
end;

{------------------------------------------------------------------------------}
procedure TRTPCombThread.UnInit;
begin

inherited;
FSFrameList[0].Free;
FSFrameList[1].Free;
end;

{------------------------------------------------------------------------------}
procedure TRTPCombThread.RTPToFrame(var PRTPPak: PNetRTPHeader);
var
i :Integer;
FPFHdr

ScrFrameHeader;
begin

if (CompareTC(FPRTPPak^.FTC,FCurFrameHdr.TC,0) = 0) and
(FPRTPPak^.Byte0 = FCurFrameHdr.KeyFrame) then

begin

{当前帧数据}
if FRepCount <> 0 then
FRepCount := 0;{乱序计数复位}
FSFrameList[FCurFrame].AddRTPPacket(PRTPPak);
end
else
{乱序的数据包}
if CompareTC(FPRTPPak^.FTC,FCurFrameHdr.TC,0) <> -1 then

begin

Inc(FRepCount);
FSFrameList[FBakFrame].AddRTPPacket(PRTPPak);
{输出数据}
{$IFDEF MMDEBUG}
// DB_WriteIntln(0,FRepCount);
// db_writestrln(0,TCtoStr(FPRTPPak^.FTC));
{$ENDIF}
if (FRepCount >= 4) then

begin

FOutBuffer.AllocBuffer(FPFHdr);
if FPFHdr <> nil then

FSFrameList[FCurFrame].MergeFrame(FPFhdr);
FOutBuffer.RestoreBuffer;
i:=FCurFrame;
FCurFrame :=FBakFrame;
FBakFrame := i;
FCurFrameHdr := FSFrameList[FCurFrame].FrameHdr;
FRepCount := 0;
end;

end
else
Inc(FParentObj.DropedRTP);
end;

////////////////////////////////////////////////////////////////////////////////
procedure TRTPCombThread.OnData(Sender: TObject);
begin

//if FState=TSPaused then
start;
start;
end;

////////////////////////////////////////////////////////////////////////////////
{ TRTPSink }
////////////////////////////////////////////////////////////////////////////////
constructor TRTPSink.Create(FOutBuffer:TframeBuffer);
begin

FActive := False;

FFrameBuffer := FOutBuffer;
FFrameBuffer.WaitHalf := False;
FFrameBuffer.FullWait :=False;

FRTPBuffer := TRTPBuffer.Create;
FRTPBuffer.WaitHalf :=False;
FRTPBuffer.SetBufferNum(2000);
FRTPBuffer.FullWait := False;

FUDPObj := TIdUDPServer.Create(nil);
FUDPObj.ThreadedEvent := True;
fudpobj.DefaultPort := 8001;
FUDPObj.OnUDPRead :=do
UDPRead;

FCombThread := TRTPCombThread.Create(FRTPBuffer,FFrameBuffer);
FCombThread.FParentObj := Self;
FCombThread.Pause;
end;

destructor TRTPSink.Destroy;
begin

inherited;
Stop;
FUDPObj.Active := False;
FUDPObj.Free;
FCombThread.Terminate;
FRTPBuffer.Free;
end;

////////////////////////////////////////////////////////////////////////////////
procedure TRTPSink.Start;
begin

FRTPCount := 0;
FFrameCount := 0;
FActive := True;
FUDPObj.Active := True;
end;

procedure TRTPSink.Stop;
begin

FUDPObj.Active := False;
FActive := False;
FrameBuffer.FlushBuffer;
end;

{------------------------------------------------------------------------------}
procedure TRTPSink.DoUDPRead(Sender: TObject;
AData: TStream;
ABinding: TIdSocketHandle);
begin

if not FActive then
Exit;
{TODO ,没有乱序和重包处理}
FRTPBuffer.AllocBuffer(FPRTPPak);
if FPRTPPak <> nil then

begin

adata.read(FPRTPPak^,SizeOf(TNetRTPHeader));
Inc(FRTPCount);
end
else
Inc(DropedRTP);
FRTPBuffer.RestoreBuffer;
end;

////////////////////////////////////////////////////////////////////////////////

function TRTPSink.GetPort: Integer;
begin

Result := FUDPObj.DefaultPort;
end;

procedure TRTPSink.SetPort(const Value: Integer);
begin

if FActive then
Exit;
FUDPObj.DefaultPort := Value;
end;

end.

============================================================================
{-----------------------------------------------------------------------------
Unit Name: StaticFrame
Author: xwing@263.net;MSN:xwing1979@hotmail.com
Purpose: 静态帧结构对象,用来进行RTP包的重组和解析
History:
-----------------------------------------------------------------------------}
{静态帧树状结构}
(*
FrameHdr
|----BlockHeader
| |---RTPData
| |---RTPData
| |---RTPData
| |---RTPData
|
|---BlockHeader
| |---RTPData
| |---RTPData
| |---RTPData
| |---RTPData
|
|--- .....
*)
unit StaticFrame;

interface

{$DEFINE MMDebug}
uses
Windows, Messages, SysUtils, Classes, mmsystem, globalunit
{$IFDEF MMdebug}
, MMdebug
{$ENDIF}

const
MAX_BLOCK_NUM = 250;
MAX_RTP_NUM = 8;

type
{数据结构}
TRTPData = array [0..RTP_PAK_SIZE - 1] of Char;
TScvBlockNode = record
RTPPakCount : Integer;
ReceivedCount : Integer;
case dType : Integer of
1 :
(BlockHdr : TBlockHeader);
2 :
(RTPData : array [0..MAX_RTP_NUM - 1] of TRTPData);
end;

TScvFrameTree = class
private
{输入的数据}
FFrameHdr : TScrFrameHeader;
{帧头信息}
FBlockList : array [0..MAX_BLOCK_NUM - 1] of TScvBlockNode;
FEnabled : Boolean;
FNewFrame : Boolean;
procedure InsertRTPPak(var PRTPPak: PNetRTPHeader);
public
constructor Create;
destructor Destroy;
override;
function AddRTPPacket(var PRTPPak: PNetRTPHeader) : Boolean;
procedure Clear;
procedure MergeFrame(var PFrame: PScrFrameHeader);
property FrameHdr : TScrFrameHeader read FFrameHdr;
end;

implementation

////////////////////////////////////////////////////////////////////////////////
{ TScvFrameTree }
////////////////////////////////////////////////////////////////////////////////
constructor TScvFrameTree.Create;
begin

FEnabled := True;
Clear;
end;

destructor TScvFrameTree.Destroy;
begin

FEnabled := False;
inherited;
end;

////////////////////////////////////////////////////////////////////////////////
function TScvFrameTree.AddRTPPacket(var PRTPPak: PNetRTPHeader) : Boolean;
begin

Result := False;
if not FEnabled then

Exit;
{新建一帧}
if FNewFrame then

begin

{设置参数}
FFrameHdr.TC := PRTPPak^.FTC;
FFrameHdr.KeyFrame := PRTPPak^.Byte0;
InsertRTPPak(PRTPPak);
FNewFrame := False;
end
else

InsertRTPPak(PRTPPak);
end;

{------------------------------------------------------------------------------}
procedure TScvFrameTree.InsertRTPPak(var PRTPPak: PNetRTPHeader);
var
BlockID : Integer;
RTPID : Integer;
begin

BlockID := PRTPPak^.ImgBlkNum-1;
RTPID := PRTPPak^.PakNum-1;
FBlockList[BlockID].RTPPakCount := PRTPPak^.PakCount;
Move(PRTPPak^.Data, FBlockList[BlockID].RTPData[RTPID], RTP_PAK_SIZE);
Inc(FBlockList[BlockID].ReceivedCount);
if FBlockList[BlockID].ReceivedCount > PRTPPak^.PakCount then

FBlockList[BlockID].ReceivedCount :=PRTPPak^.PakCount;
end;

{------------------------------------------------------------------------------}
procedure TScvFrameTree.Clear;
var
i : Integer;
begin

ZeroMemory(@FFrameHdr, SizeOf(TScrFrameHeader));
for i := 0 to MAX_BLOCK_NUM - 1do

begin

ZeroMemory(@(FBlockList), SizeOf(TBlockHeader) + SizeOf(Integer) * 3);
//ZeroMemory(@(FBlockList),SizeOf(TScvBlockNode));
end;

FNewFrame := True;
end;

{------------------------------------------------------------------------------}
procedure TScvFrameTree.MergeFrame(var PFrame: PScrFrameHeader);
var
i :Integer;
FPBlock ointer;
FFrameSize :Integer;
FBlockCount :Integer;
FDataSize :Integer;
FScreenInfo :Word;
begin

if FNewFrame or (not FEnabled) or (PFrame = nil) then

Exit;
try
FBlockCount :=0;
FDataSize := 0;
FScreenInfo := SCR_RES_NOT_SUPPORT;
FFrameSize := pframe^.FrameSize;
{首个Block地址}
FPBlock :=Pointer(Integer(PFrame)+SizeOf(TScrFrameHeader));
{遍历BlockTree}
for i := 0 to MAX_BLOCK_NUM -1do

begin

with FBlockListdo

begin

if (ReceivedCount <> 0) and (BlockHdr.BlockSize <> 0) then

begin

Inc(FBlockCount);
Inc(FDataSize,BlockHdr.BlockSize);
if FScreenInfo = SCR_RES_NOT_SUPPORT then

FScreenInfo:= BlockHdr.ScreenInfo;
Move(RTPData,FPBlock^,BlockHdr.BlockSize);
FPBlock:=Pointer(dword(FPBlock)+BlockHdr.BlockSize);
end;

end;

end;

{Move Hdr to FPrame}

with FFrameHdrdo

begin

FrameSize := FFrameSize;
DataSize := FDataSize;
ScreenInfo := FScreenInfo;
BlockNum := FBlockCount;
end;

Move(FFrameHdr,PFrame^,SizeOf(TScrFrameHeader));
{清空tree}
Clear;
except

end;

end;

end.

===============================================================================
{-----------------------------------------------------------------------------
Unit Name: FrameBuffer
Author: xwing
Purpose: 实现RTP数据包缓存
History:
-----------------------------------------------------------------------------}
unit RTPBuffer;

interface
{-$DEFINE MMDEBUG}
uses
Windows, Messages, SysUtils, Classes
, baseRingBuffer
, globalunit
{$IFDEF MMDEBUG}
, mmdebug
{$ENDIF}

type
TRTPBuffer = class(TBaseRingBuffer)
private
FRTPPak : PNetRTPHeader;

protected
proceduredo
ClearBuffer;
override;
proceduredo
FlushBuffer;
override;
proceduredo
FreeBuffer;
override;
proceduredo
PutP;
override;
proceduredo
GetP;
override;
proceduredo
GetInputP;
override;
proceduredo
InitBuffer;
override;

public
constructor Create;
override;
destructor Destroy;
override;

procedure GetDataBuffer(var RTPPak: PNetRTPHeader);
procedure ReleaseBuffer;

procedure AllocBuffer(var RTPPak: PNetRTPHeader);
procedure RestoreBuffer;

procedure SetBufferNum(BufferCount:Integer);

property ErrString;
property Enabled;
property isEmpty;
property isFull;
property BufferUsage;

property BufferNum;
property EmptyLoop;
property WaitHalf;

property OnEmpty;
property OnFull;
property OnData;

end;

implementation
////////////////////////////////////////////////////////////////////////////////
{ TRTPBuffer }
////////////////////////////////////////////////////////////////////////////////
constructor TRTPBuffer.Create;
begin

inherited create;
end;

{------------------------------------------------------------------------------}
destructor TRTPBuffer.Destroy;
begin

inherited;
end;

////////////////////////////////////////////////////////////////////////////////
procedure TRTPBuffer.AllocBuffer(var RTPPak: PNetRTPHeader);
begin

RTPPak := nil;
if not Enabled then
Exit;
GetInputP(Pointer(RTPPak));
end;

procedure TRTPBuffer.RestoreBuffer;
begin

if not Enabled then
Exit;
MovePutP;
end;

{------------------------------------------------------------------------------}
procedure TRTPBuffer.GetDataBuffer(var RTPPak: PNetRTPHeader);
begin

RTPPak := nil;
if not Enabled then
Exit;
GetP(Pointer(RTPPak));
end;

procedure TRTPBuffer.ReleaseBuffer;
begin

if not Enabled then
Exit;
MoveGetP;
end;

{------------------------------------------------------------------------------}
procedure TRTPBuffer.SetBufferNum(BufferCount: Integer);
begin

BufferNum:=BufferCount;
end;

////////////////////////////////////////////////////////////////////////////////
procedure TRTPBuffer.DoClearBuffer;
begin

inherited;
end;

procedure TRTPBuffer.DoFlushBuffer;
begin

inherited;
end;

procedure TRTPBuffer.DoInitBuffer;
var
i: Integer;
begin

SetLength(fpointerList,BufferNum);
for i := 0 to BufferNum - 1do

begin

FRTPPak := AllocMem(SizeOf(TNetRTPHeader));
FPointerList:=FRTPPak;
end;

end;

procedure TRTPBuffer.DoFreeBuffer;
var
i: Integer;
begin

if BufferNum = 0 then
Exit;
for i := 0 to BufferNum-1do

if FPointerList<>nil then

FreeMem(FPointerList,SizeOf(TNetRTPHeader));
SetLength(FPointerList,0);
FPointerList := nil;
end;

////////////////////////////////////////////////////////////////////////////////
procedure TRTPBuffer.DoGetInputP;
begin

inherited;
end;

procedure TRTPBuffer.DoGetP;
begin

inherited;
end;

procedure TRTPBuffer.DoPutP;
begin

inherited;
end;

end.

==============================================================================
{-----------------------------------------------------------------------------
Unit Name: FrameBuffer
Author: xwing
Purpose: 实现帧缓存
History:
-----------------------------------------------------------------------------}
unit FrameBuffer;

interface
{-$DEFINE MMDEBUG}
uses
Windows, Messages, SysUtils, Classes
, baseRingBuffer
, globalunit
{$IFDEF MMDEBUG}
, mmdebug
{$ENDIF}

type
TFrameBuffer = class(TBaseRingBuffer)
private
FPFrameHdr : PScrFrameHeader;
FBufferSize : Integer;

protected
proceduredo
ClearBuffer;
override;
proceduredo
FlushBuffer;
override;
proceduredo
FreeBuffer;
override;
proceduredo
PutP;
override;
proceduredo
GetP;
override;
proceduredo
GetInputP;
override;
proceduredo
InitBuffer;
override;

public
constructor Create;
override;
destructor Destroy;
override;

procedure GetDataBuffer(var PFHdr: PScrFrameHeader);
procedure ReleaseBuffer;

procedure AllocBuffer(var PFHdr: PScrFrameHeader);
procedure RestoreBuffer;

procedure SetBuffer(BufferSize,BufferCount:Integer);

property ErrString;
property Enabled;
property isEmpty;
property isFull;
property BufferUsage;

property BufferNum;
property EmptyLoop;
property WaitHalf;

property OnEmpty;
property OnFull;
property OnData;

end;

implementation
////////////////////////////////////////////////////////////////////////////////
{ TFrameBuffer }
////////////////////////////////////////////////////////////////////////////////
constructor TFrameBuffer.Create;
begin

inherited Create;
end;

{------------------------------------------------------------------------------}
destructor TFrameBuffer.Destroy;
begin

inherited;
end;

{------------------------------------------------------------------------------}
{Set Buffer After Create}
procedure TFrameBuffer.SetBuffer(BufferSize, BufferCount: Integer);
begin

FBufferSize:=BufferSize;
BufferNum:=BufferCount;

end;

////////////////////////////////////////////////////////////////////////////////
procedure TFrameBuffer.DoGetP;
begin

inherited;
end;

procedure TFrameBuffer.DoGetInputP;
begin

inherited;
end;

procedure TFrameBuffer.DoPutP;
begin

inherited;
end;

procedure TFrameBuffer.DoClearBuffer;
begin

end;

////////////////////////////////////////////////////////////////////////////////
procedure TFrameBuffer.DoFlushBuffer;
begin

inherited;
end;

procedure TFrameBuffer.DoFreeBuffer;
var
i: Integer;
begin

if BufferNum = 0 then
Exit;
for i := 0 to BufferNum-1do

if FPointerList<>nil then

FreeMem(FPointerList,FPFrameHdr^.FrameSize);
SetLength(FPointerList,0);
FPointerList := nil;
end;

////////////////////////////////////////////////////////////////////////////////
procedure TFrameBuffer.DoInitBuffer;
var
i: Integer;
begin

SetLength(fpointerList,BufferNum);
for i := 0 to BufferNum - 1do

begin

FPFrameHdr := AllocMem(FBufferSize);
FPFrameHdr^.FrameSize := FBufferSize;
FPointerList:=FPFrameHdr;
end;

end;

////////////////////////////////////////////////////////////////////////////////
procedure TFrameBuffer.GetDataBuffer(var PFHdr: PScrFrameHeader);
begin

PFHdr := nil;
if not Enabled then
Exit;
GetP(Pointer(PFHdr));
end;

procedure TFrameBuffer.ReleaseBuffer;
begin

if not Enabled then
Exit;
MoveGetP;
end;

{------------------------------------------------------------------------------}
procedure TFrameBuffer.AllocBuffer(var PFHdr: PScrFrameHeader);
begin

PFHdr := nil;
if not Enabled then
Exit;
GetInputP(Pointer(PFHdr));
end;

procedure TFrameBuffer.RestoreBuffer;
begin

if not Enabled then
Exit;
MovePutP;
end;

end.

==============================================================================
{-----------------------------------------------------------------------------
Unit Name: BaseRingBuffer
Author: xwing
Purpose: 缓冲数据
History: 环形缓冲区基础类.支持多线程读写
-----------------------------------------------------------------------------}
unit BaseRingBuffer;
interface
{-$DEFINE MMDEBUG}
uses
Windows, Messages, SysUtils, Classes,Dialogs, forms
{$IFDEF MMDEBUG}
, mmdebug
{$ENDIF};
Const
WM_BUFFER_EVENT = WM_USER + 201;
MSG_BUF_FULL = 1;
MSG_BUF_EMPTY = 2;
MSG_BUF_FILLDATA = 3;

type
EBufferException = class(Exception);
{异常处理}

TBaseRingBuffer = class(Tobject)
private
FWinHandle : HWND;
{处理消息的句柄}
FWaitFullHdl : THandle;
FHandle : THandle;

FPushIndex : Integer;
{下一个Push操作索引}
FGetIndex : Integer;
{下一个Get操作索引}
FLastGetIndex : Integer;
{最近的Get操作索引}
FGetBufFlag : Boolean;
{读写标志}
FPutBufFlag : Boolean;

FEnabled : Boolean;
{缓冲是否可用}
FEmptyLoop : Boolean;
{为空时是否返回最近一个数据}
FFullWait : Boolean;
{缓冲满的时候是否等待}
FEmpty : Boolean;
{缓冲区为空?}
FFull : Boolean;
{缓冲区已满?}
FWaitHalf : Boolean;
{输出触发方式}

FOnEmpty : TNotifyEvent;
{缓冲区为空的时候触发}
FOnFull : TNotifyEvent;
{缓冲区满的时候触发}
FOnData : TNotifyEvent;
{缓冲区填充数据时触发}
procedure WinCallBack(var Msg: TMessage);
function CalBufferUsage: Integer;
procedure SetBufferNum(Value: Integer);
function GetFull: boolean;

protected
FErrString : string;
{错误描述}
FPointerList : array of Pointer;
{缓冲区指针数组}
FBufferNum : Integer;
{缓冲个数}
FUsedBufNum : Integer;
{已经使用的缓冲数}

procedure PutP(var aPointer: Pointer);
{写入缓冲指针}
procedure GetP(var aPointer: Pointer);
{读取缓冲指针}
procedure GetInputP(var aPointer: Pointer);
{取得输入指针}
procedure MovePutP;
{移动输入指针}
procedure MoveGetP;
{移动输出指针}

proceduredo
ClearBuffer;
virtual;
proceduredo
FlushBuffer;virtual;
proceduredo
FreeBuffer;virtual;
proceduredo
PutP;
virtual;
proceduredo
GetP;
virtual;
proceduredo
GetInputP;
virtual;
proceduredo
InitBuffer;virtual;

public
constructor Create;
virtual;
destructor Destroy;
override;
procedure ClearBuffer;
{清空缓冲区}
procedure FlushBuffer;
{放空缓冲区}
procedure FreeBuffer;
{释放缓冲区}
procedure InitBuffer;
{初始化缓冲区}

property ErrString : string read FErrString;
property Enabled : Boolean read FEnabled;
property isEmpty : boolean read FEmpty;
property isFull : boolean read GetFull;
property BufferUsage: Integer read CalBufferUsage;

property BufferNum : Integer read FbufferNum write SetBufferNum;
property EmptyLoop : Boolean read FEmptyLoop write FEmptyLoop;
property FullWait : Boolean read FFullWait Write FFullWait;
property WaitHalf : boolean read FWaitHalf write FWaitHalf;

property OnEmpty : TNotifyEvent read FOnEmpty write FOnEmpty;
property OnFull : TNotifyEvent read FOnFull write FOnFull;
property OnData : TNotifyEvent read FOnData write FOnData;

end;

implementation
////////////////////////////////////////////////////////////////////////////////
{ TBaseRingBuffer }
////////////////////////////////////////////////////////////////////////////////
constructor TBaseRingBuffer.Create;
begin

FEnabled := False;
FEmptyLoop := False;
FFullWait := False;
FWaitHalf := False;
FBufferNum := 0;
FHandle := CreateEvent(nil, True, True, nil);
{设置为发信号状态}
FWaitFullHdl := CreateEvent(nil, True, True, nil);
FWinHandle := AllocateHWnd(WinCallBack);

end;

{------------------------------------------------------------------------------}
destructor TBaseRingBuffer.Destroy;
begin

{设置缓冲区不可读写}
FEnabled := False;
{延时等待读写线程结束,如果有的话}
Sleep(200);
CloseHandle(FHandle);
CloseHandle(FWaitFullHdl);
DeallocateHWnd(FWinHandle);
{释放内存}
FreeBuffer;
SetLength(FPointerList, 0);
FPointerList := nil;
end;

////////////////////////////////////////////////////////////////////////////////
//缓冲区读写操作
////////////////////////////////////////////////////////////////////////////////
procedure TBaseRingBuffer.GetP(var aPointer: Pointer);
begin

WaitForSingleObject(FHandle, INFINITE);
{等待其他操作完毕}
ResetEvent(FHandle);
{设置为不发信号状态}
try
if not (FEmpty) then
{缓冲区不为空}
begin

FGetBufFlag := True;
aPointer := FPointerList[FGetIndex];
do
GetP;
end
else
if (FEmptyLoop) and (FLastGetIndex<>-1) then
{缓冲区为空,但是有数据}
begin

FGetBufFlag:=True;
aPointer := FPointerList[FLastGetIndex];
do
GetP;
end;

finally
SetEvent(FHandle);
end;

end;

{------------------------------------------------------------------------------}
procedure TBaseRingBuffer.MoveGetP;
begin

if not FGetBufFlag then
Exit;
WaitForSingleObject(FHandle, INFINITE);
{等待其他操作完毕}
ResetEvent(FHandle);
try
if not (FEmpty) then
{缓冲区不为空}
begin

{移动读写指针}
if FGetIndex = FPushIndex then

begin

FFull := False;
SetEvent(FWaitFullHdl);
end;

FLastGetIndex := FGetIndex;
Inc(FGetIndex);
{减少使用计数}
Dec(FUsedBufNum);
if FGetIndex = FBufferNum then
FGetIndex := 0;
if FGetIndex = FPushIndex then

begin

FEmpty := True;
PostMessage(FWinHandle,WM_BUFFER_EVENT,MSG_BUF_EMPTY,0);
end;

end;

finally
FGetBufFlag:=False;
SetEvent(FHandle);
end;

end;

{------------------------------------------------------------------------------}
procedure TBaseRingBuffer.PutP(var aPointer: Pointer);
begin

if aPointer = nil then
Exit;
WaitForSingleObject(FHandle, INFINITE);
{等待其他操作完毕}
try
if FFullWait then

WaitForSingleObject(FWaitFullHdl,INFINITE);
if not (FFull) then

begin

ResetEvent(FHandle);
FPutBufFlag:=True;
FPointerList[FPushIndex] := aPointer;
do
PutP;
end;

finally
SetEvent(FHandle);
end;

{$IFDEF MMDEBUG}
DB_WriteStrLn(5,'PutPEnd');
{$ENDIF}
end;

{------------------------------------------------------------------------------}
procedure TBaseRingBuffer.GetInputP(var aPointer: Pointer);
begin

WaitForSingleObject(FHandle, INFINITE);
{等待其他操作完毕}
try
if FFullWait then

begin

WaitForSingleObject(FWaitFullHdl,INFINITE);
end;

if not (FFull) then

begin

ResetEvent(FHandle);
FPutBufFlag:=True;
aPointer := FPointerList[FPushIndex];
do
GetInputP;
end;

finally
SetEvent(FHandle);
end;

end;

{------------------------------------------------------------------------------}
procedure TBaseRingBuffer.MovePutP;
begin

if not FPutBufFlag then
Exit;
WaitForSingleObject(FHandle, INFINITE);
{等待其他操作完毕}
ResetEvent(FHandle);
try
if not (FFull) then

begin

{移动读写指针}
if FPushIndex = FGetIndex then

begin

FEmpty := False;
end;

Inc(FPushIndex);
{增加使用计数}
Inc(FUsedBufNum);
if FPushIndex = FBufferNum then
FPushIndex := 0;
{触发OnFull事件}
if FPushIndex = FGetIndex then

begin

FFull := True;
ResetEvent(FWaitFullHdl);
PostMessage(FWinHandle,WM_BUFFER_EVENT,MSG_BUF_FULL,0);
end;

{触发OnData事件}
if Assigned(FOnData) then

begin

if FWaitHalf then

begin

if FUsedBufNum>=FBufferNum div 2 then

PostMessage(FWinHandle,WM_BUFFER_EVENT,MSG_BUF_FILLDATA,0);
end
else
;
PostMessage(FWinHandle,WM_BUFFER_EVENT,MSG_BUF_FILLDATA,0);
end;

end;

finally
FPutBufFlag:=False;
SetEvent(FHandle);
end;

end;

////////////////////////////////////////////////////////////////////////////////
procedure TBaseRingBuffer.InitBuffer;
begin

WaitForSingleObject(FHandle, INFINITE);
ResetEvent(FHandle);
try
do
InitBuffer;

FEmpty := True;
FFull := False;
FGetBufFlag := False;
FPutBufFlag := False;
FUsedBufNum := 0;
FPushIndex := 0;
FGetIndex := 0;
FLastGetIndex := -1;
finally
SetEvent(FHandle);
FEnabled:=True;
end;

end;

{------------------------------------------------------------------------------}
procedure TBaseRingBuffer.ClearBuffer;
begin

WaitForSingleObject(FHandle, INFINITE);
ResetEvent(FHandle);
try
do
ClearBuffer;

FEmpty := True;
FFull := False;
FGetBufFlag := False;
FPutBufFlag := False;
FUsedBufNum := 0;
FPushIndex := 0;
FGetIndex := 0;
FLastGetIndex := -1;
finally
SetEvent(FHandle);
end;

end;

{------------------------------------------------------------------------------}
procedure TBaseRingBuffer.FlushBuffer;
begin

do
FlushBuffer;

if FUsedBufNum>0 then

if Assigned(FOnData) then
FOnData(Self);
end;

{------------------------------------------------------------------------------}
procedure TBaseRingBuffer.FreeBuffer;
begin

do
FreeBuffer;

FEmpty := True;
FFull := False;
FGetBufFlag := False;
FPutBufFlag := False;
FUsedBufNum := 0;
FPushIndex := 0;
FGetIndex := 0;
FLastGetIndex := -1;
end;

////////////////////////////////////////////////////////////////////////////////
function TBaseRingBuffer.CalBufferUsage: Integer;
begin

Result:=FUsedBufNum *100 div FBufferNum
end;

{------------------------------------------------------------------------------}
procedure TBaseRingBuffer.SetBufferNum(Value: Integer);
begin

try
FreeBuffer;
FBufferNum := Value;
InitBuffer;
except
raise EBufferException.Create('Set Buffer Num Error!');
end;

end;

////////////////////////////////////////////////////////////////////////////////
procedure TBaseRingBuffer.DoClearBuffer;
begin

end;

procedure TBaseRingBuffer.DoGetInputP;
begin

end;

procedure TBaseRingBuffer.DoGetP;
begin

end;

procedure TBaseRingBuffer.DoPutP;
begin

end;

procedure TBaseRingBuffer.DoFlushBuffer;
begin

end;

procedure TBaseRingBuffer.DoFreeBuffer;
begin

end;

procedure TBaseRingBuffer.DoInitBuffer;
begin

end;

////////////////////////////////////////////////////////////////////////////////
function TBaseRingBuffer.GetFull: boolean;
begin

Result := FFull;
if Result and Assigned(fOnData) then

PostMessage(FWinHandle,WM_BUFFER_EVENT,MSG_BUF_FULL,0);
end;

procedure TBaseRingBuffer.WinCallBack(var Msg: TMessage);
begin

if Msg.Msg <> WM_BUFFER_EVENT then
Exit;
case Msg.wParam of
MSG_BUF_FULL :if Assigned(FOnFull) then
FOnFull(Self);
MSG_BUF_EMPTY :if Assigned(Fonempty) then
FOnEmpty(Self);
MSG_BUF_FILLDATA:if Assigned(fonData) then
FOnData(Self);
end;

end;

end.

=================================================================================
{-----------------------------------------------------------------------------
Unit Name: GlobalUnit
Author: xwing
Purpose: 全局的变量和处理函数
History: 2002.8.5
-----------------------------------------------------------------------------}
unit globalunit;

interface

uses
Windows, Messages, SysUtils, Graphics, Forms, Dialogs, fastdib, inifiles, mmsystem,
strcon, math;

const
FRAME_BUF_SIZE = 300*1024;//300K
BLOCK_WIDTH = 60;
{用于压缩块的大小}
BLOCK_HEIGHT = 60;
DEF_EXP_FPS = 5;
{默认的捕获速度FPS}
DEF_MKEY_DISTANCE = 1;
//10 {间隔多少副关键帧有一个主关键帧}
DEF_SKEY_DISTANCE = 4;
//4 {副关键帧距离:秒}
USE_SKEY = false;
{关键帧类型}
TKEY_NOKEY = $0000;
{非关键帧}
TKEY_MAIN_KEY = $0001;
{主关键帧}
TKEY_SUB_KEY = $0002;
{副关键帧}
{图象编码类型}
TENCTYPE_NONE = $0000;
TENCTYPE_LZW = $0001;
TENCTYPE_JPG = $0002;
{屏幕属性}
SCR_RES_NOT_SUPPORT = $00;
SCR_RES_640x480 = $01;
SCR_RES_800x600 = $02;
SCR_RES_1024x768 = $03;
{RTP包数据大小}
RTP_PAK_SIZE = 1000;

{文件头标识}
SCM_HEAD = $46534353
{SCSF}
SCM_FRAME = $41544144
{DATA}
SCM_INDX = $58444E49
{INDX}
SCM_UNKNOWN = $FFFFFFFF

type
{存储区域变化矩阵}
TUpdateMatrix = array [0..300, 0..300] of Integer;
TTimeCode = packed record {TimeCode结构}
Ff : Byte;
{帧}
Ss : Byte;
{秒}
Mm : Byte;
{分钟}
Hh : Byte;
{小时}
end;

(*
屏幕帧的结构.(采用线性内存模式便于通过网络传输和重组)
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| FrameHeader |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| +------+ +------+ +------+ |
| |Block | |Block | |Block | |
| | | | | | | 数据区 |
| +------+ +------+ +------+ ... |
+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+
*)
PScrFrameHeader = ^ TScrFrameHeader;
TScrFrameHeader = packed record {数据帧头结构}
FrameSize : DWORD;
{帧缓存大小}
DataSize : DWORD;
{实际图象数据大小}
FrameID : DWORD;
{ID号.递增不重复}
TC : TTimeCode;
{当前帧TC时间}
ScreenInfo : Word;
{屏幕信息}
KeyFrame : Word;
{关键帧标记}
BlockNum : DWORD;
{图象块总数}
end;

{图象块结构}
PBlockHeader = ^ TBlockHeader;
TBlockHeader = packed record
BlockSize : DWORD;
{数据区大小}
Lx, ly, rx, ry : Word;
{块区域大小}
EncType : Word;
{编码类型}
KeyFrame : Word;
{关键帧类型}
ScreenInfo : Word;
{屏幕信息}
end;

{RTP数据包结构}
(*
0 1 2 3
0 1 2 3 4 5 6 7 0 1 2 3 4 5 6 7 0 1 2 3 4 5 6 7 0 1 2 3 4 5 6 7
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| |K K| 图象块序号 | 包序号 |图象块中包总数 |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| 时间戳 hh:mm:ss.ff |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| |
| 数据区 () |
| ... |
+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+
*)
PNetRTPHeader = ^ TNetRTPHeader;
TNetRTPHeader = packed record
Byte0 : Byte;
{bit6,7:00:非关键帧;01:主关键帧;10:副关键帧}
ImgBlkNum : Byte;
PakNum : Byte;
PakCount : Byte;
FTC : TTimeCode;
Data : array [0..RTP_PAK_SIZE - 1] of Char;
end;

{文件头部信息}
PScFileHeader = ^TScFileHeader;
TScFileHeader = packed record
FOURCC : DWORD;
{文件标志}
IDXOffset : DWORD;
{索引偏移地址 $FFFFFFFF:表示未知}
DatOffset : DWORD;
{数据开始偏移}
Length : TTimeCode;
{视频长度 $FFFFFFFF:表示未知}
FrameCount : DWORD;
{总帧数 $FFFFFFFF:表示未知}
FPS : Integer;
{帧速率 DEF 3 }
end;

{帧头信息}
PScFileFrameHeader = ^TScFileFrameHeader;
TScFileFrameHeader = packed record
FOURCC : DWORD;
{头标志}
NextFrame : DWORD;
{下一帧位置 $FFFFFFFF:表示未知}
FrameHdr : TScrFrameHeader;
{帧头部信息}
end;

{索引结构}
PScFileIndex = ^TScFileIndex;
TScFileIndex = packed record
FOURCC : DWORD;
{头标志}
TC : TTimecode;
{帧时间}
FrameID : DWORD;
{帧序号}
FrameType : Word;
{帧类型}
FrameOffset : DWORD;
{帧偏移量}
end;

{------------------------------------------------------------------------------}
{TC和ms转换}
function mSecToTC(mSecTime: DWORD;
FPS: Integer = DEF_EXP_FPS) : TTimeCode;

function TCTomSec(aTC: TTimeCode;
FPS: Integer = DEF_EXP_FPS) : DWORD;

{TCToStr hh:mm:ss:ff}
function TCtoStr(aTC: TTimeCode) : string;

function StrToTC(const aStr: string) : TTimeCode;

{比较两个TC大小}
function CompareTC(aTC, bTC: TTimeCode;
Ff: Integer = 0) : Integer;
overload;

function CompareTC(aTC, bTC, cTC: TTimeCode) : Integer;
overload;

{求两个TC的时间差}
function SubTC(aTC, bTC: TTimeCode;
FPS: Integer = DEF_EXP_FPS) : Integer;
function AddTC(aTC, bTC: TTimeCode;
FPS: Integer = DEF_EXP_FPS) : Integer;
{除法求商和余数}
procedure DivMod(Dividend: Integer;
Divisor: Word;
var Result, Remainder: Word);

{得到图象实际占用的字节宽度,当图象宽度*BPP<>4字节的整倍数的时候要使用实际字节宽度}
function GetByteWidth(Width: Integer;
ColorDepth: Integer) : Integer;

function GetPadWidth(Width: Integer;
ColorDepth: Integer) : Integer;

{调整Rect大小,防止越界}
procedure AdjustRect(var aRect: TRect;
MaxX, MaxY: Integer);

{根据颜色深度返回BPP(Byte Per Pixel)每象素占字节数}
function GetBBPSize(ColorDepth: Integer) : Integer;

function MinMax(MinVal, X, MaxVal: Integer) : Integer;

{设置FastDIB位图格式}
procedure SetFastDIBSize(bmp: TFastDIB;
aW, aH, ColDepth: Integer);

{拷贝指定区域到位图}
procedure CopyRectToDIB(Dst, Src: TFastDIB;
xSrc, ySrc, wSrc, hSrc: Integer);

procedure CopyDIBToRect(Dst, Src: TFastDIB;
xDst, yDst, wDst, hDst: Integer);

{延时函数}
procedure Delay(m:Cardinal);

{返回临时目录}
function GetTmpDir: string;
{返回临时文件名}
function FileGetTempName(const Prefix: string): string;
implementation

////////////////////////////////////////////////////////////////////////////////
function GetByteWidth(Width: Integer;
ColorDepth: Integer) : Integer;
var
X,
BWidth : Integer;
begin

BWidth := 0;
case ColorDepth of
1:
begin

X := (Width + 7) and -8;
BWidth := ((X + 31) and -32) shr 3;
end;

4:
begin

X := ((Width shl 2) + 7) and -8;
BWidth := ((X + 31) and -32) shr 3;
end;

8: BWidth := (((Width shl 3) + 31) and -32) shr 3;
15 ,
16: BWidth := (((Width shl 4) + 31) and -32) shr 3;
24: BWidth := (((Width * 24) + 31) and -32) shr 3;
32: BWidth := (((Width shl 5) + 31) and -32) shr 3;
end;

Result := BWidth;
end;

{------------------------------------------------------------------------------}
function GetPadWidth(Width: Integer;
ColorDepth: Integer) : Integer;
var
X,
BWidth,
Gap : Integer;
{Gap:每行图象最后的空白大小}
begin

Gap := 0;
case ColorDepth of
1:
begin

X := (Width + 7) and -8;
BWidth := ((X + 31) and -32) shr 3;
Gap := BWidth - (X shr 3);
end;

4:
begin

X := ((Width shl 2) + 7) and -8;
BWidth := ((X + 31) and -32) shr 3;
Gap := BWidth - (X shr 3);
end;

8:
begin

BWidth := (((Width shl 3) + 31) and -32) shr 3;
Gap := BWidth - Width;
end;

15 ,
16:
begin

BWidth := (((Width shl 4) + 31) and -32) shr 3;
Gap := BWidth - (Width shl 1);
end;

24:
begin

BWidth := (((Width * 24) + 31) and -32) shr 3;
Gap := BWidth - ((Width shl 1) + Width);
end;

32:
// BWidth := (((Width shl 5) + 31) and -32) shr 3;
Gap := 0;
end;

Result := Gap;
end;

////////////////////////////////////////////////////////////////////////////////
procedure AdjustRect(var aRect: TRect;
MaxX, MaxY: Integer);
begin

with aRectdo

begin

if Left < 0 then

Left := 0;
if Top < 0 then

Top := 0;
if Right < 0 then

Right := 0;
if Bottom < 0 then

Bottom := 0;
if Right > MaxX then

Right := MaxX;
if Bottom > MaxY then

Bottom := MaxY;
if Left > Right then

Left := Right;
if Top > Bottom then

Top := Bottom;
end;

end;

////////////////////////////////////////////////////////////////////////////////
function GetBBPSize(ColorDepth: Integer) : Integer;
begin

case ColorDepth of
8: Result := 1;
15 ,
16: Result := 2;
24: Result := 3;
32: Result := 4;
else
Result := 0;
end;

end;

////////////////////////////////////////////////////////////////////////////////
procedure DivMod(Dividend: Integer;
Divisor: Word;
var Result, Remainder: Word);
asm

PUSH EBX
MOV EBX,EDX
MOV EDX,EAX
SHR EDX,16
DIV BX
MOV EBX,Remainder
MOV [ECX],AX
MOV [EBX],DX
POP EBX
end;

////////////////////////////////////////////////////////////////////////////////
(*Procedure: CompareTC
Arguments: aTC,bTC,fTC:TTimeCode (fTC为比较阀值)
Result : Integer =0:相同
<0:aTC<bTC
>0:aTC>bTC
Puropse : 比较两个TC时戳的异同*)
////////////////////////////////////////////////////////////////////////////////
function CompareTC(aTC, bTC: TTimeCode;
Ff: Integer = 0) : Integer;
overload;
begin

if Abs(Integer(aTC) - Integer(bTC)) <= Abs(Integer(Ff)) then

Result := 0
else

if Integer(aTC) > Integer(bTC) then

Result := 1
else

Result := -1;
end;

{------------------------------------------------------------------------------}
function CompareTC(aTC, bTC, cTC: TTimeCode) : Integer;
overload;
begin

if Abs(Integer(aTC) - Integer(bTC)) <= Integer(cTC) then

Result := 0
else

if Integer(aTC) > Integer(bTC) then

Result := 1
else

Result := -1;
end;

////////////////////////////////////////////////////////////////////////////////
function TCtoStr(aTC: TTimeCode) : string;
begin

with aTCdo

Result := Format('%.2d:%.2d:%.2d.%.2d', [Hh, Mm, Ss, Ff]);
end;

{------------------------------------------------------------------------------}
function StrToTC(const aStr: string) : TTimeCode;
var
tmpS : string;
begin

tmpS := aStr;
with Resultdo

begin

Hh := StrToIntDef(sc.parse(':', tmpS), 99);
Mm := StrToIntDef(sc.parse(':', tmpS), 99);
Ss := StrToIntDef(sc.Del(':', sc.before('.', tmpS)), 99);
Ff := StrToIntDef(sc.After('.', tmpS), 99);
end;

end;

////////////////////////////////////////////////////////////////////////////////
function mSecToTC(mSecTime: DWORD;
FPS: Integer = DEF_EXP_FPS) : TTimeCode;
var
MinCount,
MSecCount,
msec,
h,
m,
s : Word;
begin

with Resultdo

begin

DivMod(mSecTime, 60000, MinCount, MSecCount);
DivMod(MinCount, 60, h, m);
DivMod(MSecCount, 1000, s, msec);
Ff := msec * FPS div 1000;
Hh := h;
Mm := m;
Ss := s;
end;

end;

{------------------------------------------------------------------------------}
function TCTomSec(aTC: TTimeCode;
FPS: Integer = DEF_EXP_FPS) : DWORD;
begin

with aTCdo

Result := Hh * 60 * 60 * 1000 + Mm * 60 * 1000 + Ss * 1000 + (1000 div FPS) * Ff;
end;

{------------------------------------------------------------------------------}
function SubTC(aTC, bTC: TTimeCode;
FPS: Integer = DEF_EXP_FPS) : Integer;
begin

case CompareTC(aTC, bTC, 0) of
1 ,
-1: Result := TCTomSec(aTC,FPS) - TCTomSec(bTC,FPS);
0: Result := 0;
end;

end;

{------------------------------------------------------------------------------}
function AddTC(aTC, bTC: TTimeCode;
FPS: Integer = DEF_EXP_FPS) : Integer;
begin

Result := TCTomSec(aTC) + TCTomSec(bTC);
end;

{------------------------------------------------------------------------------}
function MinMax(MinVal, X, MaxVal: Integer) : Integer;
begin

Result := X;
if X < MinVal then

Result := MinVal
else

if X > MaxVal then

Result := MaxVal;
end;

{------------------------------------------------------------------------------}
procedure SetFastDIBSize(bmp: TFastDIB;
aW, aH, ColDepth: Integer);
begin

case ColDepth of
15: bmp.SetSizeEx(aW, aH, 16, 5, 5, 5);
16: bmp.SetSizeEx(aW, aH, 16, 5, 6, 5);
24 ,
32: bmp.SetSize(aW, aH, ColDepth);
end;

bmp.Clear(tfBlack);
end;

{------------------------------------------------------------------------------}
{拷贝指定区域到位图,拷贝区域不可大于目标位图}
procedure CopyRectToDIB(Dst, Src: TFastDIB;
xSrc, ySrc, wSrc, hSrc: Integer);
var
y : Integer;
Bottom,
Right,
LineLen : Integer;
pS,
PD : DWORD;
Bpp : Integer;
DstYpad,
DstXPad : Integer;
begin

Bottom := min(Src.AbsHeight, ySrc + hSrc);
Right := min(Src.Width, xSrc + wSrc);
Bpp := (Src.Bpp + 7) shr 3;
LineLen := (Right - xSrc) * Bpp;
pS := Integer(Src.Scanlines[0]) + (Src.AbsHeight - Bottom) * Src.BWidth + xSrc * Bpp;
DstYpad := Dst.AbsHeight + ySrc - Bottom;
if DstYpad < 0 then

DstYpad := 0;
DstXPad := Dst.Width - Right;
if DstXPad < 0 then

DstXPad := 0;
PD := Integer(Dst.Scanlines[0]) + (DstYpad) * Dst.BWidth + DstXPad * Bpp;
for y := ySrc to Bottom - 1do

begin

Move(ptr(pS)^, ptr(PD)^, LineLen);
Inc(pS, Src.BWidth);
Inc(PD, Dst.BWidth);
end;

end;

{------------------------------------------------------------------------------}
{拷贝位图到指定区域}
procedure CopyDIBToRect(Dst, Src: TFastDIB;
xDst, yDst, wDst, hDst: Integer);
var
y : Integer;
Bottom,
Right,
LineLen : Integer;
pS,
PD : DWORD;
Bpp : Integer;
Ypad,
XPad : Integer;
begin

Bottom := min(Dst.AbsHeight, yDst + min(Src.AbsHeight, hDst));

Right := min(Dst.Width, xDst + min(Src.Width, wDst));

Bpp := (Src.Bpp + 7) shr 3;

LineLen := (Right - xDst) * Bpp;

Ypad := Src.AbsHeight + yDst - Bottom;
if Ypad < 0 then

Ypad := 0;

XPad := Src.Width - Right;

if XPad < 0 then

XPad := 0;

pS := Integer(Src.Scanlines[0]) + (Ypad) * Src.BWidth + XPad * Bpp;

PD := Integer(Dst.Scanlines[0]) + (Dst.AbsHeight - Bottom) * Dst.BWidth + xDst * Bpp;

for y := yDst to Bottom - 1do

begin

Move(ptr(pS)^, ptr(PD)^, LineLen);

Inc(pS, Src.BWidth);

Inc(PD, Dst.BWidth);

end;

end;

{------------------------------------------------------------------------------}
procedure Delay(m:Cardinal);
var
tick : Cardinal;
begin

tick := TimeGetTime;
while TimeGetTime - tick < mdo

begin

Application.ProcessMessages;
Sleep(2);
end;

end;

{------------------------------------------------------------------------------}
function GetTmpDir: String;
var
TempDir : array[0..255] of Char;
begin

GetTempPath(255, @TempDir);
Result := StrPas(TempDir);
end;

{------------------------------------------------------------------------------}
function FileGetTempName(const Prefix: string): string;
var
TempPath, TempFile: string;
R: Cardinal;
begin

Result := '';
R := GetTempPath(0, nil);
SetLength(TempPath, R);
R := GetTempPath(R, PChar(TempPath));
if R <> 0 then

begin

SetLength(TempPath, StrLen(PChar(TempPath)));
SetLength(TempFile, MAX_PATH);
R := GetTempFileName(PChar(TempPath), PChar(Prefix), 0, PChar(TempFile));
if R <> 0 then

begin

SetLength(TempFile, StrLen(PChar(TempFile)));
Result := TempFile;
end;

end;

end;

end.

============================================================================
unit MyBaseThread;

interface
{-$DEFINE MMDEBUG}
uses
windows, Classes ,syncobjs
{$IFDEF MMDEBUG}
, mmdebug
{$ENDIF}

type
TThreadState = (TSRuning,TSPaused,TSStoped,TSTerminated);
TMyBaseThread = class(TThread)
protected
FState : TThreadState;
fEvent : TEvent;
procedure Execute;
override;
proceduredo
Run;
virtual;
procedure AfterRun;
virtual;
procedure BeforeRun;
virtual;
procedure UnInit;virtual;

public
constructor Create(ACreateSuspended: Boolean = True);
virtual;
destructor Destroy;
override;

procedure Start;
procedure Stop;
procedure Pause;
procedure Terminate;

procedure Sync(Method: TThreadMethod);

property State :TThreadState read FState;
end;

implementation
////////////////////////////////////////////////////////////////////////////////
{ TMyBaseThread }
////////////////////////////////////////////////////////////////////////////////
constructor TMyBaseThread.Create(ACreateSuspended: Boolean);
begin

inherited Create(False);

FreeOnTerminate:=True;
if ACreateSuspended then

begin

FState:=TSStoped;
fEvent := TEvent.Create(nil,True,False,'');{发信号状态}
end
else

begin

FState:=TSRuning;
fEvent := TEvent.Create(nil,True,True,'');{发信号状态}
end;

end;

{------------------------------------------------------------------------------}
destructor TMyBaseThread.Destroy;
begin

inherited;
Terminate;
fEvent.SetEvent;
fEvent.Free;
end;

////////////////////////////////////////////////////////////////////////////////
procedure TMyBaseThread.AfterRun;
begin

end;

procedure TMyBaseThread.DoRun;
begin

end;

procedure TMyBaseThread.BeforeRun;
begin

end;

procedure TMyBaseThread.UnInit;
begin

end;

////////////////////////////////////////////////////////////////////////////////
procedure TMyBaseThread.Execute;
begin

while not Terminateddo

try
fEvent.WaitFor(INFINITE);
BeforeRun;
while FState=TSRuningdo

do
Run;
AfterRun;
except

end;

UnInit;
end;

////////////////////////////////////////////////////////////////////////////////
procedure TMyBaseThread.Start;
begin

FState:=TSRuning;
fEvent.SetEvent;
end;

{------------------------------------------------------------------------------}
procedure TMyBaseThread.Stop;
begin

FState:=TSStoped;
fEvent.ResetEvent;
end;

procedure TMyBaseThread.Pause;
begin

FState:=TSPaused;
fEvent.ResetEvent;
end;

{------------------------------------------------------------------------------}
procedure TMyBaseThread.Sync(Method: TThreadMethod);
begin

if FState<>tSTerminated then

inherited Synchronize(Method);
end;

{------------------------------------------------------------------------------}
procedure TMyBaseThread.Terminate;
begin

FState:=TSTerminated;
inherited terminate;
fEvent.SetEvent;
if WaitForSingleObject(Handle, 2000) = WAIT_TIMEOUT then

TerminateThread(Handle, 0);
end;

{------------------------------------------------------------------------------}
end.

===============================================================================
这些是部分代码.很多地方我做的都不好.问题太多了.我也搞不定. 大家参考一下吧.如果有用的话最好.

kindly · 2002-09-26

代码写的不错，表扬一下[

]

caowei · 2002-09-26

还是xwings慷慨，有意气啊....
jingtao该向他学习，不要只想着卖钱嘛...
抓屏的速度和显卡硬件有很大关系，不同的显卡速度差别很大。
最简单的检测可以使用本帧和上帧进行XOR操作，然后就看压缩的速度了。
传输的部分我觉得比较好处理...
xwings的不是RTP吧？我没有仔细看，好象不是按照RTP的标准协议做的，呵呵...
UDP可以了，不需要RTP。

150分求“每秒抓超过7次的整屏图像到文件中(仅800*600*16M色就可以了)”(50分)

jingtao

Unregistered / Unconfirmed

xwings

Unregistered / Unconfirmed

pyh_jerry

Unregistered / Unconfirmed

jingtao

Unregistered / Unconfirmed

xwings

Unregistered / Unconfirmed

jingtao

Unregistered / Unconfirmed

xwings

Unregistered / Unconfirmed

wql

Unregistered / Unconfirmed

tl_lyq

Unregistered / Unconfirmed

liujinwu

Unregistered / Unconfirmed

xwings

Unregistered / Unconfirmed

GGCAT

Unregistered / Unconfirmed

xwings

Unregistered / Unconfirmed

未来107

Unregistered / Unconfirmed

xwings

Unregistered / Unconfirmed

wql

Unregistered / Unconfirmed

wql

Unregistered / Unconfirmed

xwings

Unregistered / Unconfirmed

kindly

Unregistered / Unconfirmed

caowei

Unregistered / Unconfirmed

Similar threads

150分求“每秒抓超过7次的整屏图像到文件中(仅80060016M色就可以了)”(50分)