⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 u_crs_main.pas

📁 Voice Commnucation Components for Delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:

(*
	----------------------------------------------

	  u_crs_main.pas - ConfRoomServer / main form
	  Voice Communicator components version 2.5

	----------------------------------------------
	  This source code cannot be used without
	  proper license granted to you as a private
	  person or an entity by the Lake of Soft, Ltd

	  Visit http://lakeofsoft.com/ for more information.

	  Copyright (c) 2001, 2007 Lake of Soft, Ltd
		     All rights reserved
	----------------------------------------------

	  created by:
		Lake, 08 Jul 2003

	  modified by:
		Lake, Jul, Dec 2003
		Lake, Jan, Feb 2004
		Lake, May 2005
		Lake, Apr 2007

	----------------------------------------------
*)

{$I unaDef.inc }

{$IFDEF DEBUG }
  {xx $DEFINE DEBUG_REPORT }	// report self test
{$ENDIF }

unit
  u_crs_main;

interface

uses
  Windows, unaTypes, unaUtils, unaClasses, unaConfServer, unaSockets, unaVcIDE, Forms,
  Classes, ActnList, ExtCtrls, StdCtrls, Controls, ComCtrls, Menus;

type
  Tc_crsForm_main = class(TForm)
    c_timer_update: TTimer;
    c_actionList_main: TActionList;
    a_srv_start: TAction;
    a_srv_stop: TAction;
    c_statusBar_main: TStatusBar;
    c_panel_clients: TPanel;
    c_panel_main: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    c_edit_port: TEdit;
    c_comboBox_connType: TComboBox;
    c_button_start: TButton;
    c_button_stop: TButton;
    c_memo_main: TMemo;
    c_checkBox_aas: TCheckBox;
    c_splitter_main: TSplitter;
    c_listBox_clients: TListBox;
    c_checkBox_okOut: TCheckBox;
    c_checkBox_okIn: TCheckBox;
    c_button_disconnect: TButton;
    a_cln_disconnect: TAction;
    c_mainMenu_main: TMainMenu;
    Server1: TMenuItem;
    Start1: TMenuItem;
    Stop1: TMenuItem;
    a_srv_exit: TAction;
    Exit1: TMenuItem;
    File1: TMenuItem;
    Client1: TMenuItem;
    Disconnect1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    N1: TMenuItem;
    SelectInstallableDriver1: TMenuItem;
    Bevel1: TBevel;
    a_srv_formatChoose: TAction;
    ChooseAudioFormat1: TMenuItem;
    c_label_format: TLabel;
    Button1: TButton;
    //
    procedure formCreate(sender: tObject);
    procedure formDestroy(sender: tObject);
    procedure formShow(sender: tObject);
    procedure formClose(sender: tObject; var action: tCloseAction);
    procedure formResize(sender: tObject);
    //
    procedure c_timer_updateTimer(Sender: TObject);
    procedure c_splitter_mainCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
    procedure c_checkBox_okInClick(Sender: TObject);
    procedure c_checkBox_okOutClick(Sender: TObject);
    //
    procedure a_cln_disconnectExecute(Sender: TObject);
    //
    procedure a_srv_startExecute(Sender: TObject);
    procedure a_srv_stopExecute(Sender: TObject);
    procedure a_srv_exitExecute(Sender: TObject);
    procedure a_srv_formatChooseExecute(Sender: TObject);
    //
    procedure SelectInstallableDriver1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    f_config: unaIniFile;
    f_server: unaConfServerClass;
    f_log: unaStringList;
    f_clients: unaStringList;
    //
    procedure addLog(const message: string);
    procedure notifyAddClient(connId: int; const addr: string);
    procedure notifyRemoveClient(connId: int);
    //
    procedure onAC(sender: tObject; connectionId: unsigned; var accept: bool);
    procedure onCE(sender: tObject; connectionId: unsigned; connected: bool);
    procedure onError(sender: tObject; code, info: int);
  public
    { Public declarations }
  end;

var
  c_crsForm_main: Tc_crsForm_main;


implementation


{$R *.dfm}

uses
  WinSock, sysUtils, MMSystem,
  unaMsAcmAPI, unaMsAcmClasses, unaVCLUtils
{$IFDEF DEBUG_REPORT }
  , u_crs_report
{$ENDIF }  
  ;

// --  --
procedure Tc_crsForm_main.formCreate(sender: tObject);
begin
  f_config := unaIniFile.create();
  f_server := unaConfServerClass.create();
  f_log := unaStringList.create();
  f_clients := unaStringList.create();
  //
  f_server.onAcceptClient := onAC;
  f_server.onClientEvent := onCE;
  f_server.onError := onError;
end;

// --  --
procedure Tc_crsForm_main.formDestroy(sender: tObject);
begin
  freeAndNil(f_server);
  freeAndNil(f_log);
  freeAndNil(f_clients);
  freeAndNil(f_config);
