logonbizdm.pas

物流供应链管理系统

unit LogonBizDm;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComServ, ComObj, VCLCom, StdVcl, bdemts, DataBkr, DBClient,
  MtsRdm, Mtx, LogonBiz_TLB, DB, MConnect, Variants;

type
  TmtsLogonBiz = class(TMtsDataModule, ImtsLogonBiz)
    cdsSysLog: TClientDataSet;
    DComConSysOperator: TDCOMConnection;
    cdsSysOperator: TClientDataSet;
    cdsPermissionSlave: TClientDataSet;
    DCOMConQuery: TDCOMConnection;
    procedure MtsDataModuleActivate(Sender: TObject);
    procedure MtsDataModuleDeactivate(Sender: TObject);
    procedure MtsDataModuleCreate(Sender: TObject);
  private
    { Private declarations }
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    function Logon(const AUserId, APassword, AIP: WideString;
      out APermissionList: OleVariant): WordBool; safecall;
  public
    { Public declarations }
  end;

var
  mtsLogonBiz: TmtsLogonBiz;

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

class procedure TmtsLogonBiz.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 TmtsLogonBiz.MtsDataModuleActivate(Sender: TObject);
begin
  try
    DComConSysOperator.Connected := true;
    cdsSysLog.Active := true;
    cdsSysOperator.Active := true;
    cdsPermissionSlave.Active := true;
  except
    raise Exception.Create(DCOMCONNECTERROR);
  end;
end;

procedure TmtsLogonBiz.MtsDataModuleDeactivate(Sender: TObject);
begin
  DComConSysOperator.Connected := false;
  DComConQuery.Connected := false;
end;

function TmtsLogonBiz.Logon(const AUserId, APassword, AIP: WideString;
  out APermissionList: OleVariant): WordBool;
var
  LList: TStringList;
  LPerId: Integer;
begin
  cdsSysOperator.Locate('UserId', AUserId, []);
  if cdsSysOperator.FieldByName('Password').AsString = APassword then
  begin
    result := true;
    LPerId := cdsSysOperator.FieldByName('PermissionId').AsInteger;
    try
      DComConQuery.Connected := true;
      cdsSysLog.Close;
      cdsSysLog.CommandText := 'INSERT INTO t_SysLog'+
      '(UserId, LogInDateTime, LogIp) VALUES ('+QuotedStr(AUserId)+
        ',:LogInDate,:IP)';
      cdsSysLog.Params.ParamByName('LogInDate').AsDateTime := Now();
      cdsSysLog.Params.ParamByName('IP').AsString := AIP;
      cdsSysLog.Execute;

      LList := TStringList.Create;
      cdsPermissionSlave.Close;
      cdsPermissionSlave.CommandText := 'select Func from t_PermissionSlave '+
        'where MasterId='+IntToStr(LPerId);
      cdsPermissionSlave.Open;

      while not cdsPermissionSlave.Eof do
      begin
        LList.Add(cdsPermissionSlave.FieldByName('Func').AsString);
        cdsPermissionSlave.Next;
      end;

      APermissionList := LList.Text;
      LList.Free;
      SetComplete;
    except
      SetAbort;
      raise;
    end;
  end;
end;

procedure TmtsLogonBiz.MtsDataModuleCreate(Sender: TObject);
begin
  DComConSysOperator.ComputerName := GetComputerName;
  DComConQuery.ComputerName := DComConSysOperator.ComputerName;
end;

initialization
  TComponentFactory.Create(ComServer, TmtsLogonBiz,
    Class_mtsLogonBiz, ciMultiInstance, tmApartment);
end.