
//////////////////////////////////////////////////
//  SQL Server Data Access Components
//  Copyright © 1998-2014 Devart. All right reserved.
//////////////////////////////////////////////////

{$IFNDEF CLR}

{$I Sdac.inc}

unit MSConnectionPoolUni;

{$ENDIF}

interface

uses
{$IFDEF VER6P}
  Variants,
{$ENDIF}
  Classes, CRConnectionPool, CRAccess, CRTypes, DASQLMonitor,
{$IFNDEF UNIDACPRO}
  OLEDBAccess;
{$ELSE}
  OLEDBAccessUni;
{$ENDIF}

type
  TMSConnectionParameters = class(TCRConnectionParameters)
  protected
    procedure AssignTo(Dest: TPersistent); override;
    function ConnectParamsToString: string; override;

  public
    Database: string;
    Port: integer;
    IsolationLevel: TCRIsolationLevel;
    Authentication: TMSAuthentication;
    Provider: TOLEDBProvider;
    CompactVersion: TCompactVersion;
    NativeClientVersion: TNativeClientVersion;

    QuotedIdentifier: boolean;
    Language: string;
    Encrypt: boolean;
    PersistSecurityInfo: boolean;
    AutoTranslate: boolean;
    NetworkLibrary: string;
    ApplicationName: string;
    WorkstationID: string;
    PacketSize: integer;
    TrustServerCertificate: boolean;
    ForceCreateDatabase: boolean;
    ApplicationIntent: TApplicationIntent;

    function Equals(Obj: TCRConnectionParameters): boolean; override;
    function SetProp(Prop: integer; const Value: variant): boolean; override;
  end;

  TMSLocalConnectionPool = class(TCRLocalConnectionPool)
  protected
    function CreateNewConnector: TCRConnection; override;
  end;


  TMSConnectionPoolManager = class(TCRConnectionPoolManager)
  protected
    function CreateCRConnectionPool(ConnectionParameters: TCRConnectionParameters): TCRConnectionPool; override;
  public
    class procedure Clear;  {$IFDEF CLR}static;{$ENDIF}
    class function GetConnection(ConnectionParameters: TCRConnectionParameters; SQLMonitorClass: TDASQLMonitorClass): TCRConnection; override;
  end;

implementation

uses
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
  SysUtils, SyncObjs, CRFunctions, MemData;

var
  ConnectionPoolManager: TMSConnectionPoolManager;
  LockPoolManagerCreate: TCriticalSection;

{ TMSConnectionParameters}

procedure TMSConnectionParameters.AssignTo(Dest: TPersistent);
begin
  if Dest is TMSConnectionParameters then begin
    TMSConnectionParameters(Dest).Database := Database;
    TMSConnectionParameters(Dest).Port := Port;
    TMSConnectionParameters(Dest).IsolationLevel := IsolationLevel;
    TMSConnectionParameters(Dest).Authentication := Authentication;
    TMSConnectionParameters(Dest).Provider := Provider;
    TMSConnectionParameters(Dest).CompactVersion := CompactVersion;
    TMSConnectionParameters(Dest).NativeClientVersion := NativeClientVersion;

    TMSConnectionParameters(Dest).QuotedIdentifier := QuotedIdentifier;
    TMSConnectionParameters(Dest).Language := Language;
    TMSConnectionParameters(Dest).Encrypt := Encrypt;
    TMSConnectionParameters(Dest).PersistSecurityInfo := PersistSecurityInfo;
    TMSConnectionParameters(Dest).AutoTranslate := AutoTranslate;
    TMSConnectionParameters(Dest).NetworkLibrary := NetworkLibrary;
    TMSConnectionParameters(Dest).ApplicationName := ApplicationName;
    TMSConnectionParameters(Dest).WorkstationID := WorkstationID;
    TMSConnectionParameters(Dest).PacketSize := PacketSize;
    TMSConnectionParameters(Dest).TrustServerCertificate := TrustServerCertificate;
    TMSConnectionParameters(Dest).ForceCreateDatabase := ForceCreateDatabase;
    TMSConnectionParameters(Dest).ApplicationIntent := ApplicationIntent;
  end;

  inherited;
