TAPI编程

开发平台：
Delphi

NetAudio.pas：源码内容
							unit NetAudio;
interface
uses Windows, Messages, SysUtils, Variants, Classes, MMSystem, DblPxyTcp,
     blcksock, synsock;
const
  WM_STATEMESSAGE  = WM_USER + 101;
  WM_CLIENTCONNECT = WM_USER + 102;
  WM_CONNECTED     = WM_USER + 103;
  WM_SENDAUDIO     = WM_USER + 121;
  WM_RECVAUDIO     = WM_USER + 122;
  WM_TERMINATE     = WM_USER + 123;
  mtListenStart = 1;
  mtListening   = 2;
  mtListenFail  = 3;
  mtListenClose = 4;
  mtConnecting  = 5;
  mtConnectFail = 6;
  mtRecvFail    = 7;
  mtRecvClose   = 8;
  mtSendClose   = 9;
  mtRefused     = 10;
  mtInvConnect  = 11;
  mtMustSelIP   = 12;
  mtPeerBusy    = 13;
  mtSendFail    = 14;
  MAXDELAYTIME   = 50;
    
type
  TIniTaskFlag = (tfDoNothing, tfDoConnect, tfDoRefuse, tfDoBusy, tfDoAgree);
  TAudioListenThread = class(TThread)
  protected
    FSocket: TDblProxyTcpSocket;
    FWindow: HWND;
    FIPIndex: Integer;
    FPort: string;
  public
    constructor Create(hwin: HWND; const port: string);
    destructor Destroy; override;
    procedure Execute; override;
    property Socket: TDblProxyTcpSocket read FSocket;
    property IPIndex: Integer read FIPIndex write FIPIndex;
  end;
  TAudioBaseThread = class(TThread)
  protected
    FSocket: TDblProxyTcpSocket;
    FTask: TIniTaskFlag;
    FWindow: HWND;
    FHost, FPort: string;
  public
    constructor Create(hwin: HWND; sock: TDblProxyTcpSocket; task: TIniTaskFlag);
    function DoIniTask: Boolean;
    property Socket: TDblProxyTcpSocket read FSocket;
    property Host: string read FHost write FHost;
    property Port: string read FPort write FPort;
  end;
  TAudioRecvThread = class(TAudioBaseThread)
  protected
    FSpeakerOpen: Boolean;
  public
    constructor Create(hwin: HWND; sock: TDblProxyTcpSocket; task: TIniTaskFlag);
    procedure Execute; override;
    property SpeakerOpen: Boolean read FSpeakerOpen write FSpeakerOpen;
    property Socket;
    property Host;
    property Port;
  end;
  TAudioSendThread = class(TAudioBaseThread)
  protected
    FPhoneOpen: Boolean;
  public
    constructor Create(hwin: HWND; sock: TDblProxyTcpSocket; task: TIniTaskFlag);
    procedure Execute; override;
    property PhoneOpen: Boolean read FPhoneOpen write FPhoneOpen;
    property Socket;
    property Host;
    property Port;
  end;
  function AudioInOpened: Boolean;
  function OpenAudioIn(thread: Cardinal): Integer;
  function SetThreadIn(thread: Cardinal): Cardinal;
  procedure CloseAudioIn;
  procedure StartAudioIn;
  function AudioOutOpened: Boolean;
  function OpenAudioOut(thread: Cardinal): Integer;
  function SetThreadOut(thread: Cardinal): Cardinal;
  procedure CloseAudioOut;
  procedure StartAudioOut;
  function SetDelayTime(n: Integer): Integer;
implementation
const
  WAVINBUFCOUNT  = 3;
  WAVOUTBUFCOUNT = 3;
  WAVMAXBUFSIZE  = 13000;
type
  TPCMWaveFormat = packed record
    Wav: TWAVEFORMATEX;
    Gsm: Word;
  end;
  PPCMWaveFormat = ^TPCMWaveFormat;
var AudioInOpen, AudioOutOpen: Boolean;
    DevAudioIn: HWAVEIN;
    DevAudioOut: HWAVEOUT;
    WavInFmt, WavOutFmt: TPCMWaveFormat;
    WavInHdr: array [0..WAVINBUFCOUNT-1] of WAVEHDR;
    WavOutHdr: array [0..WAVOUTBUFCOUNT-1] of WAVEHDR;
    BufInSize: Integer;
    ThreadIn, ThreadOut: Cardinal;
    DelayTime: Integer;
    WavInBuf, WavOutBuf: PByteArray;
