unit uDADriverManager;

{----------------------------------------------------------------------------}
{ Data Abstract Library - Core Library                                       }
{                                                                            }
{ compiler: Delphi 6 and up, Kylix 3 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the Data Abstract              }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I DataAbstract.inc}

interface

uses Classes, uDAInterfaces, uROClasses;

type
  { TDriverInfo }
  PDADriverInfo = ^TDADriverInfo;
  TDADriverInfo = record
    FileName: string;
    Handle: cardinal;
    Driver: IDADriver;
    GetDriverObjectFunc: TDAGetDriverObject;
  end;

  TDADriverNameType = (dntFileName, dntDriverID);

  { TDADriverManager }
  TDADriverLoadNotification = procedure(DriverInfo: TDADriverInfo) of object;

  TDADriverManager = class(TComponent, IDADriverManager)
  private
    fDriverDirectory: string;
    fDrivers: TList;
    fLoadingAutoLoad,
      fAutoLoad: boolean;
    fOnDriverUnloaded: TDADriverLoadNotification;
    fOnDriverLoaded: TDADriverLoadNotification;
    fStreamedTraceActive,
      fTraceActive: boolean;
    fTraceFlags: TDATraceOptions;
    fOnTraceEvent: TDALogTraceEvent;

    procedure SetDriverDirectory(const Value: string);

    function GetDrivers(Index: integer): IDADriver;
    function GetDriverCount: integer;
    function GetDriverInfo(Index: integer): TDADriverInfo;
    procedure SetAutoLoad(const Value: boolean);

  protected
    procedure Loaded; override;
    procedure LoadStaticDrivers; virtual;
    procedure UnloadDriver(anIndex: integer; aForceUnloadForStaticDriver: boolean); overload;
    procedure UnloadAllDrivers(aForceUnloadForStaticDriver: boolean); overload;

    //procedure HandleDriverError(anErrorCode : integer; const anErrorMessage : string); dynamic;

    procedure SetTraceActive(const Value: boolean);
    procedure SetTraceFlags(const Value: TDATraceOptions);

  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    // IDADriverManager
    procedure LoadDriver(const aFileName: string);
    procedure UnloadDriver(anIndex: integer); overload;

    procedure LoadDrivers;overload;
    procedure LoadDrivers(const aDriverList: IROStrings; aIgnoreDuplicates: boolean = false; aIgnoreErrors: boolean = false);overload;
    procedure UnloadAllDrivers; overload;

    function ListDrivers(const aDirectory: string; out FileNames: IROStrings): integer;

    function FindDriver(const aDriverID: string; out Driver: IDADriver): boolean;
    function FindDriverIndex(const aDriverID: string): integer;

    function DriverByDriverID(const aDriverID: string): IDADriver;

    property Drivers[Index: integer]: IDADriver read GetDrivers; default;
    property DriverInfo[Index: integer]: TDADriverInfo read GetDriverInfo;
    property DriverCount: integer read GetDriverCount;

  published
    property DriverDirectory: string read fDriverDirectory write SetDriverDirectory;
    property AutoLoad: boolean read fAutoLoad write SetAutoLoad default false;
    property OnDriverLoaded: TDADriverLoadNotification read fOnDriverLoaded write fOnDriverLoaded;
    property OnDriverUnloaded: TDADriverLoadNotification read fOnDriverUnloaded write fOnDriverUnloaded;

    property TraceActive: boolean read fTraceActive write SetTraceActive;
    property TraceFlags: TDATraceOptions read fTraceFlags write SetTraceFlags;
    property OnTraceEvent: TDALogTraceEvent read fOnTraceEvent write fOnTraceEvent;
  end;

function DriverManager: TDADriverManager;

procedure RegisterDriverProc(aDriverProc: TDAGetDriverObject);
procedure UnregisterDriverProc(aDriverProc: TDAGetDriverObject);

implementation

uses
  {$IFDEF MSWINDOWS}Windows, {$ENDIF}SysUtils,
  uDAUtils, uDARes;

var
  _DriverManager: TDADriverManager;
  _DriverProcs: TList;

function DriverManager: TDADriverManager;
begin
  if (_DriverManager = nil) then RaiseError(err_DriverManagerNotAssigned);

  result := _DriverManager;
end;

procedure RegisterDriverProc(aDriverProc: TDAGetDriverObject);
begin
  if (_DriverProcs.IndexOf(@aDriverProc) >= 0) then RaiseError(err_DriverProcAlreadyRegistered, [integer(@aDriverProc)]);

  _DriverProcs.Add(@aDriverProc);
end;

procedure UnregisterDriverProc(aDriverProc: TDAGetDriverObject);
var
  idx: integer;
begin
  idx := _DriverProcs.IndexOf(@aDriverProc);
  if (idx >= 0) then _DriverProcs.Delete(idx);
end;

{ TDADriverManager }

constructor TDADriverManager.Create(aOwner: TComponent);
begin
  inherited;

  // Cannot create multiple Driver Managers
  if not (csDesigning in ComponentState) then begin
    Check(_DriverManager <> nil, err_DriverManagerAlreadyCreated);
    _DriverManager := Self;
  end;

  fAutoLoad := FALSE;
  fDriverDirectory := alias_System;
  fDrivers := TList.Create;

  if not (csDesigning in ComponentState) then begin
    LoadStaticDrivers;
  end;
end;

destructor TDADriverManager.Destroy;
begin
  if (_DriverManager = Self) then _DriverManager := nil;

  if (fDrivers <> nil) then begin // In case of the multplie driver exception
    UnloadAllDrivers(true);
    fDrivers.Free;
  end;

  inherited;
end;

function TDADriverManager.ListDrivers(const aDirectory: string; out FileNames: IROStrings): integer;
var
  actualdir: string;
  dir: TSearchRec;
begin
  result := 0;
  FileNames := TROStrings.Create;

  if (aDirectory = '') then
    actualdir := DriverDirectory
  else
    actualdir := IncludeTrailingPathDelimiter(aDirectory);

  actualdir := TranslateFileName(actualdir);

  // If no path is specified looks in the Windows\System32 directory
  {if (Length(actualdir)<=1)
    then actualdir := IncludeTrailingPathDelimiter(GetSystemDir);}

  if (FindFirst(actualdir + drv_AllDrivers, faAnyFile, dir) = 0) then begin
    repeat
      if (dir.Attr and faDirectory) <> faDirectory then begin
        Inc(result);
        FileNames.Add(ExpandFileName(actualdir + dir.Name));
      end;
    until (FindNext(dir) <> 0);
    SysUtils.FindClose(dir);
  end;
end;

function TDADriverManager.FindDriver(const aDriverID: string; out Driver: IDADriver): boolean;
var
  i: integer;
begin
  result := FALSE;
  Driver := nil;

  for i := 0 to (DriverCount - 1) do
    if SameText(Drivers[i].DriverID, aDriverID) then begin
      Driver := Drivers[i];
      result := TRUE;
      Exit;
    end;
end;

function TDADriverManager.FindDriverIndex(const aDriverID:string):integer;
var
  i: integer;
begin
  result := -1;
  for i := 0 to (DriverCount - 1) do
    if SameText(Drivers[i].DriverID, aDriverID) then begin
      result := i;
      Exit;
    end;
end;

procedure TDADriverManager.LoadStaticDrivers;
var
  i: integer;
  driver: PDADriverInfo;
  drv: IDADriver;
begin
  driver := nil;

  for i := 0 to (_DriverProcs.Count - 1) do try
    New(driver);

    driver^.GetDriverObjectFunc := _DriverProcs[i];
    driver^.FileName := '';
    driver^.Handle := 0;
    driver^.Driver := driver^.GetDriverObjectFunc;

    Check(FindDriver(driver^.Driver.DriverID, drv), err_DriverAlreadyLoaded, [driver^.Driver.DriverID]); // Checks this driver's not already loaded

    driver^.Driver.Initialize; //(HandleDriverError); // Calls the initialization routine for the DLL

    fDrivers.Add(driver);

    if Assigned(OnDriverLoaded) then OnDriverLoaded(driver^);

    driver := nil;
  except
    if (driver <> nil) then begin
      if (fDrivers.IndexOf(driver) > 0) then fDrivers.Delete(fDrivers.IndexOf(driver));

      Dispose(driver);
    end;

    raise;
  end;
end;

{$IFDEF DataAbstract_SchemaModeler}
{$INCLUDE DataAbstract_SchemaModelerOnly.inc}
{$ENDIF DataAbstract_SchemaModeler}

const function_AuthorizeSchemaModeler = 'AuthorizeSchemaModeler';

procedure TDADriverManager.LoadDriver(const aFileName: string);
var
  lHandle: cardinal;
  driver: PDADriverInfo;
  ptr: pointer;
  drv: IDADriver;
  fname: string;
  alreadyloaded: boolean;
begin
  fname := aFileName;

  if not IsMemoryManagerSet then
    raise Exception.Create(err_NeedShareMem);

  New(driver);
  try
    driver^.FileName := aFileName;
    pointer(driver^.Driver) := nil;
    driver^.Handle := 0;
    driver^.Handle := LoadLibrary(PChar(fname));

    Check(driver^.Handle = 0, err_LoadPackageFailed, [fname]); // Checks LoadLibrary's ok

    {$IFDEF DataAbstract_SchemaModeler}
    ptr := GetProcAddress(driver^.Handle, function_AuthorizeSchemaModeler);
    if Assigned(ptr) then begin
      TAuthorizeSchemaModeler(ptr)(AuthorizeSchemaModelerKey);
    end;
    {$ENDIF DataAbstract_SchemaModeler}

    ptr := GetProcAddress(driver^.Handle, func_GetDriverObject);
    Check(ptr = nil, err_InvalidDLL, [fname]); // Checks the DLL exports the required function

    @driver^.GetDriverObjectFunc := ptr;
    drv := driver.GetDriverObjectFunc();
    driver^.Driver := drv;
    drv := nil;
    { We need a local variable, because else the driver pointer will remain on the
      stack with a refcount, and Release'd on the "end;".not good, if the .dad is
      unloaded by then. }

    if not Assigned(driver^.Driver) then begin
      if GetProcAddress(driver^.Handle, function_AuthorizeSchemaModeler) <> nil then begin
        RaiseError('Driver %s may only be used inside the Schema Modeler',[fname],EDASchemaModelerOnly);
      end
      else begin
        RaiseError(err_InvalidDriverReference, [fname]);
      end;
    end;

    Check(driver^.Driver = nil, err_InvalidDriverReference, [fname]); // Checks the reference to the driver is ok

    alreadyloaded := FindDriver(driver^.Driver.DriverID, drv);
    Check(alreadyloaded, err_DriverAlreadyLoaded, [driver^.Driver.DriverID], EDADriverAlreadyLoaded); // Checks this driver's not already loaded
    drv := nil;

    driver^.Driver.Initialize; //(HandleDriverError); // Calls the initialization routine for the DLL

    fDrivers.Add(driver);

    if Assigned(fOnDriverLoaded) then fOnDriverLoaded(driver^);
  except
    lHandle := driver^.Handle;
    driver^.Driver := nil;
    Dispose(driver);
    if (lHandle <> 0) then FreeLibrary(lHandle);
    raise;
  end;
end;

procedure TDADriverManager.UnloadDriver(anIndex: integer; aForceUnloadForStaticDriver: boolean);
var
  driver: PDADriverInfo;
