uasystem.pas

基于Midas 技术的多层应用开发包第二版（带开发文档）

unit UASystem;

interface
uses
  Windows, Messages, SysUtils,
  Classes,AdoDb,Contnrs,Variants,
  Db,SyncObjs,IniFiles,Forms,ActiveX,
  UAUnits,UAServiceObjectPool;

type

{
 存在僵死的数据库连接对象，


}

  TMgrDbConn = class(TCustomPoolManager)
  private
    FDBName:string;
    FLoginId:string;
    FPassword:string;
    FDBServer:string;
    FIsDirty: Boolean;
    procedure SetDBName(const Value: string);
    procedure SetDBServer(const Value: string);
    procedure SetLoginId(const Value: string);
    procedure SetPassword(const Value: string);
  protected

  public

    constructor Create(iMaxCount: Integer; iTimeout: DWord);override;
    destructor Destroy; override;
    function  InternalCreateNewInstance: TCustomPoolObject; override;

    property  DBName:string read  FDBName write SetDBName;
    property  LoginId:string read FLoginId write SetLoginId;
    property  Password:string read FPassword write SetPassword;
    property  DBServer:string read FDBServer write SetDBServer;

  end;


  TUASystem_ = class(TComponent)
  private
    FLoginId:string;
    FPassword:string;
    FDBServer:string;
    procedure SetLoginId(const Value: string);
    procedure SetPassword(const Value: string);
    function  GetAccountData: variant;
    procedure SetDBServer(const Value: string);
  protected
    FMainDbConn:TAdoConnection;
    FMgrDbConnList:TObjectList;
    FAccList:TObjectList;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;Operation: TOperation); override;
    function  Init_MainDBConn:Boolean;
    function  ReadMainDbConnStr:string;
  public

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function  LockDbConn(sDBName:string):TAdoConnection;virtual;
    procedure UnLockDbConn(sDBName:string;DbConn:TAdoConnection);virtual;
    function  GetAllAccount(Sender:TObject;const bRefresh:Boolean = false):Boolean;
    //------- add by vinson zeng 2004-08-19...etc 查找僵死的数据库连接对象---------
    function  KillDbConn(sDBName:string;iIndex:integer):integer;
    //------- %% end of %% --------------------------------------------------------
    property AccountData:variant read GetAccountData;
    property MainDbConn:TAdoConnection read FMainDbConn; //2004-3-15 主数据库连接
    property LoginId:string read FLoginId write SetLoginId;
    property Password:string read FPassword write SetPassword;
    property DBServer:string read FDBServer write SetDBServer;

  end;

