492 lines
14 KiB
ObjectPascal
492 lines
14 KiB
ObjectPascal
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.
|