u_server_rdm.pas

来自「以多个信息系统为例」· PAS 代码 · 共 90 行

unit u_server_RDM;

interface

uses
  Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
  DBClient, Server_TLB, StdVcl, Db, DBTables, Provider;

type
  TRDM_server = class(TRemoteDataModule, IRDM_server)
    Session1: TSession;
    T_custom: TTable;
    T_city: TTable;
    T_province: TTable;
    T_country: TTable;
    DP_custom: TDataSetProvider;
    Database: TDatabase;
    DP_city: TDataSetProvider;
    DP_province: TDataSetProvider;
    DP_country: TDataSetProvider;
  private
    { Private declarations }
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    procedure FilterOnCity(const CityStr: WideString; out Data: OleVariant); safecall;
    procedure FilterOnProv(const ProvStr: WideString; out Data: OleVariant); safecall;
    procedure FilterOnCoun(const CounStr: WideString; out Data: OleVariant); safecall;
    procedure NoFilter(out Data: OleVariant); safecall;
  public
  end;

var
  RDM_server: TRDM_server;

implementation

{$R *.DFM}

procedure TRDM_server.FilterOnCity(const CityStr:WideString; out Data: OleVariant);
begin
  T_custom.Filter:='CITY='''+CityStr+'''';
  T_custom.Filtered:=True;
  T_custom.Open;
  Data:=DP_custom.Data;
end;

procedure TRDM_server.FilterOnProv(const ProvStr:WideString; out Data: OleVariant);
begin
  T_custom.Filter:='PROVINCE='''+ProvStr+'''';
  T_custom.Filtered:=True;
  T_custom.Open;
  Data:=DP_custom.Data;
end;

procedure TRDM_server.FilterOnCoun(const CounStr:WideString; out Data: OleVariant);
begin
  T_custom.Filter:='PROVINCE='''+CounStr+'''';
  T_custom.Filtered:=True;
  T_custom.Open;
  Data:=DP_custom.Data;
end;

procedure TRDM_server.NoFilter(out Data: OleVariant);
begin
  T_custom.Filtered:=False;
  T_custom.Open;
  Data:=DP_custom.Data;
end;

class procedure TRDM_server.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;


initialization
  TComponentFactory.Create(ComServer, TRDM_server,
    Class_RDM_server, ciMultiInstance, tmApartment);
end.