DriverManager.pas

unit DBDriverManager;

interface

uses
  ZDbcIntfs, Types, Classes, DB, SysUtils, ZClasses, ZCollections, ZCompatibility, ZTokenizer, ZSelectSchema,
  ZGenericSqlAnalyser, ZDbcLogging, ZVariant, ZPlainDriver, ZURL, ThreadHelper;

type
  TSafeDriverManager = class(TInterfacedObject, IZDriverManager)
  private
    FLock: TLock;
    FDrivers: IZCollection;
    FLoginTimeout: Integer;
    FLoggingListeners: IZCollection;
    FHasLoggingListener: Boolean;
    procedure LogEvent(const Event: TZLoggingEvent);
  public
    constructor Create;
    destructor Destroy; override;
    function GetConnection(const Url: string): IZConnection;
    function GetConnectionWithParams(const Url: string; Info: TStrings): IZConnection;
    function GetConnectionWithLogin(const Url: string; const User: string; const Password: string): IZConnection;
    function GetDriver(const Url: string): IZDriver;
    procedure RegisterDriver(Driver: IZDriver);
    procedure DeregisterDriver(Driver: IZDriver);
    function GetDrivers: IZCollection;
    function GetClientVersion(const Url: string): Integer;
    function GetLoginTimeout: Integer;
    procedure SetLoginTimeout(Value: Integer);
    procedure AddLoggingListener(Listener: IZLoggingListener);
    procedure RemoveLoggingListener(Listener: IZLoggingListener);
    function HasLoggingListener: Boolean;
    procedure LogMessage(Category: TZLoggingCategory; const Protocol: RawByteString; const Msg: RawByteString); overload;
    procedure LogMessage(const Category: TZLoggingCategory; const Sender: IZLoggingObject); overload;
    procedure LogError(Category: TZLoggingCategory; const Protocol: RawByteString; const Msg: RawByteString; ErrorCode: Integer; const Error: RawByteString);
    function ConstructURL(const Protocol, HostName, Database, UserName, Password: string; const Port: Integer; const Properties: TStrings = nil; const LibLocation: string = ''): string;
    procedure ResolveDatabaseUrl(const Url: string; out HostName: string; out Port: Integer; out Database: string; out UserName: string; out Password: string; ResultInfo: TStrings = nil); overload;
    procedure ResolveDatabaseUrl(const Url: string; out Database: string); overload;
  end;

implementation

uses
  ZMessages;

constructor TSafeDriverManager.Create;
begin
  FLock.Init;
  FDrivers := TZCollection.Create;
  FLoginTimeout := 0;
  FLoggingListeners := TZCollection.Create;
  FHasLoggingListener := False;
end;

{**
  Destroys this object and cleanups the memory.
}
destructor TSafeDriverManager.Destroy;
begin
  FDrivers := nil;
  FLoggingListeners := nil;
  FLock.Done;
  inherited Destroy;
end;

{**
  Gets a collection of registered drivers.
  @return an unmodifiable collection with registered drivers.
}
function TSafeDriverManager.GetDrivers: IZCollection;
begin
  Result := TZUnmodifiableCollection.Create(FDrivers);
end;

{**
  Gets a login timeout value.
  @return a login timeout.
}
function TSafeDriverManager.GetLoginTimeout: Integer;
begin
  Result := FLoginTimeout;
end;

{**
  Sets a new login timeout value.
  @param Seconds a new login timeout in seconds.
}
procedure TSafeDriverManager.SetLoginTimeout(Value: Integer);
begin
  FLoginTimeout := Value;
end;

{**
  Registers a driver for specific database.
  @param Driver a driver to be registered.
}
procedure TSafeDriverManager.RegisterDriver(Driver: IZDriver);
begin
  FLock.Lock;
  try
    if not FDrivers.contains(Driver) then
      FDrivers.Add(Driver);
  finally
    FLock.Unlock;
  end;
end;

{**
  Unregisters a driver for specific database.
  @param Driver a driver to be unregistered.
}
procedure TSafeDriverManager.DeregisterDriver(Driver: IZDriver);
begin
  FLock.Lock;
  try
    FDrivers.Remove(Driver);
  finally
    FLock.Unlock;
  end;
end;

{**
  Gets a driver which accepts the specified url.
  @param Url a database connection url.
  @return a found driver or <code>null</code> otherwise.
}
function TSafeDriverManager.GetDriver(const Url: string): IZDriver;
var
  I: Integer;
  Current: IZDriver;
begin
  FLock.Lock;
  try
    Result := nil;
    for I := 0 to FDrivers.Count - 1 do
    begin
      Current := FDrivers[I] as IZDriver;
      if Current.AcceptsURL(Url) then
      begin
        Result := Current;
        Break;
      end;
    end;
  finally
    FLock.Unlock;
  end;
end;

{**
  Locates a required driver and opens a connection to the specified database.
  @param Url a database connection Url.
  @param Info an extra connection parameters.
  @return an opened connection.
}
function TSafeDriverManager.GetConnectionWithParams(const Url: string; Info: TStrings): IZConnection;
var
  Driver: IZDriver;
begin
  Driver := GetDriver(Url);
  if Driver = nil then
    raise EZSQLException.Create(SDriverWasNotFound);
  Result := Driver.Connect(Url, Info);
end;

{**
  Locates a required driver and returns the client library version number.
  @param Url a database connection Url.
  @return client library version number.
}
function TSafeDriverManager.GetClientVersion(const Url: string): Integer;
var
  Driver: IZDriver;
begin
  Driver := GetDriver(Url);
  if Driver = nil then
    raise EZSQLException.Create(SDriverWasNotFound);
  Result := Driver.GetClientVersion(Url);
end;

{**
  Locates a required driver and opens a connection to the specified database.
  @param Url a database connection Url.
  @param User a user's name.
  @param Password a user's password.
  @return an opened connection.
}
function TSafeDriverManager.GetConnectionWithLogin(const Url: string; const User: string; const Password: string): IZConnection;
var
  Info: TStrings;
begin
  Info := TStringList.Create;
  try
    Info.Add('username=' + User);
    Info.Add('password=' + Password);
    Result := GetConnectionWithParams(Url, Info);
  finally
    Info.Free;
  end;
end;

{**
  Locates a required driver and opens a connection to the specified database.
  @param Url a database connection Url.
  @return an opened connection.
}
function TSafeDriverManager.GetConnection(const Url: string): IZConnection;
begin
  Result := GetConnectionWithParams(Url, nil);
end;

{**
  Adds a logging listener to log SQL events.
  @param Listener a logging interface to be added.
}
procedure TSafeDriverManager.AddLoggingListener(Listener: IZLoggingListener);
begin
  FLock.Lock;
  try
    FLoggingListeners.Add(Listener);
    FHasLoggingListener := True;
  finally
    FLock.Unlock;
  end;
end;

{**
  Removes a logging listener from the list.
  @param Listener a logging interface to be removed.
}
procedure TSafeDriverManager.RemoveLoggingListener(Listener: IZLoggingListener);
begin
  FLock.Lock;
  try
    FLoggingListeners.Remove(Listener);
    FHasLoggingListener := (FLoggingListeners.Count > 0);
  finally
    FLock.Unlock;
  end;
end;

function TSafeDriverManager.HasLoggingListener: Boolean;
begin
  result := FHasLoggingListener;
end;

{**
  Logs a message about event with error result code.
  @param Category a category of the message.
  @param Protocol a name of the protocol.
  @param Msg a description message.
  @param ErrorCode an error code.
  @param Error an error message.
}
procedure TSafeDriverManager.LogError(Category: TZLoggingCategory; const Protocol: RawByteString; const Msg: RawByteString; ErrorCode: Integer; const Error: RawByteString);
var
  Event: TZLoggingEvent;
begin
  if not FHasLoggingListener then
    Exit;
  Event := TZLoggingEvent.Create(Category, Protocol, Msg, ErrorCode, Error);
  try
    LogEvent(Event);
  finally
    Event.Destroy;
  end;
end;

