{*******************************************************}
{                                                       }
{        Midas RemoteDataModule Pooler Demo             }
{                                                       }
{*******************************************************}

unit srvrdm;

{
  This is the Remote Data Module (RDM) that is going to be pooled.
  The differences between this RDM and a regular RDM are as follows;
  1) In order to share RDMs the client must be stateless. This means that the
     all calls that come into the server, must not rely on any informatin passed
     in previous calls.
  2) The RDMs need to run in their own thread which is why the factory
     constructor is specifying tmApartment as the threading model.  tmFree or
     tmBoth could also be used if the server is written to support Free threading.
  3) This class is an internal accesible class only and is not registered in the
     registry.  All access to this object is done from the pooler object.  If
     you look in the Type Library you will see 2 different CoClasses for this
     project.  One is for this class and one is for the Pooler.
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComServ, ComObj, VCLCom, StdVcl, ActiveX, DataBkr, Server_TLB,
  Db, DBTables, Provider, Variants;

type
  TPooledRDM = class(TRemoteDataModule, IPooledRDM)
    Session1: TSession;
    Database1: TDatabase;
    Query1: TQuery;
    DataSetProvider1: TDataSetProvider;
    procedure DataSetProvider1BeforeGetRecords(Sender: TObject;
      var OwnerData: OleVariant);
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
{ Need a reference to the ClassFactory so the pooler can create instances of the
  class. }
  RDMFactory: TComponentFactory;

implementation

{$R *.dfm}

{ Since this is a stateless server, before records are fetched, the query needs
  to be positioned to the correct location. The client passes the query and the
  value of the first field for the last record it fetched.  If you are fetching
  all records then you don't need to locate the last record.  If the query
  isn't changing, then you don't need to pass the query to the server.}

// BeginExample: ProviderBeforeGetRecords
// Event: Provider.TCustomProvider.BeforeGetRecords
// BeginCode
{
This example shows the implementation of a provider BeforeGetRecords
event handler and a RemoteDataModule UpdateRegistry method.  The
complete project using this code example is in
Demos/DelphiWin32/VCLWin32/MIDAS/Pooler.
}
procedure TPooledRDM.DataSetProvider1BeforeGetRecords(Sender: TObject;
  var OwnerData: OleVariant);
begin
  try
    Query1.Close;
    Query1.SQL.Text := OwnerData[0];
    if not VarIsNull(OwnerData[1]) and not VarIsEmpty(OwnerData[1]) then
    begin
      Query1.Open;
      if not Query1.Locate(Query1.Fields[0].FieldName, OwnerData[1], []) then
        raise Exception.Create('Record not found');
      Query1.Next;
    end;
  finally
    OwnerData := NULL;
  end;
end;
// EndCode
// EndExample: ProviderBeforeGetRecords

// BeginExample: PooledRDMUpdateRegistry
// Method: DataBkr.TRemoteDataModule.UpdateRegistry
// Procedure: DataBkr.DisableSocketTransport
// Procedure: DataBkr.EnableSocketTransport
// Procedure: DataBkr.DisableWebTransport
// Procedure: DataBkr.EnableWebTransport

// BeginCode
{
The following UpdateRegistry method adjusts a pooled remote
data module accessed from a
TWebConnection component. This allows the resources of the 
data module to be freed when it is not in use, while 
optimizing the use of existing remote data modules by letting
clients share them.  The UpdateRegistry method also comments
out the calls to DisableSocketTransport and EnableSocket 
transport that are added by the Remote Data Module Wizard. 
This prevents socket-based connections, which do not provide
for a secure connection, from using the remote data module.
} 
class procedure TPooledRDM.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
  if Register then
  begin
    inherited UpdateRegistry(Register, ClassID, ProgID);
    EnableSocketTransport(ClassID);
    EnableWebTransport(ClassID);
  end else
  begin
    DisableSocketTransport(ClassID);
    DisableWebTransport(ClassID);
    inherited UpdateRegistry(Register, ClassID, ProgID);
  end;
end;
// EndCode
// EndExample: PooledRDMUpdateRegistry

initialization
  RDMFactory := TComponentFactory.Create(ComServer, TPooledRDM,
    Class_PooledRDM, ciInternal, tmApartment);
end.
