u_vc_main.pas

Voice Commnucation Components for Delphi

begin
  serverAction(true);
end;

// --  --
procedure Tc_form_main.a_chat_beClientExecute(Sender: TObject);
begin
  clientAction(true);
end;

// --  --
procedure Tc_form_main.serverAction(doStart: bool);
begin
  if (doStart) then begin
    //
    clientAction(false);
    //
    ipServer.proto := f_socketProto;
    //
    codecIn.consumer := ipServer;
    ipServer.consumer := codecOut;
    //
    waveIn.open();
  end
  else begin
    //
    f_needDisableClientMemo := true;
    //
    waveIn.close();
    //
    //c_memo_remote.clear();
    //
    f_remotePass := '';	// make sure new connection will be authorized (if needed)
  end;
  //
  a_chat_beServer.enabled := not ipServer.active;
  a_chat_stop.enabled := not a_chat_beServer.enabled;
end;

// --  --
procedure Tc_form_main.clientAction(doStart: bool);
begin
  if (doStart) then begin
    //
    if (inputQuery('Enter Server address', 'Server IP address or DNS name', f_host)) then begin
      //
      serverAction(false);
      //
      ipClient.host := f_host;
      ipClient.proto := f_socketProto;
      //
      codecIn.consumer := ipClient;
      ipClient.consumer := codecOut;
      //
      f_authTakeCare := false;	// in server mode only!
      //
      waveIn.open();
    end;
  end
  else begin
    //
    f_needDisableClientMemo := true;
    //
    waveIn.close();
    //
    //c_memo_remote.clear();
  end;
  //
  a_chat_beClient.enabled := not ipClient.active;
  a_chat_stop.enabled := not a_chat_beClient.enabled;
end;

// --  --
procedure Tc_form_main.a_chat_stopExecute(Sender: TObject);
begin
  serverAction(false);
  clientAction(false);
end;

// --  --
procedure Tc_form_main.ipServerServerNewClient(sender: TObject; connectionId: Cardinal; connected: LongBool);
begin
  // should not access VCL here
  f_needEnableClientMemo := true;
  //
  msg4 := 'New client is connected';
  PostMessage(handle, WM_ADDOUTTEXT, 0, lparam(pChar(msg4)));
end;

// --  --
procedure Tc_form_main.ipClientClientConnect(sender: TObject; connectionId: Cardinal; connected: LongBool);
begin
  // do not access VCL here!
  f_needEnableClientMemo := true;
  //
  if ('' <> f_authPass) then begin
    //
    ipClient.sendText(connectionId, pw_prefix + f_authPass);
  end;
  //
  msg1 := choice(unapt_TCP = ipClient.proto, 'TCP', 'UDP') + ' client connected to ' + ipClient.host;
  PostMessage(handle, WM_ADDOUTTEXT, 0, lparam(pChar(msg1)));
end;

// --  --
procedure Tc_form_main.ipClientClientDisconnect(sender: TObject; connectionId: Cardinal; connected: LongBool);
begin
  // do not access VCL here!
  msg2 := choice(unapt_TCP = ipClient.proto, 'TCP', 'UDP') + ' client disconnected from ' + ipClient.host;
  PostMessage(handle, WM_ADDOUTTEXT, 0, lparam(pChar(msg2)));
  //
  f_needDisableClientMemo := true;
end;

// --  --
procedure Tc_form_main.c_memo_clientKeyPress(Sender: TObject; var Key: Char);
begin
  case (key) of

    #13: begin
      //
      if (ipServer.active) then begin
	//
	ipServer.sendText(ipServer.getClientConnId(0), c_memo_client.text);
	c_memo_remote.lines.add(#13#10'server > ' + c_memo_client.text);
      end
      else
	if (ipClient.active) then begin
	  //
	  ipClient.sendText(ipClient.clientConnId, c_memo_client.text);
	  c_memo_remote.lines.add(#13#10'client > ' + c_memo_client.text);
	end;
      //
      c_memo_client.clear();
      key := #0;
    end;

  end;
end;

// --  --
procedure Tc_form_main.ipClientTextData(sender: TObject; connectionId: Cardinal; const data: string);
begin
  // do not access VCL here!
  f_delayedStrings.add('server > ' + data);
end;

// --  --
procedure Tc_form_main.ipServerTextData(sender: tObject; connectionId: Cardinal; const data: string);
begin
  // do not access VCL here!
  if (1 = pos(pw_prefix, data)) then begin
    //
    f_remotePass := copy(data, length(pw_prefix) + 1, maxInt)
  end
  else
    f_delayedStrings.add('client > ' + data);
end;

// --  --
procedure Tc_form_main.mi_edit_clearRemoteClick(sender: tObject);
begin
  c_memo_remote.clear();
end;

// --  --
procedure Tc_form_main.mi_editAudio_click(sender: tObject);
begin
  if (sender is tMenuItem) then begin
    //
    with (sender as tMenuItem) do begin
      //
      waveIn.pcm_SamplesPerSec := tag;
      checked := true;
      //
      f_config.setValue('wave.samplesPerSec', tag);
      //
      checkServerClientOptions();
    end;
  end;
end;


// --  --
procedure Tc_form_main.mi_options_esdClick(sender: tObject);
begin
  mi_options_esd.checked := not mi_options_esd.checked;
  //
  f_config.setValue('wave.silenceDetectionEnabled', mi_options_esd.checked);
  //
  silenceDetectionChanged(mi_options_esd.checked);
end;

// --  --
procedure Tc_form_main.silenceDetectionChanged(isEnabled: bool);
begin
  // old school
  //waveIn.calcVolume := isEnabled;
  //
  // new school
  if (isEnabled) then
    waveIn.silenceDetectionMode := unasdm_DSP
  else
    waveIn.silenceDetectionMode := unasdm_none;
end;

// --  --
procedure Tc_form_main.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  a_chat_stopExecute(sender);
end;

// --  --
procedure Tc_form_main.mi_sockets_udpClick(Sender: TObject);
begin
  f_socketProto := unapt_UDP;
  mi_sockets_udp.checked := true;
  //
  checkServerClientOptions();
end;

// --  --
procedure Tc_form_main.mi_sockets_tcpClick(Sender: TObject);
begin
  f_socketProto := unapt_TCP;
  mi_sockets_tcp.checked := true;
  //
  checkServerClientOptions();
end;


// --  --
procedure Tc_form_main.ipServerSocketEvent(sender: TObject; connectionId: Cardinal; event: unaSocketEvent; data: Pointer; len: Cardinal);
begin
  // do not access VCL here
  //
  case (event) of

    unaseServerListen: begin
      //
      msg1 := choice(unapt_TCP = ipServer.proto, 'TCP', 'UDP') + ' server at port ' + ipServer.port + ' started.';
      PostMessage(handle, WM_ADDOUTTEXT, 0, lparam(pChar(msg1)));
    end;

    unaseServerStop: begin
      //
      msg2 := choice(unapt_TCP = ipServer.proto, 'TCP', 'UDP') + ' server ' + ipServer.port + ' stopped.';
      PostMessage(handle, WM_ADDOUTTEXT, 0, lparam(pChar(msg2)));
    end;

    unaseThreadStartupError: begin
      //
      msg3 := choice(unapt_TCP = ipServer.proto, 'TCP', 'UDP') + ' server ' + ipServer.port + ' cannot be started.';
      PostMessage(handle, WM_ADDOUTTEXT, 0, lparam(pChar(msg3)));
    end;

  end;
end;

// --  --
procedure Tc_form_main.onWMAddOutText(var msg: TMessage);
begin
  case (msg.Msg) of

    WM_ADDOUTTEXT: begin
      //
      c_memo_remote.lines.add(pChar('SYS > ' + pChar(msg.lparam)));
    end;

  end;
end;

// --  --
procedure Tc_form_main.checkServerClientOptions();
var
  restartS: bool;
  restartC: bool;
begin
  restartS := (ipServer.active and (ipServer.proto <> f_socketProto));
  restartC := (ipClient.active and (ipClient.proto <> f_socketProto));
  //
  if (restartS or restartC) then begin
    //
    a_chat_stop.execute();
    //
    if (restartS) then
      a_chat_beServer.execute();
    //
    if (restartC) then
      a_chat_beClient.execute();
  end;
end;

// --  --
procedure Tc_form_main.mi_options_authClick(Sender: TObject);
var
  pass: string;
begin
  pass := f_authPass;
  if (inputQuery('Enter Server authorization string', 'Server password: ', pass)) then begin
    //
    if (f_authPass <> trim(pass)) then begin
      //
      f_authPass := trim(pass);
      f_config.setValue('auth.pw', f_authPass);
      //
      if (ipServer.active) then begin
	//
	a_chat_stop.execute();
	a_chat_beServer.execute();
      end;
    end;
  end;
end;

// --  --
procedure Tc_form_main.ipServerAcceptClient(sender: TObject; connectionId: Cardinal; var accept: LongBool);
begin
  // check if we have to wait for proper auth from client
  f_authTakeCare := (('' <> f_authPass) and (f_authPass <> f_remotePass));
  //
  if (f_authTakeCare) then
    f_authTM := timeMark();
end;

// --  --
procedure Tc_form_main.ipServerDataSent(sender: TObject; connectionId: Cardinal; data: Pointer; len: Cardinal);
begin
  if (f_authTakeCare) then begin
    //
    ipServer.setClientOptions(0{hack, assuming we have only one client)}, 0{no in/out data allowed});
  end;
end;

// --  --
procedure Tc_form_main.ipServerServerClientDisconnect(sender: TObject; connectionId: Cardinal; connected: LongBool);
begin
  // assuming we have only one client
  f_needDisableClientMemo := true;
  //
  f_remotePass := '';	// next client will have to authorize properly
  //
  msg5 := 'Client is disconnected';
  PostMessage(handle, WM_ADDOUTTEXT, 0, lparam(pChar(msg5)));
end;


end.