www.pudn.com > netcode58.zip > uMain.pas, change:2004-02-23,size:15002b


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.