?? uasystem.pas
字號:
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -