netaudio.pas

NetPhone little VoIP program written in Delphi

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.