学步园

语音聊天实现
没有通过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),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
   buf:pChar;
   iWsaRet:Integer;
   Data:WSAData;
   hostent:PHostEnt;
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 Len do
      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 3 do
       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
   buf:pChar;
   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 3 do
   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 oBufferLen do
   begin
      GetMem(oBuf[i],iBufferBlock);
      FillChar(oBuf[i]^,iBufferBlock,0);
      if oBuf[i]=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 128 do
      if wavefmt.rawdata[i]<>0 then
       showmessage('offset ' + inttostr(i)+':'+inttostr(wavefmt.rawdata[i]));

    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 oBufferLen do
   begin
      oHdr[i].lpData := oBuf[i];
      oHdr[i].dwBufferLength := iBufferBlock;
      oHdr[i].reserved := 0;
      oHdr[i].lpNext := nil;
      oHdr[i].dwLoops := 0;
      mRet := waveOutPrepareHeader(HOut,@oHdr[i],sizeof(WAVEHDR));
      if mRet <> MMSYSERR_NOERROR then
      begin
         showmessage(inttostr(mRet));
         Exit;
      end;
   end;

   for i:=1 to 3 do
       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_Words do
   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 oBufferlen do
      FreeMem(oBuf[i],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 iPlayPoint0 then
      showmessage('error');
   showmessage(inttostr((dvol shr 16) and $0000ffff) + ' ' + inttostr(dvol and $0000ffff));
end;

end. 
======================================================================================
unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ScktComp, StdCtrls, ACMWaveOut, ACMWaveIn, ACMDialog;

type
  TMainForm = class(TForm)
    ConnectButton: TButton;
    AddrEdit: TEdit;
    Label1: TLabel;
    ServerSocket: TServerSocket;
    ClientSocket: TClientSocket;
    ACMDialog: TACMDialog;
    ACMWaveIn: TACMWaveIn;
    ACMWaveOut: TACMWaveOut;
    DropButton: TButton;
    Memo: TMemo;
    Label2: TLabel;
    ClearButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ConnectButtonClick(Sender: TObject);
    procedure DropButtonClick(Sender: TObject);
    procedure ClearButtonClick(Sender: TObject);
    procedure ServerSocketClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketConnecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ACMWaveInData(data: Pointer; size: Integer);
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

Const
  BufLen:Integer=1024*1024;

Type
  Buffer=Array[1..1] of Byte;
  BufPointer=^Buffer;

Var
  MemStream:TMemoryStream;
  Buf:^Buffer;
  IsServer:Boolean;
  Client:TCustomWinSocket;

procedure TMainForm.FormCreate(Sender: TObject);
Var
  Format:Pointer;
begin
  ServerSocket.Port:=3366;
  ServerSocket.ServerType:=stNonBlocking;
  ServerSocket.Open;
  GetMem(Buf,BufLen);
  Memo.Lines.Add('Local server srarted.');
  Format:=ACMDialog.OpenDialog;
  If Format=nil Then Exit;
  ACMWaveOut.Open(Format);
  ACMWaveIn.Open(Format);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FreeMem(Buf);
  ACMWaveIn.Close;
  ACMWaveOut.Close;
  ServerSocket.Close;
  Memo.Lines.Add('Local server shutdown.');
end;

procedure TMainForm.ConnectButtonClick(Sender: TObject);
begin
  ClientSocket.Port:=3366;
  ClientSocket.ClientType:=ctNonBlocking;
  ClientSocket.Address:=AddrEdit.Text;
  ClientSocket.Open;
  IsServer:=False;
end;

procedure TMainForm.DropButtonClick(Sender: TObject);
begin
  ClientSocket.Close;
end;

procedure TMainForm.ClearButtonClick(Sender: TObject);
begin
  Memo.Clear;
end;

procedure TMainForm.ServerSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo.Lines.Add('A client connected.');
  IsServer:=True;
  Client:=Socket;
end;

procedure TMainForm.ServerSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo.Lines.Add('A client droped.');
end;

procedure TMainForm.ClientSocketConnecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo.Lines.Add('Connecting to server '+AddrEdit.Text);
end;

procedure TMainForm.ACMWaveInData(data: Pointer; size: Integer);
Var
  sending,sent,index,temp:Longint;
  s:String;
begin
{  temp:=size;
  sent:=0;
  Index:=1;
  While sent-1 Then
        Begin
          sent:=sent+sending;
          index:=index+sending;
          temp:=temp-sending;
        End;
      End;}
  Case IsServer of
  True:
    Begin
      If Client.Connected Then
        Begin
          Client.SendBuf(data^,size);
        End;
    End;
  False:
    Begin
      If ClientSocket.Socket.Connected Then
        Begin
          Str(ClientSocket.Socket.SendBuf(data^,size),s);
          Memo.Lines.Add('Sent '+s);
        End;
    End;
  End;
end;

procedure TMainForm.ServerSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
Var
  temp:Longint;
begin
  temp:=Socket.ReceiveBuf(Buf^,BufLen);
  If NOT IsServer Then Exit;
  ACMWaveOut.PlayBack(Buf,temp);
end;

procedure TMainForm.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
Var
  temp:Longint;
begin
  temp:=Socket.ReceiveBuf(Buf^,BufLen);
  If IsServer Then Exit;
  ACMWaveOut.PlayBack(Buf,temp);
end;

end.