netaudio.pas

NetPhone little VoIP program written in Delphi

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;