如何用ACMIn和ACMOut实现语音传输，给个例子(100分)

我也想看看：flyhu@371.net

to wql
能不能给我看一下你得到的那个会打嗝的程序？
不胜感激。drawncat@sohu.com
qq: 15556256

真的不好意思！

那个程序已经不在了！我把方法告诉你：

初始化过程：
1. 加两个TMediaPlay,M1和M2.
2. 加两个Time,Time1和Time2,Enable都为Fals,时间为1秒一次，Time1和M1同时工作！Time2和M2同时工作！
3. 启动Time1.Enabled:=True和M1录音。

Time1事件:
Time1.Enabled:=False;

Time2.Enabled:=True;
// 立即启动Time2
M2录音

M1停止,并把录音存盘为MF1！
Time1事件结束

Time2事件:
Time2.Enabled:=False;

Time1.Enabled:=True;
// 立即启动Time1
M1录音

M2停止,并把录音存盘为MF2！
Time2事件结束

用另外的线程吧为MF1和为MF2发送到其它机器上，其它机器用TMediaPlay播放！

但我ACM感觉传送的速度很慢?

我要我要我要

eyes@58866.com.cn

firewing的就是答案啊!
udpsocket可以用TNMUDP代替啊！

我把以前我写的代码，添出来，让大家参考、参考，不过还不稳定。
我没有通过Acm控件的，比较长，有兴趣的可以看一下，还有通过UDP的聊天功能。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, NMUDP, CheckLst,winsock, ElTree,ElHeader,ShellAPI, ExtCtrls,
ComCtrls,MMSystem,Msacm, ElXPThemedControl;

type
TForm1 = class(TForm)
udp_Send: TNMUDP;
Panel1: TPanel;
Panel2: TPanel;
btn_Send: TButton;
Label1: TLabel;
edt_Words: TEdit;
tim_Timer: TTimer;
rih_Words: TRichEdit;
Button1: TButton;
Button2: TButton;
elt_Online: TElTree;
procedure udp_SendDataReceived(Sender: TComponent;
NumberBytes: Integer;FromIP: String;
Port: Integer);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure elt_OnlineHeaderColumnDraw(Sender: TCustomElHeader;Section: TElHeaderSection;
R: TRect;
Pressed: Boolean);
procedure btn_SendClick(Sender: TObject);
procedure tim_TimerTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure WndProc(var Msg:TMessage);override;
procedure SendWords(SendMan,ReceiveMan,Word:String;RemoteIP:String);
Function GetHostIP(HostName:String=''):String;
Function ReturnPos(buf:TMemoryStream;Len,StartPos:Integer;Separator:Char):Integer;
procedure DisplayWords(SendMan,ReceiveMan,Word:String);
procedure UserLogin(UserName,IP:String;RemoteIP:String='');
procedure UserLogout(UserName,IP:String);
function AddNextBuffer():Integer;
function InitWaveInHeader():Integer;
function QueueNextBuffer : Integer;
{ Private declarations }
public
{ Public declarations }
end;


var
Form1: TForm1;

implementation

type TACMWAVEFORMAT=packed record
case Integer of
0Format:twaveformatex);
1Rawdata:array[0..128] of byte);
end;


const
iBufferBlock=2040;
oBufferLen=6;
var
sHostIP,P_UserName,sBroadIP:String;
nTickCountWord;
NIM_Data:NOTIFYICONDATAA;
bShowIcon,bPlayFlag:Boolean;
iMsgCount,iBufIndex,iInputPoint,iPlayPoint:Integer;
iHdr:Array [0..1] of WAVEHDR;
iBuf:Array [0..1] of pChar;
oBuf:Array [1..oBufferLen] of pChar;
oHdr:Array [1..oBufferLen] of WAVEHDR;
WaveFmt:TACMWAVEFORMAT;
HOut:HWaveOut;
HIn:HWAVEIN;

{$R *.DFM}
{$R msg.res}