constructor TAudioListenThread.Create(hwin: HWND; const port: string);
begin
  inherited Create(True);
  FWindow := hwin;
  FPort := port;
  FIPIndex := 0;
  FSocket := TDblProxyTcpSocket.Create;
  FreeOnTerminate := True;
end;
destructor TAudioListenThread.Destroy;
begin
  FSocket.Free;
  inherited Destroy;
end;
procedure TAudioListenThread.Execute;
var s: TSocket;
    a: string;
    b: TStringList;
begin
  PostMessage(FWindow, WM_STATEMESSAGE, mtListenStart, 0);
  b := TStringList.Create;
  FSocket.ResolveNameToIP(FSocket.LocalName, b);
  if (b.Count > 0) and (FSocket.SocksIP = '') then
  begin
    FIPIndex := -2;
    PostMessage(FWindow, WM_STATEMESSAGE, mtMustSelIP, Integer(b));
    while FIPIndex < -1 do Sleep(100);
  end
  else FIPIndex := 0;
  if FIPIndex < 0 then
  begin
    PostMessage(FWindow, WM_STATEMESSAGE, mtListenClose, 0);
    Exit;
  end
  else if FIPIndex < b.Count then a := b.Strings[FIPIndex]
  else a := cAnyHost;
  b.Free;
  FSocket.Bind(a, FPort);
  FSocket.Listen;
  if FSocket.LastError <> 0 then
  begin
    PostMessage(FWindow, WM_STATEMESSAGE, mtListenFail, 0);
    Exit;
  end;
  FSocket.GetSins;
  PostMessage(FWindow, WM_STATEMESSAGE, mtListening, 0);
  while not Terminated do
  begin
    if FSocket.CanRead(500) then
    begin
      s := FSocket.Accept;
      if FSocket.LastError = 0 then
      begin
        PostMessage(FWindow, WM_CLIENTCONNECT, s, 0);
        if FSocket.UsingSocks then
        begin
          FSocket.Socket := INVALID_SOCKET;
          FSocket.Bind(a, FPort);
          FSocket.Listen;
          if FSocket.LastError <> 0 then
          begin
            PostMessage(FWindow, WM_STATEMESSAGE, mtListenFail, 0);
            Exit;
          end;
          FSocket.GetSins;
          PostMessage(FWindow, WM_STATEMESSAGE, mtListening, 0);
        end;
      end;
    end;
  end;
  PostMessage(FWindow, WM_STATEMESSAGE, mtListenClose, 0);
end;
constructor TAudioBaseThread.Create(hwin: HWND; sock: TDblProxyTcpSocket; task: TIniTaskFlag);
begin
  inherited Create(True);
  FSocket := sock;
  FWindow := hwin;
  FTask := task;
  FHost := '';
  FPort := '';
  FreeOnTerminate := True;
end;
function TAudioBaseThread.DoIniTask: Boolean;
const ptPhoneRequest = $6C;
      ptPhoneAccept  = $6A;
      ptPhoneCanRec  = $A6;
      ptPhoneRefuse  = $00;
      ptPhoneBusy    = $01;
      ptPhoneRecord  = $02;
