unit AdoconnectPool;
interface
uses Classes, Windows, SysUtils, ADODB, IniFiles, forms;
type TADOConnectionPool = class(TObject) private FObjList:TThreadList; FTimeout: Integer; FMaxCount: Integer; FSemaphore: Cardinal; function CreateNewInstance(List:TList): TADOConnection; function GetLock(List:TList;Index: Integer): Boolean; public property Timeout:Integer read FTimeout write FTimeout; property MaxCount:Integer read FMaxCount;
constructor Create(ACapicity:Integer=30);overload; destructor Destroy;override; function Lock: TADOConnection; procedure Unlock(var Value: TADOConnection); end;
var ConnPool: TADOConnectionPool; g_ini: TIniFile;
implementation
constructor TADOConnectionPool.Create(ACapicity:Integer=30); begin FObjList:=TThreadList.Create; FTimeout := 3000; // 3 second FMaxCount := ACapicity; FSemaphore := CreateSemaphore(nil, FMaxCount, FMaxCount, nil); end;
function TADOConnectionPool.CreateNewInstance(List:TList): TADOConnection; var p: TADOConnection; function GetConnStr: string; begin try Result := g_ini.ReadString('ado','connstr',''); except Exit; end; end; begin try p := TADOConnection.Create(nil); p.ConnectionString := GetConnStr; p.LoginPrompt := False; p.Connected:=True; p.Tag := 1; List.Add(p); Result := p; except on E: Exception do begin Result := nil; Exit; end; end; end;
destructor TADOConnectionPool.Destroy; var i: Integer; List:TList; begin List:=FObjList.LockList; try for i := List.Count - 1 downto 0 do begin TADOConnection(List[i]).Free; end; finally FObjList.UnlockList; end; FObjList.Free; FObjList := nil; CloseHandle(FSemaphore); inherited; end;
function TADOConnectionPool.GetLock(List:TList;Index: Integer): Boolean; begin try Result := TADOConnection(List[Index]).Tag = 0; if Result then TADOConnection(List[Index]).Tag := 1; except Result :=False; Exit; end; end;
function TADOConnectionPool.Lock: TADOConnection; var i: Integer; List:TList; begin try Result :=nil; if WaitForSingleObject(FSemaphore, Timeout) = WAIT_FAILED then Exit; List:=FObjList.LockList; try for i := 0 to List.Count - 1 do begin if GetLock(List,i) then begin Result := TADOConnection(List[i]); PostMessage(Application.MainForm.Handle,8888,13,0); Exit; end; end; if List.Count < MaxCount then begin Result := CreateNewInstance(List); PostMessage(Application.MainForm.Handle,8888,11,0); end; finally FObjList.UnlockList; end; except Result := nil; Exit; end; end;
procedure TADOConnectionPool.Unlock(var Value: TADOConnection); var List:TList; begin try List:=FObjList.LockList; try TADOConnection(List[List.IndexOf(Value)]).Tag :=0; ReleaseSemaphore(FSemaphore, 1, nil); finally FObjList.UnlockList; end; PostMessage(Application.MainForm.Handle, 8888, 12, 0); except Exit; end; end;
initialization ConnPool := TADOConnectionPool.Create(); g_ini := TIniFile.Create(ExtractFilePath(Application.ExeName)+'server.ini'); finalization FreeAndNil(ConnPool); FreeAndNil(g_ini);
end.
|