请帮我看看这个视频电话程序，急！(50分)

我写了个通过网络传送音频、视频的程序，但运行后无法正常传送数据，而且
停止时程序占用内存急剧增大后被系统kill掉。请各位帮忙看看。只要您的回
答对问题的解决有帮助就可以得分，如果给出完整解决方案有额外加分！这是
老师的作业，很急很急！谢谢！
下面是主程序，完整的程序可以在
http://free.7host02.com/tjmovieclub/myprog.rar
ftp://yufang.vicp.net/kots/develop/myprog.rar
下载！如果无法下载请用flashget
注意，编译前要安装jhvideocap和morris两个控件包（压缩包里有，其中
jhvideo是修改过的，绝对没有问题）。


unit main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
VideoDisp, Videocap, StdCtrls, vfw, videocodec, ACMConvertor, ACMOut,
ACMIn, mmsystem, Contnrs, ScktComp, syncobjs, Buffer;

type
TMainForm = class(TForm)
VideoCap: TVideoCap;
VideoDisp: TVideoDisp;
btnStart: TButton;
btnStop: TButton;
Memo: TMemo;
ACMIn: TACMIn;
ACMOut: TACMOut;
ACMConvertorIn: TACMConvertor;
ACMConvertorOut: TACMConvertor;
ServerSocket: TServerSocket;
ClientSocket: TClientSocket;
AddrEdit: TEdit;
btnLink: TButton;
Procedure InitCapture;
Procedure InitAudio;
Procedure CloseAudio;
Procedure QueryVideoCodec;
Procedure InitVideoCodec;
Procedure CloseVideoCodec;

procedure btnStartClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
procedure VideoCapVideoStream(sender: TObject; lpVhdr: PVIDEOHDR);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnLinkClick(Sender: TObject);
procedure ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
procedure ACMInBufferFull(Sender: TObject; Data: Pointer;
Size: Integer);
procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
procedure ServerSocketGetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
private
{ Private declarations }
public
{ Public declarations }
end;

var
MainForm: TMainForm;

implementation

{$R *.DFM}

Type
DataBuf=Record
Size:LongWord;
Data:TBufferType;
End;

VideoCompressor = class(TThread)
private
{ Private declarations }
protected
constructor Create;
procedure Execute; override;
end;

AudioCompressor = class(TThread)
private
{ Private declarations }
protected
constructor Create;
procedure Execute; override;
end;

VideoDeCompressor = class(TThread)
private
{ Private declarations }
protected
constructor Create;
procedure Execute; override;
end;

AudioDeCompressor = class(TThread)
private
{ Private declarations }
protected
constructor Create;
procedure Execute; override;
end;

TSent = class(TThread)
private
{ Private declarations }
Branch:TThreadMethod;
protected
constructor Create(HasVideoData:Boolean);
procedure SentBoth;
procedure SentAudio;
procedure Execute; override;
end;

TReceive = class(TServerClientThread)
private
{ Private declarations }
Socket:TServerClientWinSocket;
protected
constructor Create(ASocket: TServerClientWinSocket);
procedure Execute; override;
end;

Const
DivXhIC:hIC=0;
DivXCompresshIC:hIC=0;
DivXDeCompresshIC:hIC=0;
HasVideo:Boolean=True;
HasAudio:Boolean=True;
InConvertRun:Boolean=False;
OutConvertRun:Boolean=False;

Var
DivXICInfo:TICINFO;
OriBMH,outBMH:TBitmapinfoHeader;
VideoCodec1:TVideoCodec;
ACMWaveFormat:TACMWaveFormat;
IsServer,IsConnected:Boolean;

OriFrame,OriAudio,CodedFrame,CodedAudio:TQueue;
OriFrame1,OriAudio1,CodedFrame1,CodedAudio1:TQueue;
AC:AudioCompressor;
ADC:AudioDeCompressor;
VC:VideoCompressor;
VDC:VideoDeCompressor;
Sent:TSent;
CS,CS1,CS2,CS3,CS4,CS5,CS6:TCriticalSection;