var b: Byte;
begin
  FSocket.SetTimeout(1000);
  case FTask of
    tfDoConnect:
    begin
      PostMessage(FWindow, WM_STATEMESSAGE, mtConnecting, 0);
      FSocket.Connect(FHost, FPort);
      if FSocket.LastError <> 0 then
      begin
        PostMessage(FWindow, WM_STATEMESSAGE, mtConnectFail, 0);
        Result := False;
      end
      else begin
        FSocket.SendByte(ptPhoneRequest);
        repeat  // 等待直到对方发送确认信息或者退出
          b := FSocket.RecvByte(1000);
          if FSocket.LastError = 0 then
          begin
            if b = ptPhoneAccept then
            begin
              PostMessage(FWindow, WM_CONNECTED, 0, 0);
              Result := True;
              Exit;
            end
            else if b = ptPhoneBusy then
            begin
              PostMessage(FWindow, WM_STATEMESSAGE, mtPeerBusy, 0);
              Result := False;
              Exit;
            end
            else begin
              PostMessage(FWindow, WM_STATEMESSAGE, mtRefused, 0);
              Result := False;
              Exit;
            end;
          end
          else if FSocket.LastError <> WSAETIMEDOUT then
          begin
            PostMessage(FWindow, WM_STATEMESSAGE, mtRecvFail, 0);
            Result := False;
            Exit;
          end;
        until Terminated;
        PostMessage(FWindow, WM_STATEMESSAGE, mtRecvClose, 0);
        Result := False;
      end;
    end;
    tfDoRefuse:
    begin
       FSocket.SendByte(ptPhoneRefuse);
       Sleep(1000);
       FSocket.Free;
       Result := False;
    end;
    tfDoBusy:
    begin
       FSocket.SendByte(ptPhoneBusy);
       Sleep(1000);
       FSocket.Free;
       Result := False;
    end;
    tfDoAgree:
    begin
      if FSocket.RecvByte(5000) <> ptPhoneRequest then
      begin
        PostMessage(FWindow, WM_STATEMESSAGE, mtInvConnect, 0);
        Result := False;
        Exit;
      end;
      FSocket.SendByte(ptPhoneAccept);
      PostMessage(FWindow, WM_CONNECTED, 0, 0);
      Result := True;
    end;
    else Result := True;
  end;
end;
constructor TAudioRecvThread.Create(hwin: HWND; sock: TDblProxyTcpSocket; task: TIniTaskFlag);
begin
  inherited Create(hwin, sock, task);
  FSpeakerOpen := True;
end;
procedure TAudioRecvThread.Execute;
const RECVTIMEOUT = 2000;
var i, j, n: Integer;
    buf: array[0..Sizeof(Integer)-1] of Byte absolute n;
    p: PWAVEHDR;
    ms: MSG;
begin
  if not DoIniTask then Exit;
  while not Terminated do
  begin
    GetMessage(ms, 0, 0, 0);
    case ms.message of
      WM_RECVAUDIO:
      begin
        i := 0;
        repeat
          i := i + FSocket.RecvBufferEx(@buf[i], Sizeof(Integer) - i, RECVTIMEOUT);
          if (i >= Sizeof(Integer)) and (FSocket.LastError = 0) then
          begin
            if n > WAVMAXBUFSIZE then
            begin
              PostMessage(FWindow, WM_STATEMESSAGE, mtRecvFail, 0);
              Exit;
            end;
            j := 0;
            repeat
              p := PWAVEHDR(ms.lParam);
              j := j + FSocket.RecvBufferEx(@(p^.lpData[j]), n - j, RECVTIMEOUT);
              if (j >= n) and (FSocket.LastError = 0) then
              begin
                if FSpeakerOpen then
                begin
                  p^.dwFlags := 0;
                  p^.dwBufferLength := n;
                  p^.dwBytesRecorded := n;
                  waveOutPrepareHeader(ms.wParam, p, Sizeof(WAVEHDR));
                  waveOutWrite(ms.wParam, p, Sizeof(WAVEHDR));
                end
                else
                  PostThreadMessage(ThreadID, WM_RECVAUDIO, ms.wParam, ms.lParam);
              end
              else if (FSocket.LastError <> 0) and (FSocket.LastError <> WSAETIMEDOUT) then
              begin
                PostMessage(FWindow, WM_STATEMESSAGE, mtRecvFail, 0);
                Exit;
              end;
            until (j >= n) or Terminated;
          end
          else if (FSocket.LastError <> 0) and (FSocket.LastError <> WSAETIMEDOUT) then
          begin
            PostMessage(FWindow, WM_STATEMESSAGE, mtRecvFail, 0);
            Exit;
          end;
        until (i >= Sizeof(Integer)) or Terminated;
      end;
      WM_TERMINATE: Terminate;
    end; // case
  end; // while
  PostMessage(FWindow, WM_STATEMESSAGE, mtRecvClose, 0);
end;
constructor TAudioSendThread.Create(hwin: HWND; sock: TDblProxyTcpSocket; task: TIniTaskFlag);
begin
  inherited Create(hwin, sock, task);
  FPhoneOpen := True;
end;
procedure TAudioSendThread.Execute;
var i, j, m, n: Integer;
    buf: array[0..Sizeof(Integer)-1] of Byte absolute n;
    p: PWAVEHDR;
    ms: MSG;
