umain.pas

NetPhone little VoIP program written in Delphi

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls, NetAudio, DblPxyTcp, uCall, uSelIP,
  LMDCustomComponent, LMDWndProcComponent, LMDTrayIcon, Menus, LMDPopupMenu;

type
  TFormMain = class(TForm)
    BtOpen: TBitBtn;
    BtClose: TBitBtn;
    BtCall: TBitBtn;
    LbMyIP: TLabel;
    LbCaller: TLabel;
    Panel1: TPanel;
    Panel2: TPanel;
    Label3: TLabel;
    Label5: TLabel;
    EdSocksUser: TEdit;
    Label6: TLabel;
    EdSocksPass: TEdit;
    RbSocks4: TRadioButton;
    RbSocks5: TRadioButton;
    CkSocks: TCheckBox;
    CkHttp: TCheckBox;
    Label1: TLabel;
    Label7: TLabel;
    EdHttpUser: TEdit;
    Label8: TLabel;
    EdHttpPass: TEdit;
    Label9: TLabel;
    EdListenPort: TEdit;
    StatusBar: TStatusBar;
    BtStop: TBitBtn;
    CkPhone: TCheckBox;
    CkSpeaker: TCheckBox;
    ATimer: TTimer;
    SbDelayTime: TScrollBar;
    LbDelayTime: TLabel;
    BtSaveSetup: TBitBtn;
    EdSocksIP: TComboBox;
    EdHttpIP: TComboBox;
    TrayIcon: TLMDTrayIcon;
    MenuPopup: TLMDPopupMenu;
    MnDisplay: TMenuItem;
    MnHide: TMenuItem;
    N1: TMenuItem;
    MnExit: TMenuItem;
    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);
    procedure SbDelayTimeChange(Sender: TObject);
    procedure CkPhoneClick(Sender: TObject);
    procedure CkSpeakerClick(Sender: TObject);
    procedure BtSaveSetupClick(Sender: TObject);
    procedure MnDisplayClick(Sender: TObject);
    procedure MnHideClick(Sender: TObject);
    procedure MnExitClick(Sender: TObject);
  private
    { Private declarations }
    IsOpen, IsBusy: Boolean;
    Sock: TDblProxyTcpSocket;
    Listen: TAudioListenThread;
    Recv: TAudioRecvThread;
    Send: TAudioSendThread;
    FormCall: TFormCall;
    FormSelIP: TFormSelIP;
  public
    { Public declarations }
    procedure LoadConfigInfo;
    procedure SaveConfigInfo;    
    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 blcksock;
{$R *.dfm}

{$I-}
type
  PConfigInfo = ^TConfigInfo;
  TConfigInfo = packed record
    Flags: string[19];
    DelayTime: Integer;
    Port: string[31];
    ListenHttp, ListenSocks, ListenSocks4: Boolean;
    ListenSocksIP, ListenSocksUser: string[63];
    ListenHttpIP, ListenHttpUser: string[63];
    CallHttp, CallSocks, CallSocks4: Boolean;
    CallSocksIP, CallSocksUser: string[63];
    CallHttpIP, CallHttpUser: string[63];
  end;

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

procedure ParseIpPort(const addr: string; var ip, port: string);
var i: Integer;
begin
  port := addr;
  i := Pos(':', port);
  ip := Copy(port, 1, i - 1);
  Delete(port, 1, i);
end;

procedure TFormMain.LoadConfigInfo;
var p: PConfigInfo;
    f: file;
begin
  if not FileExists(ConfigFile) then Exit;
  GetMem(p, Sizeof(TConfigInfo));
  AssignFile(f, ConfigFile);
  Reset(f, 1);
  BlockRead(f, p^, Sizeof(TConfigInfo));
  if IOResult <> 0 then
  begin
    CloseFile(f);
    FreeMem(p, Sizeof(TConfigInfo));
    Exit;
  end;
  CloseFile(f);
  if p^.Flags = 'NET-IP-PHONE-CONFIG' then
  begin
    if (p^.DelayTime > 0) or (p^.DelayTime <= MAXDELAYTIME) then
    begin
      SbDelayTime.Position := p^.DelayTime;
      SetDelayTime(p^.DelayTime);
    end;
    EdListenPort.Text := p^.Port;
    CkSocks.Checked := p^.ListenSocks;
    CkHttp.Checked := p^.ListenHttp;
    RbSocks4.Checked := p^.ListenSocks4;
    RbSocks5.Checked := not p^.ListenSocks4;
    EdSocksIP.Text := p^.ListenSocksIP;
    EdSocksUser.Text := p^.ListenSocksUser;
    EdHttpIP.Text := p^.ListenHttpIP;
    EdHttpUser.Text := p^.ListenHttpUser;
    FormCall.CkSocks.Checked := p^.CallSocks;
    FormCall.CkHttp.Checked := p^.CallHttp;
    FormCall.RbSocks4.Checked := p^.CallSocks4;
    FormCall.RbSocks5.Checked := not p^.CallSocks4;
    FormCall.EdSocksIP.Text := p^.CallSocksIP;
    FormCall.EdSocksUser.Text := p^.CallSocksUser;
    FormCall.EdHttpIP.Text := p^.CallHttpIP;
    FormCall.EdHttpUser.Text := p^.CallHttpUser;
  end;
  FreeMem(p, Sizeof(TConfigInfo));
