UASystem(0分)

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;
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;
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 -1do
begin
LAccountObj := TAccountObj(FAccList.Items);
vTmp := 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 -1do
//Release All AccountObj
FAccList.Items.Free;
FAccList.Clear;
for i:= 0 to FMgrDbConnList.Count -1do
TMgrDbConn(FMgrDbConnList.Items).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.Eofdo
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:Exceptiondo
begin
end;
end;
finally
Result := MainDbConn.Connected;
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 -1do
begin
if AnsiCompareText(TMgrDbConn(FMgrDbConnList.Items).DBName,
sDBName) = 0 then
begin
Result := TAdoConnection(TMgrDbConn(FMgrDbConnList.Items).LockInstance);
Break;
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 -1do
begin
if AnsiCompareText(TMgrDbConn(FMgrDbConnList.Items).DBName,
sDBName) = 0 then
begin
TMgrDbConn(FMgrDbConnList.Items).UnlockInstance(TCustomPoolObject(DbConn));
Break;
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
LDbConn := TAdoConnection.Create(nil);
LDbConn.LoginPrompt := false;
LDbConn.ConnectionString := Format(StrDbConn,[Password,LoginId,DBName,DBServer]);;
LDbConn.IsolationLevel := ilReadCommitted;
LDbConn.Connected := true;
Result := TCustomPoolObject(LDbConn);
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);
if not Assigned(G_UASystem) then
G_UASystem := TUASystem_.Create(nil);
finalization
if Assigned(G_UASystem) then
FreeAndNil(G_UASystem);

end.