Delphi 데이터베이스 연결 탱크 원본 코드
4468 단어 Delphi
unit THighlander_rtcDatabasePool;
// RTC SDK Test proyect
// freeware
// Font used in Delphi IDE = Fixedsys
{
Database parameters:
Set before first call to AddDBConn or GetDBConn.
Put a database connection back into the pool.
Need to call this after you e done using the connection.
GetDBConn = Get database connection from the pool.
Need to call this after you e done using the connection.
CloseAllDBConns = Close all connections inside the Pool.
}
interface
uses
// From CodeGear
Classes, SysUtils,
// From RealThinClient
rtcSyncObjs;
type
THL_RTC_DBPool = class
private
CS : TRtcCritSec;
fDBPool : TList;
protected
function SetUpDB : TComponent; virtual; abstract;
function InternalGetDBConn : TComponent;
function GetCount : integer;
procedure InternalPutDBConn(conn : TComponent );
public
db_server : ansistring;
db_username : ansistring;
db_password : ansistring;
property Count : integer read GetCount;
constructor Create;
destructor Destroy; override;
procedure AddDBConn;
procedure CloseAllDBConns ;
end;
implementation
constructor THL_RTC_DBPool.Create;
begin
inherited Create;
CS := TRtcCritSec.Create;
fDBPool := TList.Create;
end;
Function THL_RTC_DBPool.GetCount : integer;
begin
result := fDBPool.Count;
end;
destructor THL_RTC_DBPool.Destroy;
begin
CloseAllDBConns;
fDBPool.Free;
CS.Free;
inherited;
end;
procedure THL_RTC_DBPool.AddDBConn;
begin
CS.Enter;
try
fDBPool.Add(SetUpDB);
finally
CS.Leave;
end;
end;
Function THL_RTC_DBPool.InternalGetDBConn : TComponent;
begin
Result := nil;
CS.Enter;
try
if fDBPool.Count > 0 then begin
Result := fDBPool.items[fDBPool.Count-1];
fDBPool.Delete(fDBPool.Count-1);
end;
finally
CS.Leave;
end;
end;
procedure THL_RTC_DBPool.InternalPutDBConn(conn : tcomponent) ;
begin
CS.Enter;
try
fDBPool.Add(conn);
finally
CS.Leave;
end;
end;
procedure THL_RTC_DBPool.CloseAllDBConns;
var i : integer;
dbx : tComponent;
begin
CS.Enter;
try
for i := 0 to fDBPool.count - 1 do begin
dbx := fDBPool.items[i];
FreeAndNil(dbx);
end;
fDBPool.clear;
finally
CS.Leave;
end;
end;
end.
2. THLRTC_DBPool에서 상속 생성 THLRTC_IBXDBPoll 연결 풀
unit THighlander_rtcIBXDatabasePool;
// RTC SDK Test proyect
// freeware
// Font used in Delphi IDE = Fixedsys
interface
uses
// From CodeGear
Classes, SysUtils,
// Classes and Components for accessing Interbase from Codegear
IBDatabase,
// From RealThinClient
rtcSyncObjs,
// Dennis Ortiz rtc DBPool version;
THighlander_rtcDatabasePool;
type THL_RTC_IBXDBPoll = class(THL_RTC_DBPool)
protected
function SetUpDB : TComponent; override;
public
function GetDBConn : TIBDatabase;
procedure PutDBConn(conn : TIBDatabase);
end;
implementation
function THL_RTC_IBXDBPoll.SetUpDB : Tcomponent;
var pIBXTrans : TIBTransaction;
begin
Result := TIBDatabase.Create(nil);
try
tIBDatabase(result).DatabaseName := db_server;
tIBDatabase(result).LoginPrompt := false;
pIBXTrans := TIBTransaction.Create(tIBDatabase(result));
pIBXTrans.Params.Clear;
pIbxTrans.Params.Add('read_committed');
pIbxTrans.Params.Add('rec_version');
pIbxTrans.Params.Add('nowait');
tIBDatabase(result).DefaultTransaction := pIBXTrans;
tIBDatabase(result).Params.Clear;
tIBDatabase(result).Params.add('user_name='+db_UserName);
tIBDatabase(result).Params.add('password='+db_Password);
tIBDatabase(result).Open;
except
FreeAndNil(Result);
raise;
end;
end;
function THL_RTC_IBXDBPoll.GetDBConn : TIBDatabase;
begin
result := TIBDatabase(InternalGetDBConn);
if Result = nil then begin
Result := TIBDatabase(SetupDB);
end else if not Result.Connected then begin
Result.Free;
Result := TIBDatabase(SetupDB);
end;
end;
procedure THL_RTC_IBXDBPoll.PutDBConn(conn : tIBDatabase);
begin
if conn is tIBDatabase then InternalPutDBConn(conn);
end;
end.
소스:http://www.realthinclient.com/sdkarchive/index9f38.html?cmd=viewtopic&topic_id=11§ion_id=23&sid=
이 내용에 흥미가 있습니까?
현재 기사가 여러분의 문제를 해결하지 못하는 경우 AI 엔진은 머신러닝 분석(스마트 모델이 방금 만들어져 부정확한 경우가 있을 수 있음)을 통해 가장 유사한 기사를 추천합니다:
[Delphi] TStringBuilder그리고 꼭 사용해야만 할까? 그림처럼 Heap 영역에 "Hello" 공간을 생성하고 포인팅을 한다. "Hello World" 공간을 새로 생성한 후 포인팅을 하게 된다. 결국 "Hello" 라는 String 객체가 ...
텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
CC BY-SA 2.5, CC BY-SA 3.0 및 CC BY-SA 4.0에 따라 라이센스가 부여됩니다.