end;

procedure TFormMain.SaveConfigInfo;
var p: PConfigInfo;
    f: file;
begin
  GetMem(p, Sizeof(TConfigInfo));
  AssignFile(f, ConfigFile);
  Rewrite(f, 1);
  if IOResult <> 0 then
  begin
    ShowMessage('创建配置信息文件失败！');
    FreeMem(p, Sizeof(TConfigInfo));
    Exit;
  end;
  FillChar(p^, Sizeof(TConfigInfo), 0);
  p^.Flags := 'NET-IP-PHONE-CONFIG';
  p^.DelayTime := SbDelayTime.Position;
  p^.Port := EdListenPort.Text;
  p^.ListenSocks := CkSocks.Checked;
  p^.ListenHttp := CkHttp.Checked;
  p^.ListenSocks4 := RbSocks4.Checked;
  p^.ListenSocksIP := EdSocksIP.Text;
  p^.ListenSocksUser := EdSocksUser.Text;
  p^.ListenHttpIP := EdHttpIP.Text;
  p^.ListenHttpUser := EdHttpUser.Text;
  p^.CallSocks := FormCall.CkSocks.Checked;
  p^.CallHttp := FormCall.CkHttp.Checked;
  p^.CallSocks4 := FormCall.RbSocks4.Checked;
  p^.CallSocksIP := FormCall.EdSocksIP.Text;
  p^.CallSocksUser := FormCall.EdSocksUser.Text;
  p^.CallHttpIP := FormCall.EdHttpIP.Text;
  p^.CallHttpUser := FormCall.EdHttpUser.Text;
  BlockWrite(f, p^, Sizeof(TConfigInfo));
  if IOResult <> 0 then ShowMessage('配置信息保存失败！')
  else ShowMessage('配置信息成功保存到文件' + ConfigFile);
  CloseFile(f);
  FreeMem(p, Sizeof(TConfigInfo));
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  IsOpen := False;
  IsBusy := False;
  Sock := nil;
  Listen := nil;
  Recv := nil;
  Send := nil;
  UpdateButtons;
  FormCall := TFormCall.Create(nil);
  FormSelIP := TFormSelIP.Create(nil);  
  LoadConfigInfo;
  if FileExists(SocksProxyFile) then EdSocksIP.Items.LoadFromFile(SocksProxyFile);
  if FileExists(HttpProxyFile) then EdHttpIP.Items.LoadFromFile(HttpProxyFile);
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);
  FormCall.Free;
  FormSelIP.Free;
  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);
var ip, port: string;
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
      ParseIpPort(EdSocksIP.Text, ip, port);
      SocksIP := ip;
      SocksPort := port;
      SocksUsername := EdSocksUser.Text;
      SocksPassword := EdSocksPass.Text;
      if RbSocks5.Checked then SocksType := ST_Socks5;
    end;
    if CkHttp.Checked then
    begin
      ParseIpPort(EdHttpIP.Text, ip, port);
      HTTPTunnelIP := ip;
      HTTPTunnelPort := port;
      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);
var ip, port: string;
begin
  if FormCall.ShowModal <> mrOk then Exit;
  with FormCall do 
  begin
    IsBusy := True;
    UpdateButtons;
    Sock := TDblProxyTcpSocket.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
      ParseIpPort(EdSocksIP.Text, ip, port);
      Sock.SocksIP := ip;
      Sock.SocksPort := port;
      Sock.SocksUsername := EdSocksUser.Text;
      Sock.SocksPassword := EdSocksPass.Text;
      if RbSocks5.Checked then Sock.SocksType := ST_Socks5;
    end;
    if CkHttp.Checked then
    begin
      ParseIpPort(EdHttpIP.Text, ip, port);
      Sock.HTTPTunnelIP := ip;
      Sock.HTTPTunnelPort := port;
      Sock.HTTPTunnelUser := EdHttpUser.Text;
      Sock.HTTPTunnelPass := EdHttpPass.Text;
    end;
    ParseIpPort(EdIP.Text, ip, port);
  end;
  Recv := TAudioRecvThread.Create(Handle, Sock, tfDoConnect);
  Recv.Host := ip;
  Recv.Port := port;
  Recv.SpeakerOpen := CkSpeaker.Checked;
  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);
  Send := TAudioSendThread.Create(Handle, Sock, tfDoNothing);
  Send.PhoneOpen := CkPhone.Checked;
  Send.Resume;
  OpenAudioIn(Send.ThreadID);
  if AudioInOpened then StartAudioIn else ShowMessage('打开语音输入设备失败!');
  OpenAudioOut(Recv.ThreadID);
  if AudioOutOpened then StartAudioOut else ShowMessage('打开语音输出设备失败!');
end;

procedure TFormMain.OnClientConnect(var ms: TMessage);
var s: TDblProxyTcpSocket;
    t: TAudioRecvThread;
begin
  s := TDblProxyTcpSocket.Create;
  s.Socket := ms.WParam;
  s.GetSins;
  if IsBusy then
  begin
    t := TAudioRecvThread.Create(Handle, s, tfDoBusy);
    t.Resume;
  end
  else begin
    IsBusy := True;
    UpdateButtons;
    if MessageDlg('是否接听来电? ' + s.GetRemoteSinIP + ':' + IntToStr(s.GetRemoteSinPort),
      mtConfirmation, [mbYes,mbNo], 0) = mrYes then
    begin
      Sock := s;
      Recv := TAudioRecvThread.Create(Handle, s, tfDoAgree);
      Recv.SpeakerOpen := CkSpeaker.Checked;
      Recv.Resume;
    end
    else begin
      t := TAudioRecvThread.Create(Handle, s, tfDoRefuse);
      t.Resume;
      IsBusy := False;
      UpdateButtons;
    end;
  end;
end;

procedure TFormMain.OnStateMessage(var ms: TMessage);
var s: string;
begin
  case ms.WParam of
    mtListenStart: StatusBar.Panels[0].Text := '正在开机...';
    mtListening:
    begin
      StatusBar.Panels[0].Text := '已开机';
      s := Listen.Socket.GetLocalSinIP;
      if s <> cAnyHost then
        LbMyIP.Caption := '我的IP: ' + s + ':' + IntToStr(Listen.Socket.GetLocalSinPort)
      else LbMyIP.Caption := '我的IP: 所有本机地址:' + 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, mtRecvClose:
    begin
      Recv := nil;
      if Assigned(Send) then TerminateThread(Send)
      else DoCallFinal;
    end;
    mtSendFail, mtSendClose:
    begin
      Send := nil;
      if Assigned(Recv) then TerminateThread(Recv)
      else DoCallFinal;
    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
      begin
        if CkAll.Checked then Listen.IPIndex := LsAllIP.Count
        else Listen.IPIndex := LsAllIP.ItemIndex;
      end
      else Listen.IPIndex := -1;
    end;
    mtPeerBusy:
    begin
      DoCallFinal;
      ShowMessage('对方忙，请稍后再拨!');
    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;

procedure TFormMain.SbDelayTimeChange(Sender: TObject);
begin
  SetDelayTime(sbDelayTime.Position);
  LbDelayTime.Caption := '延时 ' + FloatToStr(0.1 * SbDelayTime.Position) + '秒'; 
end;

procedure TFormMain.CkPhoneClick(Sender: TObject);
begin
  if Assigned(Send) then Send.PhoneOpen := CkPhone.Checked;
end;

procedure TFormMain.CkSpeakerClick(Sender: TObject);
begin
  if Assigned(Recv) then Recv.SpeakerOpen := ckSpeaker.Checked;
end;

procedure TFormMain.BtSaveSetupClick(Sender: TObject);
begin
  SaveConfigInfo;
  if EdSocksIP.Items.Count > 0 then EdSocksIP.Items.SaveToFile(SocksProxyFile);
  if EdHttpIP.Items.Count > 0 then EdHttpIP.Items.SaveToFile(HttpProxyFile);
  if FormCall.EdIP.Items.Count > 0 then FormCall.EdIP.Items.SaveToFile(HistoryCall);
end;

procedure TFormMain.MnDisplayClick(Sender: TObject);
begin
  Show;
end;

procedure TFormMain.MnHideClick(Sender: TObject);
begin
  Hide;
end;

procedure TFormMain.MnExitClick(Sender: TObject);
begin
  TrayIcon.Active := False;
  Close;
end;

end.