dataserver_form.pas

Delphi三层原代码掩饰及补丁

{-----------------------------------------------------------------------------
  Unit: DataServer_form
  Author:    Aleyn.wu
  Date:      2002-05-12
  Descript: Translact Layer
-----------------------------------------------------------------------------}
unit DataServer_form;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
  DBClient, swServer2_TLB, Provider, ADODB, DB, hmUniKey,
  Variants, hmOleVariant, dmBaseModule, dmBaseService, StdVcl,
  hmClientDataSet, hmADQ, hmADC;

type
  TDataServer2 = class(TRemoteDataModule, IDataServer2)
    dspTest: TDataSetProvider;
    SqlLang: TADOQuery;
    Connection: TADOConnection;
    mdLibrary: TADOQuery;
    cdsDelta: THMClientDataSet;
    Query: THMADQ;
    Pub1: THMClientDataSet;
    Cmd: THMADC;
    Pub2: THMClientDataSet;
    Pub3: THMClientDataSet;
    procedure RemoteDataModuleCreate(Sender: TObject);
  private
    FDataBase: string;
    FUKI: string;
    FOle: THMOleVariant;
    FParams: THMOleVariant;
    FBaseService: TBaseService;
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    function DataModule(ModuleIndex: Integer; Param: OleVariant; var Data, Msg: OleVariant): WordBool; safecall;
    function Get_Database: WideString; safecall;
    procedure Set_Database(const Value: WideString); safecall;
    function DefaultModule(Param: OleVariant; var Data, Msg: OleVariant): WordBool; safecall;
    function CreateModule(const BaseService: IBaseService; ModuleIndex: integer): IBaseDataModule;
    procedure OnLoadOleData(Sender: TObject; Name: WideString);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetDefaultDatabase;
    procedure DebugText(Msg: string);
    property UKI: string read FUKI;
    property Ole: THMOleVariant read FOle;
    property OleParams: THMOleVariant read FParams;
  end;

implementation

uses MainForm_form, swModuleIndex, dmSystemService;

{$R *.DFM}

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

constructor TDataServer2.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FUKI := UniKeyInit;
  FOle := THMOleVariant.Create;
  FParams := THMOleVariant.Create;
  Connection.ConnectionString := frmDataServer.ConnectionString;
  SetDefaultDatabase;
  FBaseService := TBaseService.Create(Self);
  FBaseService.SqlLngDB:=frmDataServer.SqlLngDB;
  mdLibrary.SQL.Text := 'Select md_ID,md_moduleIndex,md_State,md_ModuleAddr from ' + LibUniKey;
  mdLibrary.Open;
  Inc(OnLineUserCount);
end;

destructor TDataServer2.Destroy;
begin
  FBaseService.Free;
  FOle.Free;
  FParams.Free;
  Dec(OnLineUserCount);
  mdLibrary.Close;
  inherited Destroy;
end;

function TDataServer2.CreateModule(const BaseService: IBaseService; ModuleIndex: integer): IBaseDataModule;
var
  Module: PModuleLibrary;
begin
  if not mdLibrary.Locate('md_ModuleIndex', ModuleIndex, []) then
    Exception.Create('狝叭竟杆更