关于MIDAS中数据库连接池的实现

 面是我的连接池的代码，我比较简单，还没有做计时释放的工作。  
 
constructor  TConnectionPools.Create;  
begin  
   FConnList  :=  TList.Create;  
   FCriticalSection  :=  TCriticalSection.Create;  
   FTimeout  :=  5000;  
   FMaxCount  :=  15;  
   FSemaphore  :=  CreateSemaphore(nil,  FMaxCount,  FMaxCount,  nil);  
 
end;  
 
function  TConnectionPools.CreateNewInstance:  TADOConnection;  
var  
   p:  PRemoteConnection;  
begin  
   Result  :=  nil;  
   FCriticalSection.Enter;  
   try  
       New(p);  
       p.Connection  :=  TADOConnection.Create(nil);  
       p.Connection.ConnectionString  :=  ConnectionString;  
       p.Connection.LoginPrompt  :=  False;  
       try  
           p.Connection.Open(DataBaseUser,DataBasePass);  
       except  
           p.Connection.Free;  
           Dispose(p);  
           Exit;  
       end;  
       p.InUse  :=  True;  
       FConnList.Add(p);  
       Result  :=  p.Connection;  
   finally  
       FCriticalSection.Leave;  
   end;  
end;  
 
destructor  TConnectionPools.Destroy;  
var  
   i:  Integer;  
begin  
   FCriticalSection.Free;  
   for  i  :=  0  to  FConnList.Count  -  1  do  
   begin  
       PRemoteConnection(FConnList[i]).Connection.Free;  
       Dispose(FConnList[i]);  
   end;  
   FConnList.Free;  
   CloseHandle(FSemaphore);  
   inherited  Destroy;  
end;  
 
function  TConnectionPools.GetLock(Index:  Integer):  Boolean;  
begin  
   FCriticalSection.Enter;  
   try  
       Result  :=  not  PRemoteConnection(FConnList[Index]).InUse;  
       if  Result  then  
           PRemoteConnection(FConnList[Index]).InUse  :=  True;  
   finally  
       FCriticalSection.Leave;  
   end;  
end;  
 
function  TConnectionPools.LockConnection:  TADOConnection;  
var  
   i:  Integer;  
begin  
   Result  :=  nil;  
   if  WaitForSingleObject(FSemaphore,  Timeout)  =  WAIT_FAILED  then  
       raise  Exception.Create('服务器忙，请稍候再试');  
   for  i  :=  0  to  FConnList.Count  -  1  do  
   begin  
       if  GetLock(i)  then  
       begin  
           Result  :=  PRemoteConnection(FConnList[i]).Connection;  
           Exit;  
       end;  
   end;  
   if  FConnList.Count  <  MaxCount  then  
       Result  :=  CreateNewInstance;  
   if  Result  =  nil  then  {  This  shouldn't  happen  because  of  the  sempahore  locks  }  
       raise  Exception.Create('Unable  to  lock  Connection');  
end;  
 
procedure  TConnectionPools.ReleaseLock(Index:  Integer;  
   var  Value:  TADOConnection);  
begin  
   FCriticalSection.Enter;  
   try  
       PRemoteConnection(FConnList[Index]).InUse  :=  False;  
       //Value  :=  nil;  
       ReleaseSemaphore(FSemaphore,  1,  nil);  
   finally  
       FCriticalSection.Leave;  
   end;  
end;  
 
procedure  TConnectionPools.SetConnectionString(const  Value:  string);  
begin  
   FConnectionString  :=  Value;  
end;  
 
procedure  TConnectionPools.SetDataBasePass(const  Value:  string);  
begin  
   FDataBasePass  :=  Value;  
end;  
 
procedure  TConnectionPools.SetDataBaseUser(const  Value:  string);  
begin  
   FDataBaseUser  :=  Value;  
end;  
 
procedure  TConnectionPools.UnlockConnection(var  Value:  TADOConnection);  
var  
   i:  Integer;  
begin  
   for  i  :=  0  to  FConnList.Count  -  1  do  
   begin  
       if  Value  =  PRemoteConnection(FConnList[i]).Connection  then  
       begin  
           ReleaseLock(i,  Value);  
           break;  
       end;  
   end;  
end;  
 
initialization  
   ConnectionPools  :=  TConnectionPools.Create;  
finalization  
   ConnectionPools.Free;  
end.