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;

type
  TIniTaskFlag = (tfDoNothing, tfDoConnect, tfDoRefuse, tfDoAgree);

  TAudioListenThread = class(TThread)
  protected
    FSocket: TDblProxyTcpSocket; // TTCPBlockSocket;
    FWindow: HWND;
    FIPIndex: Integer;
    FPort: string;
  public
    constructor Create(hwin: HWND; const port: string);
    destructor Destroy; override;
    procedure Execute; override;
    property Socket: TDblProxyTcpSocket { TTCPBlockSocket } read FSocket;
    property IPIndex: Integer read FIPIndex write FIPIndex;
  end;

  TAudioBaseThread = class(TThread)
  protected
    FSocket: TDblProxyTcpSocket; // TTCPBlockSocket;
    FTask: TIniTaskFlag;
    FWindow: HWND;
    FHost, FPort: string;
  public
    constructor Create(hwin: HWND; sock: TDblProxyTcpSocket; { TTCPBlockSocket } task: TIniTaskFlag);
    function DoIniTask: Boolean;
    property Socket: TDblProxyTcpSocket { TTCPBlockSocket } read FSocket;
    property Host: string read FHost write FHost;
    property Port: string read FPort write FPort;
  end;

  TAudioRecvThread = class(TAudioBaseThread)
  public
    procedure Execute; override;
    property Socket;
    property Host;
    property Port;
  end;


  TAudioSendThread = class(TAudioBaseThread)
  public
    procedure Execute; override;
    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;

implementation

const
  WAVINBUFCOUNT  = 3;
  WAVOUTBUFCOUNT = 3;

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, BufOutSize: Integer;
    ThreadIn, ThreadOut: Cardinal;
    WavInBuf, WavOutBuf: PByteArray;

constructor TAudioListenThread.Create(hwin: HWND; const port: string);
begin
  inherited Create(True);
  FWindow := hwin;
  FPort := port;
  FIPIndex := 0;
  FSocket := TDblProxyTcpSocket.Create; // TTCPBlockSocket.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);
//  FSocket.Bind(FSocket.ResolveName(FSocket.LocalName), FPort);
  b := TStringList.Create;
  FSocket.ResolveNameToIP(FSocket.LocalName, b);
  if b.Count > 1 then
  begin
    FIPIndex := -2;
    PostMessage(FWindow, WM_STATEMESSAGE, mtMustSelIP, Integer(b));
    while FIPIndex < -1 do Sleep(100);
  end
  else FIPIndex := 0;
  if (FIPIndex < 0) or (FIPIndex >= b.Count) then
  begin
    PostMessage(FWindow, WM_STATEMESSAGE, mtListenClose, 0);
    Exit;
  end;
  a := b.Strings[FIPIndex];
  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;
        end;
      end;
    end;
  end;
  PostMessage(FWindow, WM_STATEMESSAGE, mtListenClose, 0);
end;

constructor TAudioBaseThread.Create(hwin: HWND; sock: TDblProxyTcpSocket; { TTCPBlockSocket} task: TIniTaskFlag);
begin
  inherited Create(True);
  FSocket := sock;
  FWindow := hwin;
  FTask := task;
  FHost := '';
  FPort := '';
  FreeOnTerminate := True;
end;

function TAudioBaseThread.DoIniTask: Boolean;
begin
  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($6C);
        if FSocket.RecvByte(10000) <> $C6 then
        begin
          PostMessage(FWindow, WM_STATEMESSAGE, mtRefused, 0);
          Result := False;
        end
        else begin
          PostMessage(FWindow, WM_CONNECTED, 0, 0);
          Result := True;
        end;
      end;
    end;
    tfDoRefuse:
    begin
       FSocket.SendByte(0);
       Sleep(1000);
       FSocket.Free;
       Result := False;
    end;
    tfDoAgree:
    begin
      if FSocket.RecvByte(5000) <> $6C then
      begin
        PostMessage(FWindow, WM_STATEMESSAGE, mtInvConnect, 0);
        Result := False;
        Exit;
      end;
      FSocket.SendByte($C6);
      PostMessage(FWindow, WM_CONNECTED, 0, 0);
      Result := True;
    end;
    else Result := True;
  end;