const
   StrDbConn =
   'Provider=SQLOLEDB.1;Persist Security Info=True;Password='''+'%s'+''''
    +';User ID=%s'+';Initial Catalog=%s'+'; Data Source= %s';


var
  G_UASystem:TUASystem_;

implementation


{ TUASystem_ }

constructor TUASystem_.Create(AOwner: TComponent);
begin
  inherited;
  FMainDbConn := TAdoConnection.Create(Self);
  FMgrDbConnList := TObjectList.Create;
  FMgrDbConnList.OwnsObjects := true;

  FAccList := TObjectList.Create;
  FAccList.OwnsObjects := true;
  
end;

destructor TUASystem_.Destroy;
begin

  FMainDbConn.Connected := false;
  FMainDbConn.Free;
  FMgrDbConnList.Free;
  FAccList.Free;
  inherited;
  
end;

function TUASystem_.GetAccountData: variant;
var
  iLength,i:integer;
  vTmp:variant;
  LAccountObj:TAccountObj;
begin

  if FAccList.Count = 0 then
    GetAllAccount(Self,true);

  iLength := FAccList.Count;
  vTmp := VarArrayCreate([0,iLength-1],varVariant);
  VarArrayLock(vTmp);
  try
    for i := 0 to iLength -1 do
    begin
      LAccountObj := TAccountObj(FAccList.Items[i]);
      vTmp[i] := VarArrayOf([LAccountObj.DBName,
                             LAccountObj.AccName,
                             LAccountObj.DCreate,
                             LAccountObj.StorePath,
                             LAccountObj.IsDisable,
                             LAccountObj.IsDefault
                             ]);
    end;
  finally
    VarArrayUnLock(vTmp);
    Result := vTmp;
  end;

end;

function TUASystem_.GetAllAccount(Sender:TObject;const bRefresh:Boolean = false): Boolean;
var
  LMgrDbConn:TMgrDbConn;
  AdoQry:TAdoQuery;
  LAccObj:TAccountObj;
  i:integer;
begin

  Result := false;

  for i := 0 to FAccList.Count -1 do //Release All AccountObj
    FAccList.Items[i].Free;
  FAccList.Clear;

  for i:= 0 to FMgrDbConnList.Count -1 do
     TMgrDbConn(FMgrDbConnList.Items[i]).Free;
  FMgrDbConnList.Clear;

  AdoQry := TAdoQuery.Create(nil);
  try
    if Init_MainDBConn then
    begin
      AdoQry.Connection := MainDbConn;
      AdoQry.Close;
      AdoQry.SQL.Clear;
      AdoQry.SQL.Add('select * from UA_Account');
      AdoQry.Open;
      if AdoQry.RecordCount <> 0 then
      begin
        AdoQry.First;
        while not AdoQry.Eof do
        begin
          LAccObj := TAccountObj.Create;
          LAccObj.DBName    := AdoQry.FieldByName('cDBName').AsString;
          LAccObj.AccName   := AdoQry.FieldByName('cAccName').AsString;
          LAccObj.DCreate   := AdoQry.FieldByName('dCreate').AsDateTime;
          LAccObj.StorePath := AdoQry.FieldByName('cStorePath').AsString;
          LAccObj.IsDisable := AdoQry.FieldByName('IsDisable').AsInteger;
          LAccObj.IsDefault := AdoQry.FieldByName('IsDefault').AsInteger;
          FAccList.Add(LAccObj);

          LMgrDbConn := TMgrDbConn.Create(3,5000); //2004-3-15 default value
          LMgrDbConn.DBName   := AdoQry.FieldByName('cDBName').AsString;
          LMgrDbConn.DBServer := Self.DBServer;
          LMgrDbConn.LoginId  := AdoQry.FieldByName('cLoginId').AsString;
          LMgrDbConn.Password := AdoQry.FieldByName('cPassword').AsString;
          FMgrDbConnList.Add(LMgrDbConn);
         AdoQry.Next;
        end;
        Result := true;
      end;
    end;
  finally
    if Assigned(AdoQry) then
    begin
      AdoQry.Connection  := nil;
      FreeAndNil(AdoQry);
    end;
  end;

end;

function TUASystem_.Init_MainDBConn: Boolean;
begin

  if MainDbConn.Connected then
   MainDbConn.Connected := false;
  try
    try
      MainDbConn.LoginPrompt := false;
      MainDbConn.ConnectionString := ReadMainDbConnStr;
      MainDbConn.IsolationLevel := ilReadCommitted;
      MainDbConn.Connected := true;
    except
      on E:Exception do
         begin
         end;
    end;
  finally
    Result := MainDbConn.Connected;
  end;

end;

function TUASystem_.KillDbConn(sDBName: string; iIndex: integer): integer;
var
  i:integer;
begin

  Result := -1;

  if trim(sDBName) = '' then Exit;
  try
    for i := 0 to FMgrDbConnList.Count -1 do
    begin
      if AnsiCompareText(TMgrDbConn(FMgrDbConnList.Items[i]).DBName,
       sDBName) = 0 then
      begin
        if Assigned(TMgrDbConn(FMgrDbConnList.Items[i]).Items[iIndex]) then
        //  FreeAndNil(TAdoConnection(TMgrDbConn(FMgrDbConnList.Items[i]).Items[iIndex]));
        Break;
      end;
    end;
  except
    on E:Exception do
       begin

       end;
  end;

end;

procedure TUASystem_.Loaded;
begin
  inherited;

end;

function TUASystem_.LockDbConn(sDBName:string): TAdoConnection;
var
  i:integer;
begin

  if trim(sDBName) = '' then Exit;
  for i := 0 to FMgrDbConnList.Count -1 do
  begin
    if AnsiCompareText(TMgrDbConn(FMgrDbConnList.Items[i]).DBName,
     sDBName) = 0 then
    begin
      try
        Result := TAdoConnection(TMgrDbConn(FMgrDbConnList.Items[i]).LockInstance);
        if not Result.Connected then // add by vinson zeng
          Result.Connected := true;
        Break;
      except
        //Rever...
      end;
    end;
  end;

end;

procedure TUASystem_.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;

end;

function TUASystem_.ReadMainDbConnStr: string;
var
  DbConn_Ini: TIniFile;
  sDB:string;
begin

  DbConn_Ini := TIniFile.Create(ExtractFilePath(Paramstr(0))+'\DbConn.ini');
  DBServer := DbConn_Ini.ReadString('Db_PARAMS', 'SERVER NAME', 'Db_Error');
  sDB := DbConn_Ini.ReadString('Db_PARAMS', 'DATABASE NAME', 'Db_Error');
  LoginId := DbConn_Ini.ReadString('Db_PARAMS', 'User NAME', 'Db_Error');
  PassWord := DbConn_Ini.ReadString('Db_PARAMS', 'PASSWORD', 'Db_Error');
  Result :=
  'Provider=SQLOLEDB.1;Persist Security Info=True;Password='''+
  PassWord+''''+';User ID='+LoginId+';Initial Catalog='+sDB+'; Data Source='+DBServer;

end;

procedure TUASystem_.SetDBServer(const Value: string);
begin
  FDBServer := Value;
end;

procedure TUASystem_.SetLoginId(const Value: string);
begin
  FLoginId := Value;
end;

procedure TUASystem_.SetPassword(const Value: string);
begin
  FPassword := Value;
end;

procedure TUASystem_.UnLockDbConn(sDBName:string;DbConn: TAdoConnection);
var
  i:integer;
begin

  if trim(sDBName) = '' then Exit;
  if DbConn = nil then Exit;
  for i := 0 to FMgrDbConnList.Count -1 do
  begin
      if AnsiCompareText(TMgrDbConn(FMgrDbConnList.Items[i]).DBName,
       sDBName) = 0 then
      begin
        try         // add by vinson zeng

          DbConn.Connected := false; // add by vinson zeng
          TMgrDbConn(FMgrDbConnList.Items[i]).UnlockInstance(TCustomPoolObject(DbConn));
          Break;
        except
          // Rever......
        end;

      end;
  end;

end;

{ TMgrDbConn }

constructor TMgrDbConn.Create(iMaxCount: Integer; iTimeout: DWord);
begin
  inherited;
end;

destructor TMgrDbConn.Destroy;
begin

  inherited;
end;


function TMgrDbConn.InternalCreateNewInstance: TCustomPoolObject;
var
  LDbConn: TAdoConnection;
begin

  try
    try
      LDbConn := TAdoConnection.Create(nil);
      LDbConn.LoginPrompt := false;
      LDbConn.ConnectionString := Format(StrDbConn,[Password,LoginId,DBName,DBServer]);;
      LDbConn.IsolationLevel := ilReadCommitted;
      LDbConn.Connected := true;
      Result := TCustomPoolObject(LDbConn);
    except
      // rever for Dirty Db Connection...... vinson zeng 2004-12-06
      Result.IsDirty := true;
    end;  
  finally

  end;

end;

procedure TMgrDbConn.SetDBName(const Value: string);
begin
  FDBName := Value;
end;

procedure TMgrDbConn.SetDBServer(const Value: string);
begin
  FDBServer := Value;
end;

procedure TMgrDbConn.SetLoginId(const Value: string);
begin
  FLoginId := Value;
end;

procedure TMgrDbConn.SetPassword(const Value: string);
begin
  FPassword := Value;
end;

initialization
   CoInitialize(nil);    //??? Ado Ole Init
   if not Assigned(G_UASystem) then
     G_UASystem := TUASystem_.Create(nil);

finalization
   if Assigned(G_UASystem) then
     FreeAndNil(G_UASystem);
 
end.