{**
  Logs a message about event with error result code.
  @param Category a category of the message.
  @param Protocol a name of the protocol.
  @param Msg a description message.
  @param ErrorCode an error code.
  @param Error an error message.
}
procedure TSafeDriverManager.LogEvent(const Event: TZLoggingEvent);
var
  I: Integer;
  Listener: IZLoggingListener;
begin
  if not FHasLoggingListener then
    Exit;

  FLock.Lock;
  try
    for I := 0 to FLoggingListeners.Count - 1 do
    begin
      Listener := FLoggingListeners[I] as IZLoggingListener;
      try
        Listener.LogEvent(Event);
      except
      end;
    end;
  finally
    FLock.Unlock;
  end;
end;

{**
  Logs a message about event with normal result code.
  @param Category a category of the message.
  @param Protocol a name of the protocol.
  @param Msg a description message.
}
procedure TSafeDriverManager.LogMessage(Category: TZLoggingCategory; const Protocol: RawByteString; const Msg: RawByteString);
begin
  if not FHasLoggingListener then
    Exit;
  LogError(Category, Protocol, Msg, 0, '');
end;

procedure TSafeDriverManager.LogMessage(const Category: TZLoggingCategory; const Sender: IZLoggingObject);
var
  Event: TZLoggingEvent;
begin
  if not FHasLoggingListener then
    Exit;
  Event := Sender.CreateLogEvent(Category);
  if Assigned(Event) then
  begin
    LogEvent(Event);
    Event.Free;
  end;
end;

{**
  Constructs a valid URL
  @param Protocol the Driver-protocol (must be assigned).
  @param HostName the hostname (could be empty).
  @param Database the connection-database (could be empty).
  @param UserName the username (could be empty).
  @param Password the password(could be empty).
  @param Port the Server-Port (could be 0).
  @param Properties the Database-Properties (could be empty).
}
function TSafeDriverManager.ConstructURL(const Protocol, HostName, Database, UserName, Password: string; const Port: Integer; const Properties: TStrings = nil; const LibLocation: string = ''): string;
var
  BaseURL: TZURL;
begin
  BaseURL := TZURL.Create;
  try
    BaseURL.Protocol := Protocol;
    BaseURL.HostName := HostName;
    BaseURL.Database := Database;
    BaseURL.UserName := UserName;
    BaseURL.Password := Password;
    BaseURL.Port := Port;
    if Assigned(Properties) then
      BaseURL.Properties.Text := Properties.Text;
    BaseURL.LibLocation := LibLocation;
    Result := BaseURL.URL;
  finally
    BaseURL.Free;
  end;
end;

{**
  Resolves a database URL and fills the database connection parameters.
  @param Url an initial database URL.
  @param HostName a name of the database host.
  @param Port a port number.
  @param Database a database name.
  @param UserName a name of the database user.
  @param Password a user's password.
  @param ResutlInfo a result info parameters.
}
procedure TSafeDriverManager.ResolveDatabaseUrl(const Url: string; out HostName: string; out Port: Integer; out Database: string; out UserName: string; out Password: string; ResultInfo: TStrings = nil);
var
  BaseURL: TZURL;
begin
  BaseURL := TZURL.Create;
  try
    BaseURL.URL := Url;
    HostName := BaseURL.HostName;
    Port := BaseURL.Port;
    Database := BaseURL.Database;
    UserName := BaseURL.UserName;
    Password := BaseURL.Password;
    if Assigned(ResultInfo) then
      ResultInfo.Text := BaseURL.Properties.Text;
  finally
    BaseURL.Free;
  end;
end;

{**
  Resolves a database URL and fills the database parameter for MetaData.
  @param Url an initial database URL.
  @param Database a database name.
}
procedure TSafeDriverManager.ResolveDatabaseUrl(const Url: string; out Database: string);
var
  BaseURL: TZURL;
begin
  BaseURL := TZURL.Create;
  try
    BaseURL.URL := Url;
    Database := BaseURL.Database;
  finally
    BaseURL.Free;
  end;
end;

initialization
  DriverManager := TSafeDriverManager.Create;

finalization
  DriverManager := nil;

end.