Procedure TMainForm.InitCapture;
Var
DevList:TStrings;
Vheader:TBitmapInfoHeader;
Begin
DevList:=GetDriverList;
If DevList.Count<1 Then HasVideo:=False;
DevList.Clear;
DevList.Free;
VideoCap.DriverOpen:=False;
VideoCap.DriverIndex:=0;

Try
VideoCap.VideoPreview:=True;
Except
On ENotConnectException do HasVideo:=False;
End;

If HasVideo Then
Begin
VHeader:=Videocap.BitMapInfoHeader;
VHeader.bicompression:=bi_RGB; // Always RGB-Data
VHeader.biBitCount:= 24;
VideoCap.BitMapInfoHeader:= VHeader;
End
Else
With VHeader do
Begin
biSize:=40;
biWidth:=160;
biHeight:=120;
biPlanes:=1;
biBitCount:=24;
biCompression:=0;
biSizeImage:=57600;
biXPelsPerMeter:=0;
biYPelsPerMeter:=0;
biClrUsed:=0;
biClrImportant:=0;
End;

VideoDisp.Streaming:= true;
VideoDisp.BitMapInfoHeader:= VHeader;
End;

Procedure TMainForm.QueryVideoCodec;
Var
i:byte;
tempicinfo:TICINFO;
temphic:hic;
Begin
OriBMH:=VideoDisp.BitMapInfoHeader;
i:=0;

While (VFW.ICInfo(ICTYPE_VIDEO,i,@tempicinfo)=True) do
Begin
temphic:=ICOpen(tempicinfo.fccType,tempicinfo.fccHandler,ICMODE_QUERY);
If (temphic<>0) AND (tempicinfo.fccType=ICTYPE_VIDEO)
AND (VFW.ICCompressQuery(temphic,@OriBMH,nil)=ICERR_OK) Then
Begin
ICGetInfo(temphic, @tempicinfo, sizeof(tempicinfo));
If tempicinfo.szName='DIVXMPG4 V3' Then
Begin
DivXhIC:=temphic;
DivXICInfo:=tempicinfo;
ICCompressGetFormat(DivXhIC,@OriBMH,@outBMH);
End;
End;
ICClose(temphic);
Inc(i);
End;
End;

Procedure TMainForm.InitVideoCodec;
Begin
VideoCodec1:=TVideoCodec.Create;
VideoCoDec1.Finish;
VideoCoDec1.ForceKeyFrameRate:=true;
VideoCoDec1.Init(OriBMH, outBMH, 100, 10);
VideoCoDec1.SetDataRate(1024, 1000 * 1000 div 30, 1);
If NOT (VideoCoDec1.StartCompressor AND VideoCoDec1.StartDeCompressor) Then
Begin
ShowMessage('Can''t start codec!');
Halt(1);
End;
End;

Procedure TMainForm.CloseVideoCodec;
Begin
VideoCoDec1.CloseCompressor;
VideoCoDec1.CloseDeCompressor;
VideoCodec1.Free;
End;

Procedure TMainForm.InitAudio;
Var
WaveFormatEx:TWaveFormatEx;
Begin
WaveFormatEx.wFormatTag:=1;
WaveFormatEx.nChannels:=1;
WaveFormatEx.nSamplesPerSec:=8000;
WaveFormatEx.nAvgBytesPerSec:=WaveFormatEx.nSamplesPerSec;
WaveFormatEx.nBlockAlign:=1;
WaveFormatEx.wBitsPerSample:=8;
WaveFormatEx.cbSize:=0;
ACMWaveFormat.Format:=WaveFormatEx;
ACMConvertorIn.FormatIn:=ACMWaveFormat;
ACMConvertorOut.FormatOut:=ACMWaveFormat;
ACMOut.Open(ACMWaveFormat);
End;

Procedure TMainForm.CloseAudio;
Begin
ACMOut.Close;
End;

procedure TMainForm.btnStartClick(Sender: TObject);
begin
InitAudio;
InitCapture;

VideoCap.DriverOpen:=True;
VideoCap.DlgVFormat;
QueryVideoCodec;
InitVideoCodec;

