umain.pas

一个用于网上通信的网络电话

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls, NetAudio, DblPxyTcp;

type
  TFormMain = class(TForm)
    BtOpen: TBitBtn;
    BtClose: TBitBtn;
    BtCall: TBitBtn;
    LbMyIP: TLabel;
    LbCaller: TLabel;
    Panel1: TPanel;
    Panel2: TPanel;
    Label3: TLabel;
    EdSocksIP: TEdit;
    Label4: TLabel;
    EdSocksPort: TEdit;
    Label5: TLabel;
    EdSocksUser: TEdit;
    RbSocks4: TRadioButton;
    RbSocks5: TRadioButton;
    CkSocks: TCheckBox;
    CkHttp: TCheckBox;
    Label1: TLabel;
    EdHttpIP: TEdit;
    Label2: TLabel;
    EdHttpPort: TEdit;
    Label7: TLabel;
    EdHttpUser: TEdit;
    Label9: TLabel;
    EdListenPort: TEdit;
    StatusBar: TStatusBar;
    BtStop: TBitBtn;
    CkPhone: TCheckBox;
    CkSpeaker: TCheckBox;
    ATimer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BtOpenClick(Sender: TObject);
    procedure BtCloseClick(Sender: TObject);
    procedure BtCallClick(Sender: TObject);
    procedure BtStopClick(Sender: TObject);
    procedure ATimerTimer(Sender: TObject);
  private
    { Private declarations }
    IsOpen, IsBusy: Boolean;
    Sock: TDblProxyTcpSocket; // TTCPBlockSocket;
    Listen: TAudioListenThread;
    Recv: TAudioRecvThread;
    Send: TAudioSendThread;
  public
    { Public declarations }
    procedure DoCallFinal;
    procedure DoListenFinal;
    procedure UpdateButtons;
    procedure OnConnected(var ms: TMessage); message WM_CONNECTED;
    procedure OnClientConnect(var ms: TMessage); message WM_CLIENTCONNECT;
    procedure OnStateMessage(var ms: TMessage); message WM_STATEMESSAGE;
  end;

var
  FormMain: TFormMain;

implementation
uses uCall, uSelIP, blcksock;
{$R *.dfm}

procedure TerminateThread(thread: TThread);
begin
  if Assigned(thread) then
  begin
    thread.Terminate;
    try PostMessage(thread.ThreadID, WM_TERMINATE, 0, 0);
    except end;
  end;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  IsOpen := False;
  IsBusy := False;
  Sock := nil;
  Listen := nil;
  Recv := nil;
  Send := nil;
  UpdateButtons;
end;

procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ATimer.Enabled := False;
  CloseAudioIn;
  CloseAudioOut;
  if Assigned(Listen) then Listen.Terminate;
  if Assigned(Recv) then TerminateThread(Recv);
  if Assigned(Send) then TerminateThread(Send);
  if Assigned(Sock) then Sock.Free;
  Action := caFree;
end;

procedure TFormMain.UpdateButtons;
begin
  BtOpen.Enabled := not IsOpen;
  BtCall.Enabled := not IsBusy;
  BtClose.Enabled := IsOpen;
  BtStop.Enabled := IsBusy;
end;

procedure TFormMain.BtOpenClick(Sender: TObject);
begin
  IsOpen := True;
  UpdateButtons;
  Listen := TAudioListenThread.Create(Handle, EdListenPort.Text);
  with Listen.Socket do
  begin
    SocksIP := '';
    SocksPort := '';
    SocksUsername := '';
    SocksPassword := '';
    SocksTimeout := 60000;
    SocksType := ST_Socks4;
    HTTPTunnelIP := '';
    HTTPTunnelPort := '';
    HTTPTunnelUser := '';
    HTTPTunnelPass := '';
    HTTPTunnelTimeout := 60000;
    if CkSocks.Checked then
    begin
      SocksIP := EdSocksIP.Text;
      SocksPort := EdSocksPort.Text;
      SocksUsername := EdSocksUser.Text;
      SocksPassword := EdSocksPass.Text;
      if RbSocks5.Checked then SocksType := ST_Socks5;
    end;
    if CkHttp.Checked then
    begin
      HTTPTunnelIP := EdHttpIP.Text;
      HTTPTunnelPort := EdHttpPort.Text;
      HTTPTunnelUser := EdHttpUser.Text;
      HTTPTunnelPass := EdHttpPass.Text;
    end;
  end;
  Listen.Resume;
end;

procedure TFormMain.BtCloseClick(Sender: TObject);
begin
  if Assigned(Listen) then
  begin
    BtClose.Enabled := False;
    Listen.Terminate;
  end;
end;

procedure TFormMain.BtCallClick(Sender: TObject);
begin
  if FormCall.ShowModal <> mrOk then Exit;
  with FormCall do 
  begin
    IsBusy := True;
    UpdateButtons;
    Sock := TDblProxyTcpSocket.Create; // TTCPBlockSocket.Create;
    Sock.SocksIP := '';
    Sock.SocksPort := '';
    Sock.SocksUsername := '';
    Sock.SocksPassword := '';
    Sock.SocksTimeout := 30000;
    Sock.SocksType := ST_Socks4;
    Sock.HTTPTunnelIP := '';
    Sock.HTTPTunnelPort := '';
    Sock.HTTPTunnelUser := '';
    Sock.HTTPTunnelPass := '';
    Sock.HTTPTunnelTimeout := 30000;
    if CkSocks.Checked then
    begin
      Sock.SocksIP := EdSocksIP.Text;
      Sock.SocksPort := EdSocksPort.Text;
      Sock.SocksUsername := EdSocksUser.Text;
      Sock.SocksPassword := EdSocksPass.Text;
      if RbSocks5.Checked then Sock.SocksType := ST_Socks5;
    end;
    if CkHttp.Checked then
    begin
      Sock.HTTPTunnelIP := EdHttpIP.Text;
      Sock.HTTPTunnelPort := EdHttpPort.Text;
      Sock.HTTPTunnelUser := EdHttpUser.Text;
      Sock.HTTPTunnelPass := EdHttpPass.Text;
    end;
  end;
  Recv := TAudioRecvThread.Create(Handle, Sock, tfDoConnect);
  Recv.Host := FormCall.EdIP.Text;
  Recv.Port := FormCall.EdPort.Text;
  Recv.Resume;
