unit MegaDemoServerMain;

{ Activate this define if you are using the demo without having Indy installed.

  Simply click "Ignore" when opening the form to have the Indy components
  remove, set the define and rebuild the demo. }

{.$DEFINE NO_INDY}
{$INCLUDE RemObjects.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Spin, Buttons, ExtCtrls, SyncObjs,

{$IFNDEF NO_INDY}
  IdBaseComponent, IdComponent,
  IdTCPServer, IdHTTPServer, uROIndyTCPServer, uROIndyHTTPServer,
{$IFDEF RemObjects_INDY10}
  IdContext,
{$ENDIF}

{$ENDIF NO_INDY}

  uROClient, uROBINMessage, uROClientIntf, uROServer,
  uROBPDXHTTPServer, uROBPDXTCPServer, uROPoweredByRemObjectsButton,
  uROSOAPMessage, uROWinMessageServer, uROEncryption,
  uROPostMessage, uROServerMultiMessage, uROXmlRpcMessage;

const
  WM_LOG_MESSAGE = WM_APP + 1;

type
{$IFNDEF NO_INDY}
{$IFDEF RemObjects_INDY10}
  TIdPeerThread = TIdContext;
{$ENDIF}
{$ENDIF NO_INDY}
  TMegaDemoServerMainForm = class(TForm)
    ROBINMessage: TROBinMessage;
    IndyHttpServer: TROIndyHTTPServer;
    Memo: TMemo;
    Label2: TLabel;
    cbUseCompression: TCheckBox;
    WinMessageServer: TROWinMessageServer;
    IndyTcpServer: TROIndyTCPServer;
    ROSOAPMessage: TROSOAPMessage;
    gbHTTP: TGroupBox;
    gbTCP: TGroupBox;
    gbWinMsg: TGroupBox;
    Label1: TLabel;
    seHTTPPort: TSpinEdit;
    seTCPPort: TSpinEdit;
    Label4: TLabel;
    eServerID: TEdit;
    bActivateHTTP: TBitBtn;
    bActivateTCP: TBitBtn;
    bActivateWinMsg: TBitBtn;
    cbWinMsgMsg: TComboBox;
    Label3: TLabel;
    Label6: TLabel;
    cbTCPMsg: TComboBox;
    Label7: TLabel;
    BpdxTcpServer: TROBPDXTCPServer;
    BpdxHttpServer: TROBPDXHTTPServer;
    RoPoweredByRemObjectsButton1: TRoPoweredByRemObjectsButton;
    Label5: TLabel;
    bDeactivateWinMsg: TBitBtn;
    bDeactivateTCP: TBitBtn;
    bDeactivateHTTP: TBitBtn;
    Label13: TLabel;
    Panel2: TPanel;
    rbBpdxHttp: TRadioButton;
    RbIndyHttp: TRadioButton;
    Panel1: TPanel;
    rbBpdxTcp: TRadioButton;
    RbIndyTcp: TRadioButton;
    Label8: TLabel;
    ROSOAPMessage1: TROSOAPMessage;
    ROBINMessage1: TROBINMessage;
    cb_Encrypt: TCheckBox;
    cb_SupportKeepAlive: TCheckBox;
    cbDisableNagle: TCheckBox;
    cbVerbose: TCheckBox;
    ROPostMessage: TROPostMessage;
    ROPostMessage1: TROPostMessage;
    ErrorMemo: TMemo;
    ROServerMultiMessage: TROServerMultiMessage;
    ROXmlRpcMessage: TROXmlRpcMessage;
    procedure FormCreate(Sender: TObject);
    procedure IndyHTTPServerConnect(AThread: TIdPeerThread);
    procedure IndyHTTPServerDisconnect(AThread: TIdPeerThread);
    procedure HttpServerAfterServerActivate(Sender: TObject);
    procedure HttpServerAfterServerDeactivate(Sender: TObject);
    procedure cbUseCompressionClick(Sender: TObject);
    procedure bActivateHTTPClick(Sender: TObject);
    procedure bActivateTCPClick(Sender: TObject);
    procedure bActivateWinMsgClick(Sender: TObject);
    procedure cbTCPMsgChange(Sender: TObject);
    procedure cbWinMsgMsgChange(Sender: TObject);
    procedure bDeactivateHTTPClick(Sender: TObject);
    procedure bDeactivateTCPClick(Sender: TObject);
    procedure bDeactivateWinMsgClick(Sender: TObject);
    procedure TcpServerAfterServerActivate(Sender: TObject);
    procedure TcpServerAfterServerDeactivate(Sender: TObject);
    procedure WinMessageServerAfterServerDeactivate(Sender: TObject);
    procedure WinMessageServerAfterServerActivate(Sender: TObject);
    procedure cb_EncryptClick(Sender: TObject);
    procedure cb_SupportKeepAliveClick(Sender: TObject);
    procedure cbDisableNagleClick(Sender: TObject);
    procedure MessageInitializeMessage(Sender: TROMessage;
      const aTransport: IROTransport; const anInterfaceName,
      aMessageName: String);
  private

    fCritical: TCriticalSection;

    procedure ActivateGroupBox(iGroupBox: TGroupBox; iActivate: boolean);
    procedure CheckStatus;
  protected
    procedure WMLog(var Message: TMessage); message WM_LOG_MESSAGE;

  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    procedure Log(const someText: string);

  end;

var
  MegaDemoServerMainForm: TMegaDemoServerMainForm;

implementation

uses MegaDemoLibrary_Intf;

{$R *.DFM}

procedure TMegaDemoServerMainForm.FormCreate(Sender: TObject);
begin
{$IFDEF NO_INDY}
  rbIndyHttp.Enabled := false;
  rbIndyTcp.Enabled := false;
{$ENDIF NO_INDY}

{$IFNDEF NO_INDY}
  // Necessary for Delphi5 since Object Inspector's limitations
  IndyHTTPServer.IndyServer.DefaultPort := 8099;
  {IndyHTTPServer.IndyServer.OnConnect := IndyHTTPServerConnect;
  IndyHTTPServer.IndyServer.OnDisconnect := IndyHTTPServerDisconnect;}

  IndyTCPServer.IndyServer.DefaultPort := 8090;
  {IndyTCPServer.IndyServer.OnConnect := IndyHTTPServerConnect;
  IndyTCPServer.IndyServer.OnDisconnect := IndyHTTPServerDisconnect;}
{$ENDIF NO_INDY}

  cb_SupportKeepAliveClick(Sender);

  // Misc
  WinMessageServer.ServerID := LibraryUID;

  seHTTPPort.Value := IndyHTTPServer.IndyServer.DefaultPort;
  seTCPPort.Value := IndyTCPServer.IndyServer.DefaultPort;
  eServerID.Text := WinMessageServer.ServerID;

  cbTCPMsg.Items.Clear;
  cbTCPMsg.Items.AddObject('Auto', ROServerMultiMessage);
  cbTCPMsg.Items.AddObject('Bin', ROBINMessage);
  cbTCPMsg.Items.AddObject('Soap', ROSOAPMessage);
  cbTCPMsg.Items.AddObject('Post', ROPOSTMessage);
  cbTCPMsg.Items.AddObject('XmlRpc', ROXmlRpcMessage);
  cbTCPMsg.ItemIndex := 0;
  cbTCPMsgChange(cbTCPMsg);

  cbWinMsgMsg.Items.AddStrings(cbTCPMsg.Items);
  cbWinMsgMsg.ItemIndex := 0;
  cbWinMsgMsgChange(cbWinMsgMsg);

  cbUseCompressionClick(cbUseCompression);
  cb_EncryptClick(cb_Encrypt);

  if (ParamCount > 0) and SameText(ParamStr(1), '/activate') then begin
    Application.ProcessMessages();
    bActivateHTTP.Click;
    bActivateTcP.Click;
    bActivateWinMsg.Click;
  end;
  CheckStatus;
end;

procedure TMegaDemoServerMainForm.Log(const someText: string);
var
  p: pChar;
begin
  if not cbVerbose.Checked then Exit;

  GetMem(p, Length(someText) + 1);
  Move(someText[1], p^, Length(someText) + 1);
  PostMessage(Handle, WM_LOG_MESSAGE, 0, integer(p));

  { Access to the VCL may only happen from within the main thread. To allow
    Log to be called from within the Service implementattion, we must ensure
    it's threadsafe.

    So instread of just addint the log message to the Memo, we'l send a
    PostMessage to the window, which wil then later be handled within the
    main thread.

    As a side benefit, the secution of the Log doe snot need to wait for this
    logging to happen (as usage of, for example, Synchronize would require),
    which will in turn make the server more respinsible for a simultaneous
    calls. }
end;

procedure TMegaDemoServerMainForm.WMLog(var Message: TMessage);
var
  p: pChar;
begin
  try
    p := pChar(Message.LParam);
    Memo.Lines.Add(p);
    Freemem(p);
  except
    on E: Exception do
      Memo.Lines.Add(E.Classname + ': ' + E.Message);
  end;
end;

procedure TMegaDemoServerMainForm.IndyHTTPServerConnect(AThread: TIdPeerThread);
begin
  Log('Client connected')
end;

procedure TMegaDemoServerMainForm.IndyHTTPServerDisconnect(AThread: TIdPeerThread);
begin
  Log('Client disconnected')
end;

procedure TMegaDemoServerMainForm.ActivateGroupBox(iGroupBox: TGroupBox; iActivate: boolean);
var
  i, j: integer;
  lPanel: TPanel;
begin
  for i := 0 to (iGroupBox.ControlCount - 1) do begin
    if not (iGroupBox.Controls[i] is TBitBtn) and
      not (iGroupBox.Controls[i] is TComboBox) and
      not ((iGroupBox.Controls[i] is TLabel) and (TLabel(iGroupBox.Controls[i]).Caption = 'Message:')) then iGroupBox.Controls[i].Enabled := iActivate;
    if (iGroupBox.Controls[i] is TPanel) then begin
      lPanel := TPanel(iGroupBox.Controls[i]);
      for j := 0 to (lPanel.ControlCount - 1) do begin
        lPanel.Controls[j].Enabled := iActivate;
      end;
    end;
  end;
end;

procedure TMegaDemoServerMainForm.HttpServerAfterServerActivate(Sender: TObject);
begin
  ActivateGroupBox(gbHttp, false);
  Log((Sender as TComponent).Name + ' has been activated...');
end;

procedure TMegaDemoServerMainForm.HttpServerAfterServerDeactivate(Sender: TObject);
begin
  ActivateGroupBox(gbHttp, true);
  Log((Sender as TComponent).Name + ' has been deactivated...');
end;

procedure TMegaDemoServerMainForm.TcpServerAfterServerActivate(Sender: TObject);
begin
  ActivateGroupBox(gbTcp, false);
  Log((Sender as TComponent).Name + ' has been activated...');
end;

procedure TMegaDemoServerMainForm.TcpServerAfterServerDeactivate(Sender: TObject);
begin
  ActivateGroupBox(gbTcp, true);
  Log((Sender as TComponent).Name + ' has been deactivated...');
end;

procedure TMegaDemoServerMainForm.WinMessageServerAfterServerActivate(Sender: TObject);
begin
  ActivateGroupBox(gbWinMsg, false);
  Log((Sender as TComponent).Name + ' has been activated...');
end;

procedure TMegaDemoServerMainForm.WinMessageServerAfterServerDeactivate(Sender: TObject);
begin
  ActivateGroupBox(gbWinMsg, true);
  Log((Sender as TComponent).Name + ' has been deactivated...');
end;

procedure TMegaDemoServerMainForm.cbUseCompressionClick(Sender: TObject);
begin
  ROBINMessage.UseCompression := cbUseCompression.Checked;
  ROBINMessage1.UseCompression := cbUseCompression.Checked;
end;

procedure TMegaDemoServerMainForm.cbTCPMsgChange(Sender: TObject);
begin
  with TComboBox(Sender) do begin
    IndyTCPServer.Dispatchers[0].Message := TROMessage(Items.Objects[ItemIndex]);
    BpdxTCPServer.Dispatchers[0].Message := TROMessage(Items.Objects[ItemIndex]);
  end;
end;

procedure TMegaDemoServerMainForm.cbWinMsgMsgChange(Sender: TObject);
begin
  with TComboBox(Sender) do
    WinMessageServer.Dispatchers[0].Message :=TROMessage(Items.Objects[ItemIndex]);
end;

procedure TMegaDemoServerMainForm.bActivateTCPClick(Sender: TObject);
begin
  if rbBpdxTcp.Checked then begin
    BpdxTCPServer.BpdxServer.ServerPort := seTCPPort.Value;
    BpdxTCPServer.Active := true;
    bDeactivateTcp.Enabled := false;
    Log('Please note that BPDX Servers cannot be deactivated once they have been activated.' +
      'This is a limitation of the BPDX Library, see the Help topic for this sample for more details.');
  end
{$IFNDEF NO_INDY}
  else begin
    IndyTCPServer.IndyServer.DefaultPort := seTCPPort.Value;
    IndyTCPServer.Active := true;
  end;
{$ENDIF NO_INDY}

  bDeactivateTcp.Visible := true;
  bActivateTcp.Visible := false;
  CheckStatus;
end;

procedure TMegaDemoServerMainForm.bDeactivateTCPClick(Sender: TObject);
begin
  bActivateTcp.Visible := true;
  bDeactivateTcp.Visible := false;

  BpdxTCPServer.Active := false;
{$IFNDEF NO_INDY}
  IndyTCPServer.Active := false;
{$ENDIF NO_INDY}
  CheckStatus;
end;

procedure TMegaDemoServerMainForm.bActivateHTTPClick(Sender: TObject);
begin
  if rbBpdxHttp.Checked then begin
    BpdxHTTPServer.BpdxServer.ServerPort := seHTTPPort.Value;
    BpdxHTTPServer.Active := true;
    bDeactivateHttp.Enabled := false;
    Log('Please note that BPDX Servers cannot be deactivated once they have been activated.' +
      'This is a limitation of the BPDX Library, see the Help topic for this sample for more details.');
  end
{$IFNDEF NO_INDY}
  else begin
    IndyHTTPServer.IndyServer.DefaultPort := seHTTPPort.Value;
    IndyHTTPServer.Active := true;
  end;
{$ENDIF NO_INDY}

  bDeactivateHttp.Visible := true;
  bActivateHttp.Visible := false;
  CheckStatus;
end;

procedure TMegaDemoServerMainForm.bDeactivateHTTPClick(Sender: TObject);
begin
  bActivateHttp.Visible := true;
  bDeactivateHttp.Visible := false;

  BpdxHTTPServer.Active := false;
{$IFNDEF NO_INDY}
  IndyHTTPServer.Active := false;
{$ENDIF NO_INDY}
  CheckStatus;
end;

procedure TMegaDemoServerMainForm.bActivateWinMsgClick(Sender: TObject);
begin
  WinMessageServer.ServerID := eServerID.Text;
  WinMessageServer.Active := true;

  bDeactivateWinMsg.Visible := true;
  bActivateWinMsg.Visible := false;
  CheckStatus;
end;

procedure TMegaDemoServerMainForm.bDeactivateWinMsgClick(Sender: TObject);
begin
  bActivateWinMsg.Visible := true;
  bDeactivateWinMsg.Visible := false;
  WinMessageServer.Active := false;
  CheckStatus;
end;

procedure TMegaDemoServerMainForm.cb_EncryptClick(Sender: TObject);
var
  lEncryption: TROEncryptionMethod;
begin
  if cb_Encrypt.Checked then lEncryption := tetDES
  else lEncryption := tetNone;

  BpdxHttpServer.Encryption.EncryptionMethod := lEncryption;
  BpdxTcpServer.Encryption.EncryptionMethod := lEncryption;
{$IFNDEF NO_INDY}
  IndyHttpServer.Encryption.EncryptionMethod := lEncryption;
  IndyTcpServer.Encryption.EncryptionMethod := lEncryption;
{$ENDIF NO_INDY}
  WinMessageServer.Encryption.EncryptionMethod := lEncryption;
end;

procedure TMegaDemoServerMainForm.cb_SupportKeepAliveClick(Sender: TObject);
begin
  BpdxHttpServer.SupportKeepAlive := cb_SupportKeepAlive.Checked;
{$IFNDEF NO_INDY}
{$IFDEF RemObjects_INDY8}
  //  IndyHttpServer.SupportKeepAlive := cb_SupportKeepAlive.Checked;
  IndyHttpServer.KeepAlive := cb_SupportKeepAlive.Checked;
{$ELSE}
  IndyHttpServer.IndyServer.KeepAlive := cb_SupportKeepAlive.Checked;
  IndyHttpServer.KeepAlive := cb_SupportKeepAlive.Checked;
{$ENDIF}
{$ENDIF NO_INDY}
end;

procedure TMegaDemoServerMainForm.cbDisableNagleClick(Sender: TObject);
begin
  IndyTcpServer.DisableNagle := cbDisableNagle.Checked
end;

constructor TMegaDemoServerMainForm.Create(aOwner: TComponent);
begin
  inherited;
  fCritical := TCriticalSection.Create;
end;

destructor TMegaDemoServerMainForm.Destroy;
begin
  fCritical.Free;
  inherited;
end;

procedure TMegaDemoServerMainForm.CheckStatus;
var
  fStatus: Boolean;
begin
  FStatus :=
    IndyHttpServer.Active or
    IndyTcpServer.Active or
    WinMessageServer.Active or
    BpdxHttpServer.Active or
    BpdxTcpServer.Active;
  if FStatus then begin
    ErrorMemo.Visible := False;
    Memo.Visible := True;
  end
  else begin
    ErrorMemo.Visible := True;
    Memo.Visible := False;
  end;
end;

procedure TMegaDemoServerMainForm.MessageInitializeMessage(
  Sender: TROMessage; const aTransport: IROTransport;
  const anInterfaceName, aMessageName: String);
begin
  Log('Request via '+Sender.ClassName);
end;

end.