baseinfobizdm.pas

物流供应链管理系统

unit BaseInfoBizDm;

{$WARN SYMBOL_PLATFORM OFF}

{*********************************************************
作者：杨中科
描述：业务规则层中的小粒度对象
在使用此组件的时候，必须调用ImtsBaseInfoBiz接口的LoginMTS
（Auserid,APassword)方法登录正确才能使用这些DataSetProvider
**********************************************************}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComServ, ComObj, VCLCom, StdVcl, bdemts, DataBkr, DBClient,
  MtsRdm, Mtx, BaseInfoBiz_TLB, Provider, DB, ADODB;

type
  TmtsBaseInfoBiz = class(TMtsDataModule, ImtsBaseInfoBiz)
    ADOConnection: TADOConnection;
    ADOTVendor: TADOTable;
    dspVendor: TDataSetProvider;
    ADOTWareHouse: TADOTable;
    dspWareHouse: TDataSetProvider;
    ADOTRegion: TADOTable;
    dspRegion: TDataSetProvider;
    ADOTEmployee: TADOTable;
    dspEmployee: TDataSetProvider;
    ADOTDepartment: TADOTable;
    dspDepartment: TDataSetProvider;
    ADOTOrderPolicy: TADOTable;
    dspOrderPolicy: TDataSetProvider;
    ADOTEduLevel: TADOTable;
    dspEduLevel: TDataSetProvider;
    dspLifeSpanUnit: TDataSetProvider;
    ADOTLifeSpanUnit: TADOTable;
    ADOTWeightUnit: TADOTable;
    dspWeightUnit: TDataSetProvider;
    ADOTVolumnUnit: TADOTable;
    dspVolumnUnit: TDataSetProvider;
    ADOTCheckupGrade: TADOTable;
    dspCheckupGrade: TDataSetProvider;
    ADOTPayType: TADOTable;
    dspPayType: TDataSetProvider;
    ADOTUnit: TADOTable;
    dspUnit: TDataSetProvider;
    dspJobType: TDataSetProvider;
    ADOTJobType: TADOTable;
    dspCurrencyUnit: TDataSetProvider;
    ADOTCurrencyUnit: TADOTable;
    ADOTLogin: TADOTable;
    procedure MtsDataModuleActivate(Sender: TObject);
    procedure MtsDataModuleDeactivate(Sender: TObject);
    procedure MtsDataModuleCreate(Sender: TObject);

  private
    { Private declarations }
    FConnectionString: string;
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    function LoginMTS(const AUserId, APassword: WideString): WordBool;
      safecall;
  public
    { Public declarations }
  end;

var
  mtsBaseInfoObj: TmtsBaseInfoBiz;

implementation
uses BizDBConfig, uBizGlobal;
{$R *.DFM}

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

procedure TmtsBaseInfoBiz.MtsDataModuleActivate(Sender: TObject);
begin
  try
    ADOConnection.Connected := true;
  except
    raise Exception.Create('数据库无法连接！');
  end;
end;

procedure TmtsBaseInfoBiz.MtsDataModuleDeactivate(Sender: TObject);
begin
  ADOConnection.Connected := false;
end;

//DCOM安全性登录
function TmtsBaseInfoBiz.LoginMTS(const AUserId,
  APassword: WideString): WordBool;
var
  i, n: integer;
begin
  result := false;
  ADOTLogin.Connection := ADOConnection;
  try
    ADOTLogin.Active := true;
  except
    raise Exception.Create(Format(ERRORTABLE,[ADOTLogin.Name]));
  end;
  if ADOTLogin.Locate('UserId', AUserId,[]) then
    if ADOTLogin.FieldByName('Password').AsString = APassword then
      result := true;
  if false = result then exit;

  n := self.ComponentCount - 1;
  for i := 0 to n do
  begin
    if (self.Components[i] is TADOTable) then
      try
        (self.Components[i] as TADOTable).Active := true;
      except
        raise Exception.Create(Format(ERRORTABLE,[self.Components[i].Name]));
      end;
  end;
end;

procedure TmtsBaseInfoBiz.MtsDataModuleCreate(Sender: TObject);
begin
  FConnectionString := GetDBConnectionString;
  ADOConnection.ConnectionString := FConnectionString;
end;

initialization
  TComponentFactory.Create(ComServer, TmtsBaseInfoBiz,
    Class_mtsBaseInfoBiz, ciMultiInstance, tmApartment);
end.