end;

procedure TFormMain.BtStopClick(Sender: TObject);
begin
  BtStop.Enabled := False;
  CloseAudioIn;
  CloseAudioOut;
  if Assigned(Recv) then TerminateThread(Recv);
  if Assigned(Send) then TerminateThread(Send);
  if Assigned(Sock) then Sock.CloseSocket;
end;

procedure TFormMain.OnConnected(var ms: TMessage);
begin
  ATimer.Enabled := True;
  StatusBar.Panels[1].Text := '通话中...';
  LbCaller.Caption := '对方IP: ' + Sock.GetRemoteSinIP + ':' + IntToStr(Sock.GetRemoteSinPort);
  if CkPhone.Checked then
  begin
    Send := TAudioSendThread.Create(Handle, Sock, tfDoNothing);
    Send.Resume;
    OpenAudioIn(Send.ThreadID);
    if AudioInOpened then StartAudioIn
    else ShowMessage('打开语音输入设备失败!');
  end
  else Send := nil;
  if CkSpeaker.Checked then
  begin
    OpenAudioOut(Recv.ThreadID);
    if AudioOutOpened then StartAudioOut
    else ShowMessage('打开语音输出设备失败!');
  end;
end;

procedure TFormMain.OnClientConnect(var ms: TMessage);
var s: TDblProxyTcpSocket; // TTCPBlockSocket;
    t: TAudioRecvThread;
begin
  s := TDblProxyTcpSocket.Create; // TTCPBlockSocket.Create;
  s.Socket := ms.WParam;
  s.GetSins;
  if IsBusy then
  begin
    t := TAudioRecvThread.Create(Handle, s, tfDoRefuse);
    t.Resume;
  end
  else begin
    IsBusy := True;
    UpdateButtons;
    Sock := s;
    Recv := TAudioRecvThread.Create(Handle, s, tfDoAgree);
    Recv.Resume;
  end;
end;

procedure TFormMain.OnStateMessage(var ms: TMessage);
begin
  case ms.WParam of
    mtListenStart: StatusBar.Panels[0].Text := '正在开机...';
    mtListening:
    begin
      StatusBar.Panels[0].Text := '已开机';
      LbMyIP.Caption := '我的IP: ' + Listen.Socket.GetLocalSinIP + ':'
        + IntToStr(Listen.Socket.GetLocalSinPort);
    end;
    mtListenFail:
    begin
      DoListenFinal;
      ShowMessage('开机失败!');
    end;
    mtListenClose: DoListenFinal;
    mtConnecting: StatusBar.Panels[1].Text := '正在连接...';
    mtConnectFail:
    begin
      Recv := nil;
      DoCallFinal;
      ShowMessage('连接失败!');
    end;
    mtRecvFail:
    begin
      Recv := nil;
      if not Assigned(Send) then DoCallFinal
      else TerminateThread(Send);
    end;
    mtRecvClose:
    begin
      Recv := nil;
      if not Assigned(Send) then DoCallFinal
      else TerminateThread(Send);
    end;
    mtSendClose:
    begin
      Send := nil;
      if not Assigned(Recv) then DoCallFinal
      else TerminateThread(Recv);
    end;
    mtRefused:
    begin
      DoCallFinal;
      ShowMessage('对方忙，请稍后再拨!');
    end;
    mtInvConnect: DoCallFinal;
    mtMustSelIP:
    with FormSelIP do
    begin
      LsAllIP.Items.Assign(TStringList(ms.LParam));
      LsAllIP.ItemIndex := 0;
      LbMySelIP.Caption := '我的选择是: ' + LsAllIP.Items[LsAllIP.ItemIndex];
      if ShowModal = mrOk then Listen.IPIndex := LsAllIP.ItemIndex
      else Listen.IPIndex := -1;
    end;
  end;
end;

procedure TFormMain.DoCallFinal;
begin
  CloseAudioIn;
  CloseAudioOut;
  ATimer.Enabled := False;
  Sock.Free;
  Sock := nil;
  IsBusy := False;
  UpdateButtons;
  StatusBar.Panels[1].Text := '没有连接';
  LbCaller.Caption := '对方IP: 无';
end;

procedure TFormMain.DoListenFinal;
begin
  Listen := nil;
  IsOpen := False;
  UpdateButtons;
  StatusBar.Panels[0].Text := '就绪';
  LbMyIP.Caption := '我的IP: 无';
end;

procedure TFormMain.ATimerTimer(Sender: TObject);
begin
  if Assigned(Sock) then
  begin
    StatusBar.Panels[2].Text := '收到: ' + IntToStr(Sock.RecvCounter)
      + '    发送: ' + IntToStr(Sock.SendCounter);
  end;
end;

end.