//NODOC-BEGIN
var
globalIsis: isisbase =
nil;
IsisLibHandle: HMODULE;
//NODOC-END
{! Load the isislib.dll from our fallback location, if it is not already
loaded }
procedure LoadIsisLib;
const
CIsisLib = '
ISISLIB.DLL';
var
LOldPath, LDLLPath, LDLLFolder:
string;
begin
IsisLibHandle:= GetModuleHandle(CIsisLib);
if IsisLibHandle = 0
then begin
// first check the applications home folder
LDLLFolder := TPath.GetDirectoryName(ParamStr(0));
LDllPath := TPath.Combine(LDLLFolder, CIsisLib);
if not TFile.Exists(LDLLPath)
then begin
LDllFolder := SPathToolsFolder;
LDllPath := TPath.Combine(LDLLFolder, CIsisLib);
end;
if not TFile.Exists(LDLLPath)
then
raise EOleSysError.Create(SIsisLibNotFound, E_FAIL, 0);
LOldPath := TDirectory.GetCurrentDirectory;
try
TDirectory.SetCurrentDirectory(LDLLFolder);
IsisLibHandle := SafeLoadLibrary(LDllPath);
if IsisLibHandle = 0
then
RaiseLastOSError;
finally
TDirectory.SetCurrentDirectory(LOldPath);
end;
end;
{if}
end;
{! Try to create an instance of the ISIS automation server directly
from the fallback copy of the ISIS Dll. }
function CreateServerFromFallback: isisbase;
const
IID_IClassFactory: TGUID = (
D1:$00000001;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
var
DllProc :
function (
const CLSID: TGUID;
const IID: TGUID;
out Factory: IClassFactory): HRESULT;
stdcall;
LFactory: IClassFactory;
LBase: isisbase;
LResult: HRESULT;
begin
Result :=
nil;
if IsisLibHandle = 0
then
LoadIsisLib;
@DllProc := GetProcAddress(IsisLibHandle, '
DllGetClassObject');
if Assigned(DLLProc)
then begin
LResult:= DllProc(LIBID_BaseType, IID_IClassFactory, LFactory);
case LResult
of
S_OK:
begin
LResult:= LFactory.CreateInstance(
nil, isisbase, LBase);
if Succeeded(LResult)
then
Result := LBase
else
raise EOleSysError.Create(SFailedToCreateISISServer,LREsult, 0);
end;
E_NOINTERFACE:
raise EOleSysError.Create(SIClassFactoryNotSupported, LResult, 0);
CLASS_E_CLASSNOTAVAILABLE:
raise EOleSysError.Create(SLIBID_BaseTypeNotSupported, LResult, 0);
else
raise EOleSysError.Create(SUnexpectedError, LResult, 0);
end;
end
else
raise EOleError.Create(SDllEntryPointNotFound);
end;
{!
<summary>
Return an instance of the ISIS/Base OLE automation server</summary>
<returns>
the interface for the automation server.</returns>
<param name="newInstance">
determines whether we return a new instance or the existing one
(if there is any). This parameter is only used if the function is
called from the main thread.</param>
<exception cref="EOleSysError">
is raised if the server instance cannot be created.</exception>
<remarks>
The function will keep a single instance of the server for the main
thread, unless NewInstance is passed as True. If you call this function
from a secondary thread, make sure to call OleInitialize in the thread's
context first! And remember that the ISIS automation server is not
thread-safe!</remarks>
}
function CreateIsisServer(newInstance: Boolean): isisbase;
function DoCreateServer: isisbase;
begin
try
result:= isisbase(CreateOleObject(cIsisbase))
except
result :=
nil;
end;
if not Assigned(result)
then
result := CreateServerFromFallback;
end;
begin
if not NewInstance
and (GetCurrentThreadID = MainThreadID)
then begin
if not Assigned(globalIsis)
then
globalIsis := DoCreateServer;
Result := globalIsis;
end { If }
else
Result := DoCreateServer;
end;