end;

function TMSConnectionParameters.ConnectParamsToString: string;
begin
  Result := inherited ConnectParamsToString + Format(
    'Database=%s'#13,
    [Database]);
end;

function TMSConnectionParameters.Equals(Obj: TCRConnectionParameters): boolean;
var
  O: TMSConnectionParameters;
begin
  Result := inherited Equals(Obj);
  if Result and (Obj is TMSConnectionParameters) then begin
    O := TMSConnectionParameters(Obj);
    Result :=
      (CompareText(Database, O.Database) = 0) and
      (O.Port = Port) and
      (O.IsolationLevel = IsolationLevel) and
      (O.Authentication = Authentication) and
      (O.Provider = Provider) and
      (O.QuotedIdentifier = QuotedIdentifier) and
      (CompareText(O.Language, Language) = 0)and
      (O.Encrypt = Encrypt) and
      (O.PersistSecurityInfo = PersistSecurityInfo) and
      (O.AutoTranslate = AutoTranslate) and
      (CompareText(O.NetworkLibrary, NetworkLibrary) = 0) and
      (CompareText(O.ApplicationName, ApplicationName) = 0) and
      (CompareText(O.WorkstationID, WorkstationID) = 0) and
      (O.PacketSize = PacketSize) and
      (O.TrustServerCertificate = TrustServerCertificate) and
      (O.ForceCreateDatabase = ForceCreateDatabase) and
      (O.ApplicationIntent = ApplicationIntent);
    if Result then begin
      if Provider = prCompact then
        Result := O.CompactVersion = CompactVersion
      else
      if Provider = prNativeClient then
        Result := O.NativeClientVersion = NativeClientVersion;
    end;
  end;
end;

function TMSConnectionParameters.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prDatabase:
      Database := Value;
    prPort:
      Port := Value;
    prIsolationLevel:
      IsolationLevel := TCRIsolationLevel(Value);
    prAuthentication:
      Authentication := TMSAuthentication(Value);
    prProvider:
      Provider := TOLEDBProvider(Value);
    prCompactVersion:
      CompactVersion := TCompactVersion(CompactVersion);
    prNativeClientVersion:
      NativeClientVersion := TNativeClientVersion(NativeClientVersion);
    prQuotedIdentifier:
      QuotedIdentifier := Value;
    prLanguage:
      Language := Value;
    prEncrypt:
      Encrypt := Value;
    prPersistSecurityInfo:
      PersistSecurityInfo := Value;
    prAutoTranslate:
      AutoTranslate := Value;
    prNetworkLibrary:
      NetworkLibrary := Value;
    prApplicationName:
      ApplicationName := Value;
    prWorkstationID:
      WorkstationID := Value;
    prPacketSize:
      PacketSize := Value;
    prTrustServerCertificate:
      TrustServerCertificate := Value;
    prForceCreateDatabase:
      ForceCreateDatabase := Value;
    prApplicationIntent:
      ApplicationIntent := TApplicationIntent(Value);
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

{ TMSLocalConnectionPool }