procedure TForm1.udp_SendDataReceived(Sender: TComponent;NumberBytes: Integer;
FromIP: String;
Port: Integer);
var
sUserName,sSendMan,sReceiveMan,sIP,sWord:String;
iMsgType,iPos,i,iTmpPos:Integer;
Node:TEltreeItem;
mBuf:TMemoryStream;
FindHandle, ResHandle: THandle;
ResPtr: Pointer;
begin

if Trim(FromIP)=sHostIP then

Exit;

mBuf := TMemoryStream.Create();
mBuf.SetSize(NumberBytes);
mBuf.Clear;
udp_Send.
ReadStream(mBuf);
if (pchar(mBuf.Memory)^=#02) and (pchar(Longint(mBuf.Memory)+1)^=#03) then

iMsgType := ord(pchar(Longint(mBuf.Memory)+2)^)
else

begin

mBuf.Free;
Exit;
end;


sUserName := '';
case iMsgType of
1: //登录
begin

iPos := ReturnPos(mBuf,NumberBytes,4,#$1f);
sUserName := copy(PChar(mBuf.Memory),4,iPos-4);
sIP := copy(PChar(mBuf.Memory),iPos+1,ReturnPos(mBuf,NumberBytes,iPos+1,#$1f)-iPos-1);
for i:=0 to elt_Online.Items.Count-1do

begin

Node := elt_Online.Items;
if (strcomp(PChar(sUserName),PChar(Node.Text))=0)
and (strcomp(PChar(sIP),PChar(Node.ColumnText[0]))=0) then

begin

mBuf.Free;
Exit;
end;

end;

Node := elt_Online.Items.Add(nil,sUserName);
Node.ShowCheckBox := True;
Node.ColumnText.Add(sIP);

waveInStop(hIn);
for i:=1 to 3do

UserLogin(p_UserName,sHostIP,sIP);
waveInStart(hIn);
end;

2: //退出
begin

iPos := ReturnPos(mBuf,NumberBytes,4,#$1f);
sUserName := copy(PChar(mBuf.Memory),4,iPos-4);
sIP := copy(PChar(mBuf.Memory),iPos+1,ReturnPos(mBuf,NumberBytes,iPos+1,#$1f)-iPos-1);
for i:=0 to elt_Online.Items.Count-1do

begin

Node := elt_Online.Items;
if (strcomp(PChar(sUserName),PChar(Node.Text))=0)
and (strcomp(PChar(sIP),PChar(Node.ColumnText[0]))=0) then

begin

mBuf.Free;
Node.Delete;
Exit;
end;

end;

end;

3: //收到信息
begin

iPos := ReturnPos(mBuf,NumberBytes,4,#$1f);
sSendMan := copy(PChar(mBuf.Memory),4,iPos-4);
iTmpPos := ReturnPos(mBuf,NumberBytes,iPos+1,#$1f);
sReceiveMan := copy(PChar(mBuf.Memory),iPos+1,iTmpPos-iPos-1);

sWord := copy(PChar(mBuf.Memory),iTmpPos+1,ReturnPos(mBuf,NumberBytes,iTmpPos+1,#$1f)-iTmpPos-1);
DisplayWords(sSendMan,sReceiveMan,sWord);

FindHandle:=FindResource(HInstance, 'MSG_WAVE', 'WAVE');
if FindHandle<>0 then

begin

ResHandle:=LoadResource(HInstance, FindHandle);
if ResHandle<>0 then

begin

ResPtr:=LockResource(ResHandle);
if ResPtr<>Nil then

SndPlaySound(PChar(ResPtr), snd_ASync or snd_Memory);
UnlockResource(ResHandle);
end;

FreeResource(FindHandle);
end;


if Not Self.Visible then

begin

tim_Timer.Enabled := True;
end;

end;

4:
begin

if iInputPoint>oBufferLen then

iInputPoint := 1;
CopyMemory(oBuf[iInputPoint],PChar(Longint(mBuf.Memory)+3),iBufferBlock);
iInputPoint := iInputPoint + 1;
if (bPlayFlag = False) and (iInputPoint>oBufferLen/2) then

begin

bPlayFlag := True;
QueueNextBuffer;
QueueNextBuffer;
end;

end;

end;

mBuf.Free;
end;


function TForm1.GetHostIP(HostName: String): String;
var
bufChar;
iWsaRet:Integer;
Data:WSAData;
hostentHostEnt;
begin

Result := '';
iWsaRet := WSAStartup($101,Data);
if iWsaRet<>0 then

begin

ShowMessage('Socket initialize error!');
Exit;
end;

buf := Allocmem(60);
strcopy(buf,PChar(HostName));
if Trim(buf)='' then

gethostname(buf,60);
hostent := gethostbyname(buf);
Freemem(buf,60);
if hostent=nil then

Exit;
Result := inet_ntoa(pinAddr(hostent^.h_addr^)^);
WSACleanup();
end;


function TForm1.ReturnPos(buf:TMemoryStream;Len,StartPos:Integer;Separator:Char):Integer;
var
i:Integer;
begin

Result := 0;
for i:=StartPos-1 to Lendo

if pchar(Longint(buf.Memory)+i)^=#$1f then

begin

Result := i+1;
Break;
end;

end;


procedure TForm1.UserLogin(UserName,IP: String;RemoteIP:String='');
var
mBuf:TMemoryStream;
sData:String;
begin

mBuf := TMemoryStream.Create();
mBuf.Clear;
sData := #$02+#$03+#$01+UserName+#$1f+IP+#$1f+#$03;
mBuf.Write(sData[1],Length(sData));
if Trim(RemoteIP)='' then

udp_Send.
RemoteHost := sBroadIP
else

udp_Send.
RemoteHost := RemoteIP;
udp_Send.
SendStream(mBuf);
mBuf.Free;
end;


procedure TForm1.UserLogout(UserName, IP: String);
var
mBuf:TMemoryStream;
sData:String;
begin

mBuf := TMemoryStream.Create();
mBuf.Clear;
sData := #$02+#$03+#$02+UserName+#$1f+IP+#$1f+#$03;
mBuf.Write(sData[1],Length(sData));
udp_Send.
RemoteHost := sBroadIP;
udp_Send.
SendStream(mBuf);
mBuf.Free;
end;


procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
var
i:Integer;
begin

for i:=1 to 3do

UserLogout(p_UserName,sHostIP);

Shell_NotifyIconA(NIM_DELETE,@NIM_DATA);
end;


procedure TForm1.elt_OnlineHeaderColumnDraw(Sender: TCustomElHeader;Section: TElHeaderSection;
R: TRect;
Pressed: Boolean);
var
sTmpStr:String;
nRect:TRect;
begin

Sender.Canvas.Font.Size := 10;
sTmpStr := Trim(Section.Text);
nRect := R;
nRect.Top := nRect.Top+1;
DrawText(Sender.Canvas.Handle,PChar(sTmpStr),Length(sTmpStr),nRect,DT_Center);
end;


procedure TForm1.btn_SendClick(Sender: TObject);
var
Node:TEltreeItem;
sUserName,sIP:String;
begin

Node := elt_Online.Selected;
if Node = nil then

begin

Application.MessageBox('对不起，请选择发送对象!','错误',MB_ICONINFORMATION);
Exit;
end;

if Trim(edt_Words.Text)='' then

begin

Application.MessageBox('对不起，你不能发送空信息!','错误',MB_ICONINFORMATION);
edt_Words.SetFocus;
Exit;
end;

if GetTickCount()-nTickCount<250 then

begin

Application.MessageBox('对不起，你的速度太快了!','错误',MB_ICONINFORMATION);
edt_Words.SetFocus;
Exit;
end;

nTickCount := GetTickCount();

sUserName := Trim(Node.Text);
sIP := Trim(Node.ColumnText[0]);
DisplayWords(P_UserName,sUserName,Trim(edt_Words.Text));
SendWords(P_UserName,sUserName,Trim(edt_Words.Text),sIP);
edt_Words.Text := '';
edt_Words.SetFocus;
end;


procedure TForm1.SendWords(SendMan,ReceiveMan,Word:String;RemoteIP:String);
var
mBuf:TMemoryStream;
sData:String;
begin

mBuf := TMemoryStream.Create();
mBuf.Clear;
sData := #$02+#$03+#$03+Trim(SendMan)+#$1f
+ Trim(ReceiveMan)+#$1f+Word+#$1f+#$03;
mBuf.Write(sData[1],Length(sData));
if Trim(RemoteIP)='' then

udp_Send.
RemoteHost := sBroadIP
else

udp_Send.
RemoteHost := RemoteIP;
udp_Send.
SendStream(mBuf);
mBuf.Free;
end;


procedure TForm1.WndProc(var Msg: TMessage);
var
mBuf:TMemoryStream;
begin

if Msg.Msg = MM_WIM_DATA then

begin

mBuf := TMemoryStream.Create();
mBuf.Clear;
mBuf.SetSize(iBufferBlock+3);
mBuf.Write(#$02+#$03+#$04,3);
CopyMemory(Pointer(Longint(mBuf.Memory)+3),iBuf[iBufindex],iBufferBlock);
udp_Send.
RemoteHost := sBroadIP;
udp_Send.
SendStream(mBuf);
mBuf.Free;
AddNextBuffer;
end;


if Msg.Msg = MM_WOM_DONE then

begin

QueueNextBuffer();
end;


if Msg.Msg=WM_USER+11 then

if Msg.LParam=WM_LBUTTONDBLCLK then

begin

SetForegroundWindow(Self.Handle);
if Self.Visible=False then

begin

Self.Visible := True;
if iMsgCount>1 then

iMsgCount := iMsgCount - 1;
if iMsgCount=0 then

begin

NIM_Data.hIcon := LoadIcon(hInstance,'SHOW_ICON');
Shell_NotifyIconA(NIM_MODIFY,@NIM_DATA);
tim_Timer.Enabled := False;
end;

end;

end;

if Msg.Msg=WM_SYSCOMMAND then

begin

if Msg.WParam=SC_MINIMIZE then

begin

Self.Hide;
Exit;
end;

end;


inherited;
end;


procedure TForm1.tim_TimerTimer(Sender: TObject);
begin

if bShowIcon then

begin

NIM_Data.hIcon := LoadIcon(hInstance,'HIDE_ICON');
Shell_NotifyIconA(NIM_MODIFY,@NIM_DATA);
bShowIcon := False;
end
else

begin

NIM_Data.hIcon := LoadIcon(hInstance,'SHOW_ICON');
Shell_NotifyIconA(NIM_MODIFY,@NIM_DATA);
bShowIcon := true;
end;

end;


procedure TForm1.FormCreate(Sender: TObject);
var
bufChar;
Node:TEltreeItem;
sTmpStr:String;
FMaxFmtSize,i:Integer;
mRet:MMRESULT;

acmopt : TACMFORMATCHOOSE;
err : MMRESULT;
begin

iBufIndex := 0;
iInputPoint := 1;
iPlayPoint := 1;

buf := Allocmem(60);
Node := elt_Online.Items.Add(nil,'所有人');
Node.ColumnText.Add('');
sHostIP := Trim(GetHostIP());

sBroadIP := '';
sTmpStr := sHostIP;
for i:=1 to 3do

begin

sBroadIP := sBroadIP + copy(sTmpStr,1,pos('.',sTmpStr));
sTmpStr := copy(sTmpStr,pos('.',sTmpStr)+1,Length(sTmpStr));
end;

sBroadIP := sBroadIP + '255';
gethostname(buf,60);
p_UserName := buf;
FreeMem(buf,60);

GetMem(iBuf[0],iBufferBlock);
if iBuf[0]=nil then

begin

showmessage('error in getmem function');
exit;
end;

GetMem(iBuf[1],iBufferBlock);
if iBuf[1]=nil then

begin

showmessage('error in getmem function');
exit;
end;


for i:=1 to oBufferLendo

begin

GetMem(oBuf,iBufferBlock);
FillChar(oBuf^,iBufferBlock,0);
if oBuf=nil then

begin

showmessage('error in getmem function');
exit;
end;

end;


WaveFmt.Format.wFormatTag := 49;
WaveFmt.Format.nChannels := 1;
WaveFmt.Format.nSamplesPerSec := 22050;
WaveFmt.Format.nAvgBytesPerSec := 4478;
WaveFmt.Format.nBlockAlign := 65;
WaveFmt.Format.wBitsPerSample := 0;
WaveFmt.Format.cbSize := 2;
Wavefmt.Rawdata[18] := 64;
Wavefmt.Rawdata[19] := 1;
{ acmMetrics(nil, ACM_METRIC_MAX_SIZE_FORMAT, FMaxFmtSize);
acmopt.cbStruct := sizeof(acmopt);
acmopt.fdwStyle := ACMFORMATCHOOSE_STYLEF_INITTOWFXSTRUCT;
acmopt.hwndOwner := Handle;
acmopt.pwfx := @WaveFmt;
acmopt.cbwfx := sizeof(wavefmt);
acmopt.pszTitle := 'Select Compression';
acmopt.fdwEnum := ACM_FORMATENUMF_INPUT;
err := acmFormatChoose(acmopt);
for i:=sizeof(wavefmt.format) to 128do

if wavefmt.rawdata<>0 then

showmessage('offset ' + inttostr(i)+':'+inttostr(wavefmt.rawdata));

showmessage('tag:' + inttostr(WaveFmt.Format.wFormatTag)+#13
+ 'Channels:' + inttostr(WaveFmt.Format.nChannels)+#13
+ 'SamplesPerSec:' + inttostr(WaveFmt.Format.nSamplesPerSec)+#13
+ 'AvgBytesPerSec:' + inttostr(WaveFmt.Format.nAvgBytesPerSec)+#13
+ 'BlockAlign:' + inttostr(WaveFmt.Format.nBlockAlign)+#13
+ 'BitsPerSample:' + inttostr(WaveFmt.Format.wBitsPerSample)+#13
+ 'cbsize:' + inttostr(WaveFmt.Format.cbsize)+#13
+ 'WAVE_FORMAT_PCM:'+ inttostr(WAVE_FORMAT_PCM));
}
mRet := waveInOpen(@HIn,WAVE_MAPPER,@WaveFmt.Format,Self.Handle,0,CALLBACK_WINDOW);
if mRet <> MMSYSERR_NOERROR then

begin

showmessage('Open waveform audio in device error'+inttostr(mRet));
end;


mRet := waveOutOpen(@HOut,WAVE_MAPPER,@WaveFmt,Self.Handle,0,CALLBACK_WINDOW or WAVE_ALLOWSYNC);
if mRet <> MMSYSERR_NOERROR then

begin

showmessage('Open waveform audio out device error'+inttostr(mRet));
end;


for i:=1 to oBufferLendo

begin

oHdr.lpData := oBuf;
oHdr.dwBufferLength := iBufferBlock;
oHdr.reserved := 0;
oHdr.lpNext := nil;
oHdr.dwLoops := 0;
mRet := waveOutPrepareHeader(HOut,@oHdr,sizeof(WAVEHDR));
if mRet <> MMSYSERR_NOERROR then

begin

showmessage(inttostr(mRet));
Exit;
end;

end;



for i:=1 to 3do

UserLogin(p_UserName,sHostIP);

nTickCount := GetTickCount();

NIM_Data.cbSize := sizeof(NIM_Data);
NIM_Data.Wnd := Self.Handle;
NIM_Data.uID := 100;
NIM_Data.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
NIM_Data.uCallbackMessage := WM_USER+11;
NIM_Data.szTip := '信息发送工具';
NIM_Data.hIcon := LoadIcon(hInstance,'SHOW_ICON');
Shell_NotifyIconA(NIM_ADD,@NIM_Data);
bShowIcon := True;
iMsgCount := 0;
SetWindowLongA(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
end;


procedure TForm1.DisplayWords(SendMan, ReceiveMan, Word: String);
begin

with rih_Wordsdo

begin

if Length(Text)<>0 then

Lines.Add('');
Selattributes.Style := SelAttributes.Style + [fsBold] + [fsItalic];
SelStart := Length(Text);
SelLength := 0;
SelAttributes.Color := clBlue;
SelText := SendMan;

Selattributes.Style := SelAttributes.Style - [fsItalic];
SelStart := Length(Text);
SelLength := 0;
SelAttributes.Color := rgb(255,0,128);
SelText := '对';

Selattributes.Style := SelAttributes.Style + [fsBold] + [fsItalic];
SelStart := Length(Text);
SelLength := 0;
SelAttributes.Color := clBlue;
SelText := ReceiveMan;

Selattributes.Style := SelAttributes.Style - [fsItalic];
SelStart := Length(Text);
SelLength := 0;
SelAttributes.Color := rgb(255,0,128);
SelText := '说：';

Selattributes.Style := SelAttributes.Style - [fsItalic]-[fsBold];
SelStart := Length(Text);
SelLength := 0;
SelAttributes.Color := clBlack;
SelText := Word;

SelLength := 0;
SelStart := GetTextLen;
Perform(EM_SCROLLCARET,0,0);
end;

end;


procedure TForm1.Button1Click(Sender: TObject);
begin

InitWaveInHeader();
if (waveInPrepareHeader(hIn,@iHdr[0],sizeof(WAVEHDR))<>0) or
(waveInPrepareHeader(hIn,@iHdr[1],sizeof(WAVEHDR))<>0) then

begin

ShowMessage('error in waveinPrepareHeader function');
Exit;
end;


if AddNextBuffer<>0 then

begin

ShowMessage('error in AddNextBuffer function');
Exit;
end;


waveInStart(HIn);

if AddNextBuffer<>0 then

begin

ShowMessage('error in AddNextBuffer function');
Exit;
end;

end;


function TForm1.AddNextBuffer: Integer;
var
mRet:MMRESULT;
begin

mRet := waveInAddBuffer(HIn,@iHdr[iBufIndex],sizeof(WAVEHDR));
if mRet <> 0 then

begin

showmessage('error in waveinAddBuffer function');
Exit;
end;

iBufIndex := 1-iBufIndex;
Result := mRet;
end;


function TForm1.InitWaveInHeader: Integer;
begin

iHdr[0].lpData := iBuf[0];
iHdr[0].dwBufferLength := iBufferBlock;
iHdr[0].reserved := 0;
iHdr[0].lpNext := nil;

iHdr[1].lpData := iBuf[1];
iHdr[1].dwBufferLength := iBufferBlock;
iHdr[1].reserved := 0;
iHdr[1].lpNext := nil;
end;


procedure TForm1.FormDestroy(Sender: TObject);
var
i:Integer;
begin

waveOutClose(hOut);
for i:=1 to oBufferlendo

FreeMem(oBuf,iBufferBlock);

FreeMem(iBuf[0],iBufferBlock);
FreeMem(iBuf[1],iBufferBlock);
end;


function TForm1.QueueNextBuffer : Integer;
begin

oHdr[iPlayPoint].dwFlags := WHDR_PREPARED;
if waveOutWrite(hOut,@oHdr[iPlayPoint],sizeof(WAVEHDR))<>0 then

begin

Result := -1;
Exit;
end;

if iPlayPoint<oBufferLen then

iPlayPoint := iPlayPoint + 1
else

iPlayPoint := 1;

Result := 0;
end;


procedure TForm1.Button2Click(Sender: TObject);
var
dVolWORD;
mRet:MMRESULT;
begin

dVol := 0;
mRet := waveOutGetVolume(hOut,@dVol);
if mRet<>0 then

showmessage('error');
showmessage(inttostr((dvol shr 16) and $0000ffff) + ' ' + inttostr(dvol and $0000ffff));
end;


end.

干什么用的???

高手。学习！

徐军:
可以给我发一份那个改过的东西吗谢谢？
wuzhenzhen@263.net