end;

procedure TAudioRecvThread.Execute;
const RECVTIMEOUT = 2000;
var n: Integer;
    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
        FSocket.RecvBufferEx(@n, Sizeof(Integer), RECVTIMEOUT);
        if FSocket.LastError = 0 then
        begin
          if n > BufOutSize then
          begin
            PostMessage(FWindow, WM_STATEMESSAGE, mtRecvFail, 0);
            Exit;
          end;
          repeat
            p := PWAVEHDR(ms.lParam);
            FSocket.RecvBufferEx(p^.lpData, n, RECVTIMEOUT);
            if FSocket.LastError = 0 then
            begin
              p^.dwFlags := 0;
              p^.dwBytesRecorded := n;
              waveOutPrepareHeader(ms.wParam, p, Sizeof(WAVEHDR));
              waveOutWrite(ms.wParam, p, Sizeof(WAVEHDR));
            end
            else if FSocket.LastError <> WSAETIMEDOUT then
            begin
              PostMessage(FWindow, WM_STATEMESSAGE, mtRecvFail, 0);
              Exit;
            end;
          until (FSocket.LastError = 0) or Terminated;
        end
        else if FSocket.LastError <> WSAETIMEDOUT then
        begin
          PostMessage(FWindow, WM_STATEMESSAGE, mtRecvFail, 0);
          Exit;
        end;
      end;
      WM_TERMINATE: Terminate;
    end; // case
  end; // while
  PostMessage(FWindow, WM_STATEMESSAGE, mtRecvClose, 0);
end;

procedure TAudioSendThread.Execute;
var n: Integer;
    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_SENDAUDIO:
      begin
        p := PWAVEHDR(ms.lParam);
        n := p^.dwBytesRecorded;
        FSocket.SendBuffer(@n, Sizeof(Integer));
        FSocket.SendBuffer(p^.lpData, n);
        p^.dwFlags := 0;
        p^.dwBytesRecorded := 0;
        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; // WAVE_FORMAT_PCM;
    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 := 1300;
  BufOutSize := 1300;
  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, BufInSize * WAVINBUFCOUNT);
  for i := 0 to WAVINBUFCOUNT - 1 do
  begin
    WavInHdr[i].lpData := @(WavInBuf^[i*BufInSize]);
    WavInHdr[i].dwBufferLength := BufInSize;
    WavInHdr[i].dwFlags := 0;
    Result := waveInPrepareHeader(DevAudioIn, @WavInHdr[i], Sizeof(WAVEHDR));
    AudioInOpen := Result = MMSYSERR_NOERROR;
    if not AudioInOpen then
    begin
      waveInClose(DevAudioIn);
      FreeMem(WavInBuf, BufInSize * 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, BufInSize * 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, BufInSize * 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, BufOutSize * WAVOUTBUFCOUNT);
  Result := waveOutOpen(@DevAudioOut, WAVE_MAPPER, @WavOutFmt, Cardinal(@WaveOutProc), 0, CALLBACK_FUNCTION);
  AudioOutOpen := Result = MMSYSERR_NOERROR;
  if not AudioOutOpen then
  begin
    FreeMem(WavOutBuf, BufOutSize * 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, BufOutSize * 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*BufOutSize]);
    WavOutHdr[i].dwBufferLength := BufOutSize;
    WavOutHdr[i].dwBytesRecorded := 0;
    WavOutHdr[i].dwFlags := 0;
    WavOutHdr[i].dwLoops := 1;
    PostThreadMessage(ThreadOut, WM_RECVAUDIO, DevAudioOut, Integer(@WavOutHdr[i]));
  end;
end;

begin
  InitAudioVars;
end.