Sent:=TSent.Create(HasVideo);
VC:=VideoCompressor.Create;
AC:=AudioCompressor.Create;
VDC:=VideoDeCompressor.Create;
ADC:=AudioDeCompressor.Create;
Sent.Execute;

VideoCap.StartCapture;
ACMIn.Open(ACMWaveFormat);
end;

procedure TMainForm.btnStopClick(Sender: TObject);
begin
VideoDisp.Streaming:= false;
ACMIn.Close;
VideoCap.StopCapture;

VC.Terminate;
VDC.Terminate;
AC.Terminate;
ADC.Terminate;
Sent.Terminate;
VC.Free;
VDC.Free;
AC.Free;
ADC.Free;
Sent.Free;

CloseVideoCodec;
VideoCap.DriverOpen:=False;

CloseAudio;
end;

procedure TMainForm.VideoCapVideoStream(sender: TObject;
lpVhdr: PVIDEOHDR);
Var
p:^DataBuf;
begin
If NOT (VideoCoDec1.CompressorStarted AND VideoCoDec1.DecompressorStarted) Then Exit;
GetMem(p,lpVhdr^.dwBytesUsed+4);
p^.Size:=lpVhdr^.dwBytesUsed+4;
Move(lpVhdr^.lpData^,p^.Data,lpVhdr^.dwBytesUsed);
OriFrame.Push(p);
VC.Execute;
end;

constructor AudioCompressor.Create;
Begin
inherited Create(True);
FreeOnTerminate:=False;
End;

Procedure AudioCompressor.Execute;
Var
i:LongWord;
p,p1:^DataBuf;
NewSize:LongWord;
Begin
p:=OriAudio.Pop;
MainForm.ACMConvertorIn.InputBufferSize:=400;
MainForm.ACMConvertorIn.Active:=True;
For i:=1 to 20 do
Begin
Move(p^.Data[(i-1)*400+1],MainForm.ACMConvertorIn.BufferIn^,400);
NewSize:=MainForm.ACMConvertorIn.Convert;
GetMem(p1,NewSize+4);
p1^.Size:=NewSize;
Move(MainForm.ACMConvertorIn.BufferOut^,p1^.Data,NewSize);
CodedAudio.Push(p1);
End;
MainForm.ACMConvertorIn.Active:=False;
FreeMem(p);
// ADC.Execute;
End;

constructor VideoCompressor.Create;
Begin
inherited Create(True);
FreeOnTerminate:=False;
End;

Procedure VideoCompressor.Execute;
Var
Size:LongWord;
pointer;
p1,p2:^DataBuf;
Const
KeyFrame:Boolean=True;
Begin
If OriFrame.Count>0 Then
Begin
p1:=OriFrame.Pop;
p:=VideoCodec1.PackFrame(@p1^.Data,KeyFrame,Size);
GetMem(p2,Size+4);
p2^.Size:=Size;
Move(p^,p2^.Data,Size);
CodedFrame.Push(p2);
FreeMem(p1);
End;
// VDC.Execute;
End;

constructor AudioDeCompressor.Create;
Begin
inherited Create(True);
FreeOnTerminate:=False;
End;

Procedure AudioDeCompressor.Execute;
Var
i:LongWord;
p{,p1}:^DataBuf;
NewSize:LongWord;
Begin
MainForm.ACMConvertorOut.InputBufferSize:=400;
MainForm.ACMConvertorOut.Active:=True;
p:=CodedAudio1.Pop;
Move(p^.Data,MainForm.ACMConvertorOut.BufferIn^,400);
FreeMem(p);
NewSize:=MainForm.ACMConvertorOut.Convert;
MainForm.ACMOut.Play(MainForm.ACMConvertorOut.BufferOut^,NewSize);
MainForm.ACMConvertorOut.Active:=False;
End;

constructor VideoDeCompressor.Create;
Begin
inherited Create(True);
FreeOnTerminate:=False;
End;

Procedure VideoDeCompressor.Execute;
Var
Size:LongWord;
pointer;
p1:^DataBuf;
Const
KeyFrame:Boolean=True;
Begin
If CodedFrame.Count>0 Then
Begin
p1:=CodedFrame1.Pop;
p:=VideoCoDec1.UnPackFrame(@p1^.Data,KeyFrame,Size);
FreeMem(p1);
MainForm.VideoDisp.DrawStream(p,KeyFrame);
End;
End;