function TMSLocalConnectionPool.CreateNewConnector: TCRConnection;
begin
  Result := TOLEDBConnection.Create;

  try
    Result.SetProp(prDatabase, TMSConnectionParameters(ConnectionParameters).Database);
    Result.SetProp(prPort, TMSConnectionParameters(ConnectionParameters).Port);
    Result.SetProp(prAuthentication, Variant(TMSConnectionParameters(ConnectionParameters).Authentication));
    Result.SetProp(prProvider, Variant(TMSConnectionParameters(ConnectionParameters).Provider));
    Result.SetProp(prCompactVersion, Variant(TMSConnectionParameters(ConnectionParameters).CompactVersion));
    Result.SetProp(prNativeClientVersion, Variant(TMSConnectionParameters(ConnectionParameters).NativeClientVersion));
  
    Result.SetProp(prQuotedIdentifier, TMSConnectionParameters(ConnectionParameters).QuotedIdentifier);
    Result.SetProp(prLanguage, TMSConnectionParameters(ConnectionParameters).Language);
    Result.SetProp(prEncrypt, TMSConnectionParameters(ConnectionParameters).Encrypt);
    Result.SetProp(prPersistSecurityInfo, TMSConnectionParameters(ConnectionParameters).PersistSecurityInfo);
    Result.SetProp(prAutoTranslate, TMSConnectionParameters(ConnectionParameters).AutoTranslate);
    Result.SetProp(prNetworkLibrary, TMSConnectionParameters(ConnectionParameters).NetworkLibrary);
    Result.SetProp(prApplicationName, TMSConnectionParameters(ConnectionParameters).ApplicationName);
    Result.SetProp(prWorkstationID, TMSConnectionParameters(ConnectionParameters).WorkstationID);
    Result.SetProp(prPacketSize, TMSConnectionParameters(ConnectionParameters).PacketSize);
    Result.SetProp(prTrustServerCertificate, TMSConnectionParameters(ConnectionParameters).TrustServerCertificate);
    Result.SetProp(prForceCreateDatabase, TMSConnectionParameters(ConnectionParameters).ForceCreateDatabase);
    Result.SetProp(prApplicationIntent, Variant(TMSConnectionParameters(ConnectionParameters).ApplicationIntent));
    Result.OnError := ConnectionParameters.OnError;
  
    Result.GetInternalTransaction.SetProp(prIsolationLevel, Variant(TMSConnectionParameters(ConnectionParameters).IsolationLevel));
  
    Result.SetUsername(ConnectionParameters.Username);
    Result.SetPassword(ConnectionParameters.Password);
    Result.SetServer(ConnectionParameters.Server);
  except
    Result.Free;
    raise;
  end;
end;

{ TMSConnectionPoolManager }

function TMSConnectionPoolManager.CreateCRConnectionPool(ConnectionParameters: TCRConnectionParameters): TCRConnectionPool;
begin
  Result := TMSLocalConnectionPool.Create(Self, ConnectionParameters);
end;

class procedure TMSConnectionPoolManager.Clear;
begin
  if ConnectionPoolManager <> nil then
    ConnectionPoolManager.InternalClear;
end;

class function TMSConnectionPoolManager.GetConnection(ConnectionParameters: TCRConnectionParameters;
  SQLMonitorClass: TDASQLMonitorClass): TCRConnection;
begin
  LockPoolManagerCreate.Enter;
  try
    if ConnectionPoolManager = nil then begin
      ConnectionPoolManager := TMSConnectionPoolManager.Create;
      ConnectionPoolManager.SQLMonitorClass := SQLMonitorClass;
    end;
  finally
    LockPoolManagerCreate.Leave;
  end;

  Result := ConnectionPoolManager.InternalGetConnection(ConnectionParameters);
end;

{$IFDEF WIN32}
{$IFNDEF FPC}
{$IFNDEF VER6P}
type
  TDLLProc = procedure (Reason: Integer);
{$ENDIF}

var
  OldDLLProc: TDLLProc;

procedure LibraryProc(Reason: integer);
begin
  if Reason = DLL_PROCESS_DETACH then begin
    ConnectionPoolManager.Free;
    ConnectionPoolManager := nil;
  end;
  if Assigned(OldDLLProc) then
    OldDLLProc(Reason);
end;
{$ENDIF}
{$ENDIF}

initialization
{$IFNDEF FPC}
{$IFDEF WIN32}
  OldDLLProc := DLLProc;
  DLLProc := @LibraryProc;
{$ENDIF}
{$ENDIF}
  ConnectionPoolManager := nil;
  LockPoolManagerCreate := TCriticalSection.Create;

finalization
  ConnectionPoolManager.Free;
  ConnectionPoolManager := nil;
  LockPoolManagerCreate.Free;

end.