begin
  if not DoIniTask then Exit;
  m := 0;
  while not Terminated do
  begin
    GetMessage(ms, 0, 0, 0);
    case ms.message of
      WM_SENDAUDIO:
      begin
        p := PWAVEHDR(ms.lParam);
        n := p^.dwBytesRecorded;
        if FPhoneOpen and (n >= m) then
        begin
          i := 0;
          repeat
            i := i + FSocket.SendBuffer(@buf[i], Sizeof(Integer) - i);
            if (i >= Sizeof(Integer)) and (FSocket.LastError = 0) then
            begin
              j := 0;
              repeat
                j := j + FSocket.SendBuffer(@(p^.lpData[j]), n - j);
                if FSocket.LastError <> 0 then
                begin
                  PostMessage(FWindow, WM_STATEMESSAGE, mtSendFail, 0);
                  Exit;
                end;
              until (j >= n) or Terminated;
              if Terminated then
              begin
                PostMessage(FWindow, WM_STATEMESSAGE, mtSendClose, 0);
                Exit;
              end;
              m := n;
            end
            else if FSocket.LastError <> 0 then
            begin
              PostMessage(FWindow, WM_STATEMESSAGE, mtSendFail, 0);
              Exit;
            end;
          until (i >= Sizeof(Integer)) or Terminated;
        end;
        if m > n then Dec(m, n);
        p^.dwFlags := 0;
        p^.dwBytesRecorded := 0;
        p^.dwBufferLength := BufInSize;
        waveInPrepareHeader(ms.wParam, p, Sizeof(WAVEHDR));
        waveInAddBuffer(ms.wParam, p, Sizeof(WAVEHDR));
      end;
      WM_TERMINATE: Terminate;
    end; // case
  end; // while
  PostMessage(FWindow, WM_STATEMESSAGE, mtSendClose, 0);
end;
procedure InitAudioVars;
begin
  with WavInFmt do
  begin
    Wav.wFormatTag := 49; // GSM 6.10 语音格式，11025Hz8位单声道;
    Wav.nChannels := 1;
    Wav.nSamplesPerSec := 11025;
    Wav.nAvgBytesPerSec := 2239;
    Wav.nBlockAlign := 65;
    Wav.wBitsPerSample := 0;
    Wav.cbSize := 2;
    Gsm := 320;
  end;
  WavOutFmt := WavInFmt;
  AudioInOpen := False;
  AudioOutOpen := False;
  DevAudioIn := 0;
  DevAudioOut := 0;
  BufInSize := 780;
  DelayTime := 3;
  ThreadIn := 0;
  ThreadOut := 0;
  WavInBuf := nil;
  WavOutBuf := nil;
end;
procedure WaveInProc(hw: HWAVEIN; ms: Integer; ux: Cardinal; p1: PWAVEHDR; p2: Cardinal); stdcall; far;
begin
  if ms = WIM_DATA then
  begin
    waveInUnprepareHeader(hw, p1, Sizeof(WAVEHDR));
    if ThreadIn <> 0 then PostThreadMessage(ThreadIn, WM_SENDAUDIO, hw, Integer(p1));
  end;
end;
function AudioInOpened: Boolean;
begin
  Result := AudioInOpen;
end;
function OpenAudioIn(thread: Cardinal): Integer;
var i: Integer;
begin
  if AudioInOpen then CloseAudioIn;
  ThreadIn := thread;
  Result := waveInOpen(@DevAudioIn, WAVE_MAPPER, @WavInFmt, Cardinal(@WaveInProc), 0, CALLBACK_FUNCTION);
  AudioInOpen := Result = MMSYSERR_NOERROR;
  if not AudioInOpen then Exit;
  GetMem(WavInBuf, WAVMAXBUFSIZE * WAVINBUFCOUNT);
  for i := 0 to WAVINBUFCOUNT - 1 do
  begin
    WavInHdr[i].lpData := @(WavInBuf^[i*WAVMAXBUFSIZE]);
    WavInHdr[i].dwBufferLength := BufInSize;
    WavInHdr[i].dwBytesRecorded := 0;
    WavInHdr[i].dwFlags := 0;
    Result := waveInPrepareHeader(DevAudioIn, @WavInHdr[i], Sizeof(WAVEHDR));
    AudioInOpen := Result = MMSYSERR_NOERROR;
    if not AudioInOpen then
    begin
      waveInClose(DevAudioIn);
      FreeMem(WavInBuf, WAVMAXBUFSIZE * WAVINBUFCOUNT);
      WavInBuf := nil;
      Exit;
    end;
    Result := waveInAddBuffer(DevAudioIn, @WavInHdr[i], Sizeof(WAVEHDR));
    AudioInOpen := Result = MMSYSERR_NOERROR;
    if not AudioInOpen then
    begin
      waveInClose(DevAudioIn);
      FreeMem(WavInBuf, WAVMAXBUFSIZE * WAVINBUFCOUNT);
      WavInBuf := nil;
      Exit;
    end;
  end;
