Server



 

unit ServerMain;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ExtCtrls, RoutixRPCCOM_TLB, DelphiHelperUnit, ComObj;

 

type

  TServerMainForm = class(TForm)

    edtAddress: TLabeledEdit;

    btnStartStop: TButton;

    procedure btnStartStopClick(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private

    FServer: IServer;

    function OnAuthenticationHandler(

      const AUserName, APassword: WideString): WordBool;

    function OnRequestObjectHandler(

      const AObjectIDString: WideString): OleVariant;

  public

 

  end;

 

var

  ServerMainForm: TServerMainForm;

 

implementation

 

{$R *.dfm}

 

{ TForm1 }

 

procedure TServerMainForm.btnStartStopClick(Sender: TObject);

begin

  if Assigned(FServer) then

  begin

    FServer := nil;

    edtAddress.Enabled := True;

    btnStartStop.Caption := 'Start listening';

  end

  else

  begin

    ///  Server creation through CreateRoutixRPCServer helper-function.

    ///  With this helper-function you don't need mess with connection points

    ///  and other COM events-related staff. But you still have possibility

    ///  to use standart COM events through COM connection points if you want.

    FServer := CreateRoutixRPCServer(OnAuthenticationHandler, OnRequestObjectHandler);

    ///  In demo version specified listen address and port are ignored

    ///  and equals to '0.0.0.0:40404'! It means that incoming connections

    ///  accepted on all available in the system IP addresses.

    ///  Such behaviour can't be changed in the demo version!

    ///  Hence edtAddress.Text is ignored and exists in the code as an example

    ///  of full version usage!

    ///  In the full version you can start listening on 127.0.0.1 for example or

    ///  on any other IP address.

    FServer.StartListen(edtAddress.Text);

    edtAddress.Enabled := False;

    btnStartStop.Caption := 'Stop listening';

  end;

end;

 

procedure TServerMainForm.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  FServer := nil;

end;

 

function TServerMainForm.OnAuthenticationHandler(const AUserName,

  APassword: WideString): WordBool;

begin

  ///  In demo version result of this authentication event handler is ignored!

  ///  Any client can connect to our server without knowledge user name

  ///  and password. In other words you can't control client connections.

  ///  Any client can connect to server without user name and password!

  ///  Hence user name and password are ignored and exists in the code as an

  ///  example of full version usage!

  if (AUserName = 'RoutixUser') and (APassword = 'Secret') then

    Result := True

  else

    Result := False;

end;

 

function TServerMainForm.OnRequestObjectHandler(

  const AObjectIDString: WideString): OleVariant;

begin

  ///  Result of this event handler is ignored in demo version!

  ///  In demo version object will be created through

  ///  CreateOleObject(AObjectIDString). In othr words in demo version

  ///  you can't control objects requests. Any requested system object

  ///  will be created and returned to the client.

  ///  This code exists here as example of usage of full version.

  ///  In full version you can parse AObjectIDString, create and return

  ///  needed object to the client.

  if AObjectIDString = 'MyCustomObject' then

    Result := CreateOleObject('WScript.Shell')

  else

    ///  If you want restrict objects creation - simply return error string

    ///  and on client side exception will be raised with this error string.

    ///  (works in full version only!)

    Result := 'Unknown object requested: "' + AObjectIDString + '"!';

end;

 

end.