begin

  driver := fDrivers[anIndex];
  if (driver^.Handle = 0) and not aForceUnloadForStaticDriver then Exit;

  try
    fDrivers.Delete(anIndex);

    driver^.Driver.Finalize; // Calls the finalization routine for the DLL
    driver^.Driver := nil;

    if (driver^.Handle <> 0) then FreeLibrary(driver^.Handle);

    if Assigned(OnDriverUnloaded) then OnDriverUnloaded(driver^);
  finally
    Dispose(driver);
  end;
end;

procedure TDADriverManager.UnloadDriver(anIndex: integer);
begin
  UnloadDriver(anIndex, false);
end;

function TDADriverManager.GetDriverCount: integer;
begin
  result := fDrivers.Count
end;

function TDADriverManager.GetDrivers(Index: integer): IDADriver;
begin
  result := PDADriverInfo(fDrivers[Index])^.Driver
end;

procedure TDADriverManager.LoadDrivers;
var
  DriverList:IROStrings;
begin
   ListDrivers(DriverDirectory,DriverList);
   LoadDrivers(DriverList,True);
end;

procedure TDADriverManager.LoadDrivers(const aDriverList: IROStrings; aIgnoreDuplicates: boolean = false; aIgnoreErrors: boolean = false);
var
  i: integer;
begin
  for i := 0 to (aDriverList.Count - 1) do try
    LoadDriver(aDriverList[i]);
  except
    on E: EDADriverAlreadyLoaded do begin
      if not aIgnoreDuplicates then raise;
    end
  else begin
      if not aIgnoreErrors then raise;
    end;
  end;
end;

procedure TDADriverManager.UnloadAllDrivers(aForceUnloadForStaticDriver: boolean);
var
  i: integer;
begin
  for i := DriverCount - 1 downto 0 do
    UnloadDriver(i, aForceUnloadForStaticDriver);
end;

procedure TDADriverManager.UnloadAllDrivers;
begin
  UnloadAllDrivers(false);
end;

function TDADriverManager.DriverByDriverID(const aDriverID: string): IDADriver;
begin
  Check(not FindDriver(aDriverID, result), err_UnknownDriver, [aDriverID]);
end;

procedure TDADriverManager.SetDriverDirectory(const Value: string);
begin
  fDriverDirectory := Trim(Value);
  if (fDriverDirectory <> '') then
    fDriverDirectory := IncludeTrailingPathDelimiter(fDriverDirectory)
end;

function TDADriverManager.GetDriverInfo(Index: integer): TDADriverInfo;
begin
  result := PDADriverInfo(fDrivers[Index])^
end;

procedure TDADriverManager.SetAutoLoad(const Value: boolean);
var
  sl: IROStrings;
begin
  if (csLoading in ComponentState) then
    fLoadingAutoLoad := Value
  else begin
    //if (Value=fAutoLoad) then Exit; // Prevents a strange double set done by the IDE....

    //if not Value and (DriverCount>0) then UnloadAllDrivers;

    fAutoLoad := Value;

    if fAutoLoad and not (csDesigning in ComponentState) then begin
      sl := TROStrings.Create;
      ListDrivers('', sl);
      if sl.Count > 0 then begin
        LoadDrivers(sl);
      end;
    end;
  end;
end;

procedure TDADriverManager.Loaded;
begin
  inherited;

  AutoLoad := fLoadingAutoLoad;
  TraceActive := fStreamedTraceActive;
end;

procedure TDADriverManager.SetTraceActive(const Value: boolean);
var
  i: integer;
begin
  if (Value = fTraceActive) then Exit;

  if (csLoading in ComponentState) then
    fStreamedTraceActive := Value
  else begin
    fTraceActive := Value;

    for i := 0 to (DriverCount - 1) do
      Drivers[i].SetTraceOptions(Value, TraceFlags, OnTraceEvent);
  end;
end;

procedure TDADriverManager.SetTraceFlags(const Value: TDATraceOptions);
begin
  fTraceFlags := Value;
end;


initialization
  _DriverManager := nil;
  _DriverProcs := TList.Create;

finalization
  _DriverProcs.Free;

end.