语音聊天实现
没有通过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
0:(Format:twaveformatex);
1:(Rawdata:array[0..128] of byte);
end;
const
iBufferBlock=2040;
oBufferLen=6;
var
sHostIP,P_UserName,sBroadIP:String;
nTickCount:DWord;
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-1 do
begin
Node := elt_Online.Items[i];
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 3 do
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-1 do
begin
Node := elt_Online.Items[i];
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),iPo