end;
function SetThreadIn(thread: Cardinal): Cardinal;
begin
  Result := ThreadIn;
  ThreadIn := thread;
end;
procedure CloseAudioIn;
begin
  if AudioInOpen then
  begin
    ThreadIn := 0;
    waveInStop(DevAudioIn);
    waveInReset(DevAudioIn);
    waveInClose(DevAudioIn);
    FreeMem(WavInBuf, WAVMAXBUFSIZE * WAVINBUFCOUNT);
    WavInBuf := nil;
    AudioInOpen := False;
  end;
end;
procedure StartAudioIn;
begin
  if AudioInOpen then waveInStart(DevAudioIn);
end;
procedure WaveOutProc(hw: HWAVEOUT; ms: Integer; ux: Cardinal; p1: PWAVEHDR; p2: Cardinal); stdcall; far;
begin
  if ms = WOM_DONE then
  begin
    waveOutUnprepareHeader(hw, p1, Sizeof(WAVEHDR));
    if ThreadOut <> 0 then PostThreadMessage(ThreadOut, WM_RECVAUDIO, hw, Integer(p1));
  end;  
end;
function AudioOutOpened: Boolean;
begin
  Result := AudioOutOpen;
end;
function OpenAudioOut(thread: Cardinal): Integer;
begin
  if AudioOutOpen then CloseAudioOut;
  ThreadOut := thread;
  GetMem(WavOutBuf, WAVMAXBUFSIZE * WAVOUTBUFCOUNT);
  Result := waveOutOpen(@DevAudioOut, WAVE_MAPPER, @WavOutFmt, Cardinal(@WaveOutProc), 0, CALLBACK_FUNCTION);
  AudioOutOpen := Result = MMSYSERR_NOERROR;
  if not AudioOutOpen then
  begin
    FreeMem(WavOutBuf, WAVMAXBUFSIZE * WAVOUTBUFCOUNT);
    WavOutBuf := nil;
  end;
end;
function SetThreadOut(thread: Cardinal): Cardinal;
begin
  Result := ThreadOut;
  ThreadOut := thread;
end;
procedure CloseAudioOut;
begin
  if AudioOutOpen then
  begin
    ThreadOut := 0;
    waveOutReset(DevAudioOut);
    waveOutClose(DevAudioOut);
    FreeMem(WavOutBuf, WAVMAXBUFSIZE * WAVOUTBUFCOUNT);
    WavOutBuf := nil;
    AudioOutOpen := False;
  end;
end;
procedure StartAudioOut;
var i: Integer;
begin
  if AudioOutOpen and (ThreadOut <> 0) then for i := 0 to WAVOUTBUFCOUNT - 1 do
  begin
    WavOutHdr[i].lpData := @(WavOutBuf^[i*WAVMAXBUFSIZE]);
    WavOutHdr[i].dwBufferLength := BufInSize;
    WavOutHdr[i].dwBytesRecorded := 0;
    WavOutHdr[i].dwFlags := 0;
    WavOutHdr[i].dwLoops := 1;
    PostThreadMessage(ThreadOut, WM_RECVAUDIO, DevAudioOut, Integer(@WavOutHdr[i]));
  end;
end;
function SetDelayTime(n: Integer): Integer;
begin
  Result := DelayTime;
  if n < 1 then n := 1 else if n > MAXDELAYTIME then n := MAXDELAYTIME;
  if n <> DelayTime then
  begin
    DelayTime := n;
    n := Round(0.5 + 223.9 * n / 65);
    BufInSize := n * 65;
  end;
end;
begin
  InitAudioVars;
end.

						