www.pudn.com > netcode58.zip > NetAudio.pas, change:2004-02-23,size:16998b


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.