Guest User

Devart UniDAC Connection pooling 2

a guest
Aug 15th, 2019
181
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, MemDS, DBAccess, Uni,
  8.   Vcl.StdCtrls, Generics.Collections, SyncObjs;
  9.  
  10. type
  11.   TUniConnectionPooled = class(TUniConnection)
  12.   private
  13.     FInUse: Boolean;
  14.   public
  15.     property InUse: Boolean read FInUse write FInUse;
  16.   end;
  17.  
  18.  
  19.   TForm1 = class(TForm)
  20.     Button1: TButton;
  21.     Label1: TLabel;
  22.     procedure Button1Click(Sender: TObject);
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure FormDestroy(Sender: TObject);
  25.   private
  26.     { Private declarations }
  27.  
  28.     FPool: TObjectList<TUniConnectionPooled>;
  29.     FInUseCount: Integer;
  30.     FMaxUseCount: Integer;
  31.     FCS: TCriticalSection;
  32.  
  33.     function GetConnection(): TUniConnection;
  34.     procedure ReturnConnection(const AConn: TUniConnection);
  35.     procedure IncreasePool(const ACount: integer);
  36.     procedure OutputDebug(const AMsg: string);
  37.   public
  38.     { Public declarations }
  39.     property InUseCount: Integer read FInUseCount;
  40.   end;
  41.  
  42. var
  43.   Form1: TForm1;
  44.  
  45. implementation
  46.  
  47. {$R *.dfm}
  48.  
  49. uses Diagnostics, Threading, InterbaseUniProvider, System.TimeSpan;
  50.  
  51.  
  52. procedure SetupConnection(const AUniConn: TUniConnection);
  53. begin
  54.   AUniConn.ProviderName := 'InterBase';
  55.   AUniConn.Server :='localhost';
  56.   AUniConn.Database := 'employee';
  57.   AUniConn.Username := 'SYSDBA';
  58.   AUniConn.Password := 'masterkey';
  59.   AUniConn.LoginPrompt := False;
  60.   AUniConn.PoolingOptions.MaxPoolSize := 10;
  61.   AUniConn.PoolingOptions.MinPoolSize := 2;
  62.   AUniConn.PoolingOptions.ConnectionLifetime := 60000; // 60 seconds
  63.   AUniConn.PoolingOptions.Validate := True;
  64.   AUniConn.Pooling := True;
  65. //  AUniConn.Connect;
  66. end;
  67.  
  68.  
  69.  
  70. procedure TForm1.Button1Click(Sender: TObject);
  71. var
  72.   LIndex: Integer;
  73.   LStopWatch: TStopWatch;
  74.   LTasks: TArray<ITask>;
  75.   LWarmUpConnection: TUniConnection;
  76. begin
  77.  
  78.   LWarmUpConnection := TUniConnection.Create(nil);
  79.   try
  80.     SetupConnection(LWarmUpConnection);
  81.     LWarmUpConnection.Open;
  82.  
  83.     LStopWatch := TStopWatch.StartNew;
  84.     LTasks := [];
  85.     for LIndex := 1 to 1000 do
  86.     begin
  87.  
  88.       LTasks := LTasks + [
  89.         TTask.Run(
  90.           procedure
  91.           var
  92.             LConnection: TUniConnection;
  93.             LQuery: TUniQuery;
  94.           begin
  95.             LConnection := GetConnection();
  96.             try
  97.               LQuery := TUniQuery.Create(nil);
  98.               try
  99.                 LQuery.Connection := LConnection;
  100.                 LQuery.SQL.Text := 'select * from EMPLOYEE';
  101.  
  102.                 LQuery.Open;
  103.                 LQuery.Last;
  104.               finally
  105.                 FreeAndNil(LQuery);
  106.               end;
  107.             finally
  108.               ReturnConnection(LConnection);
  109.             end;
  110.           end
  111.         )
  112.       ];
  113.  
  114.     end;
  115.  
  116.     while not TTask.WaitForAll(LTasks, TTimeSpan.FromSeconds(1)) do
  117.     begin
  118.       Application.ProcessMessages;
  119.     end;
  120.  
  121.     LStopWatch.Stop;
  122.     Button1.Caption := LStopWatch.ElapsedMilliseconds.ToString;
  123.   finally
  124.     LWarmUpConnection.Close;
  125.     FreeAndNil(LWarmUpConnection);
  126.   end;
  127. end;
  128.  
  129. procedure TForm1.FormCreate(Sender: TObject);
  130. begin
  131.   FCS := TCriticalSection.Create;
  132.   FPool := TObjectList<TUniConnectionPooled>.Create;
  133.   FInUseCount := 0;
  134.   FMaxUseCount := 0;
  135.   IncreasePool(100);
  136. end;
  137.  
  138. procedure TForm1.FormDestroy(Sender: TObject);
  139. begin
  140.   FCS.Enter;
  141.   try
  142.     FreeAndNil(FPool);
  143.   finally
  144.     FCS.Leave;
  145.   end;
  146.  
  147.   FreeAndNil(FCS);
  148. end;
  149.  
  150. function TForm1.GetConnection: TUniConnection;
  151. var
  152.   LConnection: TUniConnectionPooled;
  153. begin
  154.   FCS.Enter;
  155.   try
  156.     Result := nil;
  157.     for LConnection in FPool do
  158.      if not LConnection.InUse then
  159.      begin
  160.        LConnection.InUse := True;
  161.        Result := LConnection;
  162.        Inc(FInUseCount);
  163.        if FInUseCount > FMaxUseCount then
  164.          FMaxUseCount := FInUseCount;
  165.  
  166.        OutputDebug('In use: ' + FInUseCount.ToString + ' Max: ' + FMaxUseCount.ToString);
  167.        Exit;
  168.      end;
  169.   finally
  170.     FCS.Leave;
  171.   end;
  172. end;
  173.  
  174. procedure TForm1.IncreasePool(const ACount: integer);
  175. var
  176.   LIndex: Integer;
  177.   LUniConnection: TUniConnectionPooled;
  178. begin
  179.   FCS.Enter;
  180.   try
  181.     for LIndex := 1 to ACount do
  182.     begin
  183.       LUniConnection := TUniConnectionPooled.Create(nil);
  184.       try
  185.         SetupConnection(LUniConnection);
  186.         FPool.Add(LUniConnection);
  187.       except
  188.         LUniConnection.Free;
  189.         raise;
  190.       end;
  191.     end;
  192.   finally
  193.     FCS.Leave;
  194.   end;
  195. end;
  196.  
  197. procedure TForm1.OutputDebug(const AMsg: string);
  198. begin
  199.   TThread.Queue(nil
  200.   , procedure
  201.     begin
  202.       Label1.Caption := AMsg;
  203.       Label1.Update;
  204.       Application.ProcessMessages;
  205.     end
  206.   );
  207. end;
  208.  
  209. procedure TForm1.ReturnConnection(const AConn: TUniConnection);
  210. var
  211.   LIndex: Integer;
  212.   LConn: TUniConnectionPooled;
  213. begin
  214.   FCS.Enter;
  215.   try
  216.     LConn := AConn as TUniConnectionPooled;
  217.     LIndex := FPool.IndexOf(LConn);
  218.     if LIndex <> -1 then
  219.     begin
  220.       FPool[LIndex].InUse := False;
  221.       Dec(FInUseCount);
  222.     end;
  223.   finally
  224.     FCS.Leave;
  225.   end;
  226. end;
  227.  
  228. end.
RAW Paste Data