end;

// --  --
procedure Tc_crsForm_main.formShow(sender: tObject);
var
  waveFormat: unavclWavePipeFormatExchange;
begin
  loadControlPosition(self, f_config);
  //
  {$IFDEF DEBUG_REPORT }
  {$ELSE }
  Button1.Visible := false;
  {$ENDIF}
  //
  c_edit_port.text := f_config.get('ip.port', '17900');
  c_comboBox_connType.itemIndex := f_config.get('ip.connType', int(0));
  c_checkBox_aas.checked := f_config.get('gui.server.aas', false);
  //
  waveFormat.r_format.formatTag := f_config.get('audio.format.tag', int(c_outFormatTag));
  with waveFormat.r_format.formatOriginal do begin
    //
    pcmSamplesPerSecond := f_config.get('audio.format.rate', int(c_defSamplingRate));
    pcmBitsPerSample 	:= f_config.get('audio.format.bps', int(c_defBitsPerSample));
    pcmNumChannels 	:= f_config.get('audio.format.nc', int(c_defNumChannels));
    //
    if not (Succeeded(f_server.setAudioFormat(pcmSamplesPerSecond, pcmBitsPerSample, pcmNumChannels, waveFormat.r_format.formatTag))) then
      // set default format
      f_server.setAudioFormat();
  end;
  //
  f_server.getAudioFormat(waveFormat);
  with (waveFormat.r_format.formatOriginal) do
    c_label_format.caption := formatTag2str(waveFormat.r_format.formatTag) + ': ' + sampling2str(pcmSamplesPerSecond, pcmBitsPerSample, pcmNumChannels);
  //
{$IFDEF DEBUG }
  //
{$ELSE }
  About1Click(About1);
{$ENDIF }
  //
  if (c_checkBox_aas.checked) then
    a_srv_start.execute();
  //
  c_timer_update.enabled := true;
end;

// --  --
procedure Tc_crsForm_main.formClose(sender: tObject; var action: tCloseAction);
var
  waveFormat: unavclWavePipeFormatExchange;
begin
  c_timer_update.enabled := false;
  //
  f_config.setValue('ip.port', c_edit_port.text);
  f_config.setValue('ip.connType', c_comboBox_connType.itemIndex);
  f_config.setValue('gui.server.aas', c_checkBox_aas.checked);
  //
  f_server.getAudioFormat(waveFormat);
  with (waveFormat.r_format.formatOriginal) do begin
    //
    f_config.setValue('audio.format.rate', pcmSamplesPerSecond);
    f_config.setValue('audio.format.bps', pcmBitsPerSample);
    f_config.setValue('audio.format.nc', pcmNumChannels);
    f_config.setValue('audio.format.tag', waveFormat.r_format.formatTag);
  end;  
  //
  saveControlPosition(self, f_config);
end;

// --  --
procedure Tc_crsForm_main.c_timer_updateTimer(Sender: TObject);
var
  i: int;
  isClient: bool;
  client: string;
begin
  c_statusBar_main.panels[0].text := 'Mem: ' + int2str(ams() shr 10, 10, 3) + ' KB';
  c_statusBar_main.panels[1].text := 'Mixed: ' + int2str(f_server.mixedBytes, 10, 3) + ' bytes;  ' +
				     'Num. of Clients: ' + int2str(f_server.clientCount) + '/' + int2str(f_server.server.clientCount) + '/' + int2str(c_maxClients);
  //
  if (0 < f_log.count) then begin
    //
    c_memo_main.lines.add(f_log.get(0));
    f_log.removeByIndex(0);
  end;
  //
  if (0 < f_clients.count) then begin
    //
    client := f_clients.get(0);
    //
    case (client[1]) of

      '#': c_listBox_clients.items.add(client);

      '~': begin
	//
	client[1] := '#';
	if (0 < c_listBox_clients.items.count) then
	  for i := 0 to c_listBox_clients.items.count - 1 do
	    if (1 = pos(client, c_listBox_clients.items[i])) then begin
	      //
	      c_listBox_clients.items.delete(i);
	      break;
	    end;
      end;

    end;
    //
    f_clients.removeByIndex(0);
  end;
  //
  if (not a_srv_start.enabled and not f_server.isActive) then begin
    //
    addLog('Some problem with server startup (the port is probably already used).');
    a_srv_stop.execute();
  end;
  //
  i := c_listBox_clients.itemIndex;
  isClient := (0 <= i);
  c_checkBox_okIn.enabled := isClient;
  c_checkBox_okOut.enabled := isClient;
  a_cln_disconnect.enabled := isClient;
  //
  if (isClient) then begin
    //
    c_checkBox_okIn.checked := (0 <> (f_server.clientOptions[i] and c_unaIPServer_co_inbound));
    c_checkBox_okOut.checked := (0 <> (f_server.clientOptions[i] and c_unaIPServer_co_outbound));
  end

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -