Componentes.Terceros.RemObjects/internal/5.0.23.613/1/RemObjects SDK for Delphi/Samples/Multi Channel/MultiChannel_ServerMain.pas

unit MultiChannel_ServerMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  uROClientIntf, SyncObjs, uROBPDXHTTPServer, uROBPDXTCPServer,
  uROIndyUDPServer, uROSuperTCPServer, uROIndyTCPServer, uROIndyHTTPServer,
  uRONamedPipeServer, uROClient, uROServer, uROWinMessageServer,
  uROBinMessage, StdCtrls, uROPoweredByRemObjectsButton;

type
  TMultiChannel_ServerMainForm = class(TForm)
    ROPoweredByRemObjectsButton1: TROPoweredByRemObjectsButton;
    ROBinMessage: TROBinMessage;
    WinMessageServer: TROWinMessageServer;
    NamedPipeServer: TRONamedPipeServer;
    IndyHTTPServer: TROIndyHTTPServer;
    IndyTCPServer: TROIndyTCPServer;
    SuperTcpServer: TROSuperTcpServer;
    IndyUDPServer: TROIndyUDPServer;
    BPDXTCPServer: TROBPDXTCPServer;
    BPDXHTTPServer: TROBPDXHTTPServer;
    Memo: TMemo;
    cbIndyHTTPServer: TCheckBox;
    cbBPDXHttpServer: TCheckBox;
    cbSuperTcpServer: TCheckBox;
    cbIndyTcpServer: TCheckBox;
    cbBPDXTcpServer: TCheckBox;
    cbIndyUdpServer: TCheckBox;
    cbNamedPipeServer: TCheckBox;
    cbWinMessageServer: TCheckBox;
    ErrorMemo: TMemo;
    procedure ROBinMessageInitializeMessage(Sender: TROMessage;
      const aTransport: IROTransport; const anInterfaceName,
      aMessageName: string);
    procedure stub(aStream: TStream);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure cbIndyHTTPServerClick(Sender: TObject);
    procedure cbBPDXHttpServerClick(Sender: TObject);
    procedure cbSuperTcpServerClick(Sender: TObject);
    procedure cbIndyTcpServerClick(Sender: TObject);
    procedure cbBPDXTcpServerClick(Sender: TObject);
    procedure cbLocalServerClick(Sender: TObject);
    procedure cbIndyUdpServerClick(Sender: TObject);
    procedure cbNamedPipeServerClick(Sender: TObject);
    procedure cbWinMessageServerClick(Sender: TObject);
    procedure EmailServerException(aSender: TObject;
      aExceptionClass: TClass; const aExceptionMessage: string);
  private
    { Private declarations }
    CriticalSection: tCriticalSection;
    procedure ActivateServer(Server: TROServer; Mode: Boolean);
  public
    procedure Log(Astr: string);
    { Public declarations }
  end;

var
  MultiChannel_ServerMainForm: TMultiChannel_ServerMainForm;

implementation
uses Dialogs;
{$R *.dfm}

procedure TMultiChannel_ServerMainForm.Log(Astr: string);
begin
  CriticalSection.Enter;
  try
    Memo.Lines.Add(Astr);
  finally
    CriticalSection.Leave;
  end;
end;

procedure TMultiChannel_ServerMainForm.ROBinMessageInitializeMessage(
  Sender: TROMessage; const aTransport: IROTransport;
  const anInterfaceName, aMessageName: string);
begin
  Log('Connect via ' + Tobject(aTransport.GetTransportObject).ClassName);
  Log(anInterfaceName + ':'#9 + StringReplace(aMessageName, 'Response', '', []));
  Log('');
end;

procedure TMultiChannel_ServerMainForm.stub(aStream: TStream);
begin
  //  stub for prevention of a error
end;

procedure TMultiChannel_ServerMainForm.FormCreate(Sender: TObject);
begin
  CriticalSection := TCriticalSection.Create;
end;

procedure TMultiChannel_ServerMainForm.FormDestroy(Sender: TObject);
begin
  CriticalSection.Free;
end;

procedure TMultiChannel_ServerMainForm.cbIndyHTTPServerClick(
  Sender: TObject);
begin
  ActivateServer(IndyHTTPServer, TCheckBox(Sender).Checked);
end;

procedure TMultiChannel_ServerMainForm.cbBPDXHttpServerClick(
  Sender: TObject);
begin
  ActivateServer(BPDXHttpServer, TCheckBox(Sender).Checked);
end;

procedure TMultiChannel_ServerMainForm.cbSuperTcpServerClick(
  Sender: TObject);
begin
  ActivateServer(SuperTcpServer, TCheckBox(Sender).Checked);
end;

procedure TMultiChannel_ServerMainForm.cbIndyTcpServerClick(
  Sender: TObject);
begin
  ActivateServer(IndyTcpServer, TCheckBox(Sender).Checked);
end;

procedure TMultiChannel_ServerMainForm.cbBPDXTcpServerClick(
  Sender: TObject);
begin
  ActivateServer(BPDXTcpServer, TCheckBox(Sender).Checked);
end;

procedure TMultiChannel_ServerMainForm.cbLocalServerClick(Sender: TObject);
begin
  Log('This server can be tested only on client side.')
end;

procedure TMultiChannel_ServerMainForm.cbIndyUdpServerClick(
  Sender: TObject);
begin
  ActivateServer(IndyUdpServer, TCheckBox(Sender).Checked);
end;

procedure TMultiChannel_ServerMainForm.cbNamedPipeServerClick(
  Sender: TObject);
begin
  ActivateServer(NamedPipeServer, TCheckBox(Sender).Checked);
end;

procedure TMultiChannel_ServerMainForm.cbWinMessageServerClick(
  Sender: TObject);
begin
  ActivateServer(WinMessageServer, TCheckBox(Sender).Checked);
end;

procedure TMultiChannel_ServerMainForm.ActivateServer(Server: TROServer;
  Mode: Boolean);
begin
  Server.Active := Mode;
  Memo.Visible :=
    WinMessageServer.Active or
    NamedPipeServer.Active or
    IndyHTTPServer.Active or
    IndyTCPServer.Active or
    SuperTcpServer.Active or
    IndyUDPServer.Active or
    BPDXTCPServer.Active or
    BPDXHTTPServer.Active;
  ErrorMemo.Visible := not Memo.Visible;
  if Server.Active then
    Log(Server.Name + ' is activated!')
  else
    Log(Server.Name + ' is deactivated!');
  Log('');
end;

procedure TMultiChannel_ServerMainForm.EmailServerException(
  aSender: TObject; aExceptionClass: TClass;
  const aExceptionMessage: string);
begin
  ShowMessage('There was a problem in the Email Server Thread:'#13#13 + aExceptionClass.ClassName + ': ' + aExceptionMessage);
end;

end.