procedure TMainForm.FormCreate(Sender: TObject);
begin
IsConnected:=False;
CS:=TCriticalSection.Create;
CS1:=TCriticalSection.Create;
CS2:=TCriticalSection.Create;
CS3:=TCriticalSection.Create;
CS4:=TCriticalSection.Create;
CS5:=TCriticalSection.Create;
CS6:=TCriticalSection.Create;

OriFrame:=TQueue.Create;
OriAudio:=TQueue.Create;
CodedFrame:=TQueue.Create;
CodedAudio:=TQueue.Create;
CodedFrame1:=TQueue.Create;
CodedAudio1:=TQueue.Create;
ServerSocket.Open;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ServerSocket.Close;
CodedAudio1.Free;
CodedFrame1.Free;
CodedAudio.Free;
CodedFrame.Free;
OriAudio.Free;
OriFrame.Free;
CS6.Free;
CS5.Free;
CS4.Free;
CS3.Free;
CS2.Free;
CS1.Free;
CS.Free;
end;

procedure TMainForm.btnLinkClick(Sender: TObject);
begin
ClientSocket.Address:=AddrEdit.Text;
ClientSocket.Open;
IsServer:=False;
IsConnected:=True;
end;

procedure TMainForm.ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo.Lines.Add(Socket.RemoteAddress+' Connected.');
IsServer:=True;
IsConnected:=True;
end;

constructor TSent.Create(HasVideoData:Boolean);
Begin
inherited Create(True);
FreeOnTerminate:=False;
If HasVideoData Then Branch:=SentBoth
Else Branch:=SentAudio;
End;

Procedure TSent.SentBoth;
Var
s:LongWord;
DataStream:TWinSocketStream;
p,p1:^DataBuf;
Temp:Array[1..20*1024] of Byte;
Begin
While NOT Terminated do
Begin
If (CodedFrame.Count>0) AND (CodedAudio.Count>0) Then
Begin
p:=CodedFrame.Pop;
p1:=CodedAudio.Pop;
Try
If IsConnected Then
Begin
s:=p^.Size+p1^.Size+8;
Move(p^,Temp,p^.Size+4);
Move(p1^,Temp[P^.Size+4+1],p1^.Size+4);
If IsServer Then
Begin
DataStream:=TWinSocketStream.Create(MainForm.ServerSocket.Socket.Connections[0],50);
If DataStream.Write(s,4)=4 Then Datastream.Write(Temp,s);
DataStream.Free;
End
Else
Begin
DataStream:=TWinSocketStream.Create(MainForm.ClientSocket.Socket,50);
If DataStream.Write(s,4)=4 Then Datastream.Write(Temp,s);
DataStream.Free;
End;
End;
Finally
FreeMem(p);
FreeMem(p1);
Application.ProcessMessages;
End;
End;
End;
End;

Procedure TSent.SentAudio;
Var
s:LongWord;
DataStream:TWinSocketStream;
p1:^DataBuf;
Temp:Array[1..5*1024] of Byte;
Begin
While NOT Terminated do
Begin
If CodedAudio.Count>0 Then
Begin
p1:=CodedAudio.Pop;
Try
If IsConnected Then
Begin
s:=p1^.Size+4+4;
FillChar(Temp,4,0);
Move(p1^,Temp[5],p1^.Size+4);
If IsServer Then
Begin
DataStream:=TWinSocketStream.Create(MainForm.ServerSocket.Socket.Connections[0],50);
If DataStream.Write(s,4)=4 Then Datastream.Write(Temp,s);
DataStream.Free;
End
Else
Begin
DataStream:=TWinSocketStream.Create(MainForm.ClientSocket.Socket,50);
If DataStream.Write(s,4)=4 Then Datastream.Write(Temp,s);
DataStream.Free;
End;
End;
Finally
FreeMem(p1);
Application.ProcessMessages;
End;
End;
End;
End;


Procedure TSent.Execute;
Begin
{
While NOT Terminated do
Begin
If (CodedFrame.Count>0) AND (CodedAudio.Count>0) Then
Begin
CodedFrame1.Push(CodedFrame.Pop);
CodedAudio1.Push(CodedAudio.Pop);
VDC.Execute;
ADC.Execute;
End;
Application.ProcessMessages;
End;
Exit;
}
Branch;
End;

procedure TMainForm.ACMInBufferFull(Sender: TObject; Data: Pointer;
Size: Integer);
Var
p:^DataBuf;
begin
GetMem(p,Size+4);
p^.Size:=Size;
Move(Data^,p^.Data,Size);
OriAudio.Push(p);
AC.Execute;
end;

procedure TMainForm.ClientSocketRead(Sender: TObject;
Socket: TCustomWinSocket);
Var
p,p1:^DataBuf;
Temp:Array[1..20*1024] of Byte;
DataStream:TWinSocketStream;
s,s1:LongWord;
begin
If Socket.Connected Then
Begin
Try
DataStream:=TWinSocketStream.Create(Socket,50);
Try
If DataStream.WaitForData(50) Then
Begin
If DataStream.Read(s,4)=0 Then Socket.Close;
If DataStream.Read(Temp,s)=0 Then Socket.Close;
Move(Temp,s,4); //Size of the video block
If s<>0 Then
Begin
GetMem(p,s+4);
p^.Size:=s;
Move(Temp[5],p^.Data,s); //Data of the video block
CodedFrame1.Push(p);
VDC.Execute; //unpack
End;
Move(Temp[5+s],s1,4); //Size of the audio block
GetMem(p1,s1+4);
p1^.Size:=s1;
Move(Temp[9+s],p1^.Data,s1);
CodedAudio1.Push(p1);
ADC.Execute; //unpack
End
Else
Socket.Close;
Finally
End;
Finally
DataStream.Free;
End;
End;
end;

constructor TReceive.Create(ASocket: TServerClientWinSocket);
Begin
inherited Create(True,ASocket);
Socket:=ASocket;
FreeOnTerminate:=False;
End;

procedure TReceive.Execute;
Var
p,p1:^DataBuf;
Temp:Array[1..20*1024] of Byte;
DataStream:TWinSocketStream;
s,s1:LongWord;
Begin
While (NOT Terminated) AND Socket.Connected do
Begin
Try
DataStream:=TWinSocketStream.Create(Socket,50);
Try
If DataStream.Read(s,4)=0 Then Socket.Close;
If DataStream.Read(Temp,s)=0 Then Socket.Close;
Move(Temp,s1,4);
If s1<>0 Then
Begin
GetMem(p,s1);
p^.Size:=s1;
Move(Temp[5],p^.Data,s1);
CodedFrame1.Push(p);
VDC.Execute;
End;
Move(Temp[4+s1+1],s1,4);
GetMem(p1,s1);
p1^.Size:=s1;
Move(Temp[4+s1+4+1],p1^.Data,s1);
CodedAudio1.Push(p1);
ADC.Execute;
Finally
DataStream.Free;
End;
Except
Socket.Free;
End;
End;
End;

procedure TMainForm.ServerSocketGetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
Var
myThread:TReceive;
begin
myThread:=TReceive.Create(ClientSocket);
SocketThread:=myThread;
end;

end.

帮你顶一下吧！程序太长，没空看！　

看到头晕，好象有专门控件实现，去GOOGLE收收！！

不能下载啊

连接更新了。
下载以下文件：
http://user1.7host.com/tjmovieclub/forum/image/VOIP.RAR.PNG
这是RAR文件
下载后去掉.PNG后缀即可。

IdTCPClient,IdTCPServer这个是什么组件阿？！ delphi5.0里好像没有。
我刚下载了，在看！

不会吧,Indy你都不知道?在google上搜索一下就有了.

下不了。

太长了，看得头晕！
帮你顶一下吧

无法下载...

不能下载，为什么？？

请firstrose进来接分:http://www.delphibbs.com/delphibbs/DispQ.asp?LID=2472562


感谢他回答：http://www.delphibbs.com/delphibbs/dispq.asp?lid=2423355