Это известная ошибка / регрессия, см. Отчеты QC
- http://qc.embarcadero.com/wc/qcmain.aspx?d=109476
- http://qc.embarcadero.com/wc/qcmain.aspx?d=107346
Я не уверен, почему вы думаете, что вам нужно использовать MidasLib для «избежания аддона DLL».
Когда звонит RTL TCustomClientDataSet.CreateDSBase
, это вызывает CheckDbClient
DSIntf.Pas. Именно эта процедура определяет, какой экземпляр Midas.Dll загружен, путем изучения реестра.
Таким образом, вы можете убедиться, что конкретный экземпляр Midas.Dll используется для обеспечения того, что реестр отражает его местоположение до вызова CheckDbClient
. Параметр реестра находится InProcServer32
ниже HK_Classes_RootCLSId{9E8D2FA1-591C-11D0-BF52-0020AF32BD64}
. Он может быть обновлен, вызывая RegisterComServer
указание пути Midas и имени файла, с учетом необходимых разрешений на доступ к реестру, конечно.
Мы просто используем локальную копию DLL Midas независимо от того, что установлено в системе, и возвращаемся только к глобальному, если локальный не найден.
Мы используем XE2 upd4 hf1, и позже мы переключились на DLL Midas XE4 (основной проект все еще сделан с xe2)
// based on stock MidasLib unit
unit MidasDLL;
interface
implementation
uses Winapi.Windows, Winapi.ActiveX, Datasnap.DSIntf, SysUtils, Registry;
// function DllGetDataSnapClassObject(const CLSID, IID: TGUID; var Obj): HResult; stdcall; external 'Midas.DLL';
//var DllGetDataSnapClassObject: function(const CLSID, IID: TGUID; var Obj): HResult; stdcall; //external 'Midas.DLL';
var DllGetDataSnapClassObject: pointer; //external 'Midas.DLL';
const dllFN = 'Midas.DLL'; dllSubN = 'DllGetDataSnapClassObject';
var DllHandle: HMODULE = 0;
function RegisteredMidasPath: TFileName;
const rpath = 'SOFTWAREClassesCLSID{9E8D2FA1-591C-11D0-BF52-0020AF32BD64}InProcServer32';
var rry: TRegistry;
begin
Result := '';
rry := TRegistry.Create( KEY_READ );
try
rry.RootKey := HKEY_LOCAL_MACHINE;
if rry.OpenKeyReadOnly( rpath ) then begin
Result := rry.ReadString('');
if not FileExists( Result ) then
Result := '';
end;
finally
rry.Destroy;
end;
end;
procedure TryFindMidas;
var fPath, msg: string;
function TryOne(const fName: TFileName): boolean;
const ver_16_0 = 1048576; // $00060001
var ver: Cardinal; ver2w: LongRec absolute ver;
begin
Result := false;
ver := GetFileVersion( fName );
if LongInt(ver)+1 = 0 then exit; // -1 --> not found
if ver < ver_16_0 then begin
msg := msg + #13#10 +
'Obsolete version found: '+IntToStr(ver2w.Hi) + '.' + IntToStr(ver2w.Lo) + ' in library file ' + fName;
exit;
end;
DllHandle := SafeLoadLibrary(fName);
if DllHandle = 0 then begin
msg := msg + #13#10 +
'Failure loading library ' + fName + '. Maybe this was Win64 DLL or some other reason.';
exit;
end;
DllGetDataSnapClassObject := GetProcAddress( DllHandle, dllSubN);
if nil = DllGetDataSnapClassObject then begin // ???µ ???°?????µ???°
msg := msg + #13#10 +
'Incompatible library loaded ' + fName + '. Missed function ' + dllSubN;
FreeLibrary( DllHandle );
DllHandle := 0;
end;
Result := true;
end;
function TryTwo(const fName: TFileName): boolean; // seek in the given folder and its immediate parent
begin
Result := TryOne(fName + dllFN);
if not Result then
Result := TryOne(fName + '..' + dllFN); //
end;
begin
fPath := ExtractFilePath( ParamStr(0) );
if TryTwo( fPath ) then exit;
fPath := IncludeTrailingBackslash( GetCurrentDir() );
if TryTwo( fPath ) then exit;
fPath := RegisteredMidasPath;
if fPath > '' then
if TryOne( fPath ) then exit;
msg := 'This program needs the library ' + dllFN + ' version 16.0 or above.'#13#10 +
'It was not found, thus the program can not work.'#13#10 + #13#10 + msg;
Winapi.Windows.MessageBox(0, PChar(msg), 'Launch failure!',
MB_ICONSTOP or MB_TASKMODAL or MB_DEFAULT_DESKTOP_ONLY or MB_TOPMOST );
Halt(1);
end;
initialization
// RegisterMidasLib(@DllGetDataSnapClassObject); -- static linking does not work for utilities in sub-folders
TryFindMidas; // immediately terminates the application if not found
RegisterMidasLib(DllGetDataSnapClassObject);
finalization
if DllHandle <> 0 then
if FreeLibrary( DllHandle ) then
DllHandle := 0;
end.
Я не уверен, почему вы думаете, что вам нужно использовать MidasLib для «избежания аддона DLL».
Когда звонит RTL TCustomClientDataSet.CreateDSBase
, это вызывает CheckDbClient
DSIntf.Pas. Именно эта процедура определяет, какой экземпляр Midas.Dll загружен, путем изучения реестра.
Таким образом, вы можете убедиться, что конкретный экземпляр Midas.Dll используется для обеспечения того, что реестр отражает его местоположение до вызова CheckDbClient
. Параметр реестра находится InProcServer32
ниже HK_Classes_RootCLSId{9E8D2FA1-591C-11D0-BF52-0020AF32BD64}
. Он может быть обновлен, вызывая RegisterComServer
указание пути Midas и имени файла, с учетом необходимых разрешений на доступ к реестру, конечно.
Мы просто используем локальную копию DLL Midas независимо от того, что установлено в системе, и возвращаемся только к глобальному, если локальный не найден.
Мы используем XE2 upd4 hf1, и позже мы переключились на DLL Midas XE4 (основной проект все еще сделан с xe2)
// based on stock MidasLib unit
unit MidasDLL;
interface
implementation
uses Winapi.Windows, Winapi.ActiveX, Datasnap.DSIntf, SysUtils, Registry;
// function DllGetDataSnapClassObject(const CLSID, IID: TGUID; var Obj): HResult; stdcall; external 'Midas.DLL';
//var DllGetDataSnapClassObject: function(const CLSID, IID: TGUID; var Obj): HResult; stdcall; //external 'Midas.DLL';
var DllGetDataSnapClassObject: pointer; //external 'Midas.DLL';
const dllFN = 'Midas.DLL'; dllSubN = 'DllGetDataSnapClassObject';
var DllHandle: HMODULE = 0;
function RegisteredMidasPath: TFileName;
const rpath = 'SOFTWAREClassesCLSID{9E8D2FA1-591C-11D0-BF52-0020AF32BD64}InProcServer32';
var rry: TRegistry;
begin
Result := '';
rry := TRegistry.Create( KEY_READ );
try
rry.RootKey := HKEY_LOCAL_MACHINE;
if rry.OpenKeyReadOnly( rpath ) then begin
Result := rry.ReadString('');
if not FileExists( Result ) then
Result := '';
end;
finally
rry.Destroy;
end;
end;
procedure TryFindMidas;
var fPath, msg: string;
function TryOne(const fName: TFileName): boolean;
const ver_16_0 = 1048576; // $00060001
var ver: Cardinal; ver2w: LongRec absolute ver;
begin
Result := false;
ver := GetFileVersion( fName );
if LongInt(ver)+1 = 0 then exit; // -1 --> not found
if ver < ver_16_0 then begin
msg := msg + #13#10 +
'Obsolete version found: '+IntToStr(ver2w.Hi) + '.' + IntToStr(ver2w.Lo) + ' in library file ' + fName;
exit;
end;
DllHandle := SafeLoadLibrary(fName);
if DllHandle = 0 then begin
msg := msg + #13#10 +
'Failure loading library ' + fName + '. Maybe this was Win64 DLL or some other reason.';
exit;
end;
DllGetDataSnapClassObject := GetProcAddress( DllHandle, dllSubN);
if nil = DllGetDataSnapClassObject then begin // ???µ ???°?????µ???°
msg := msg + #13#10 +
'Incompatible library loaded ' + fName + '. Missed function ' + dllSubN;
FreeLibrary( DllHandle );
DllHandle := 0;
end;
Result := true;
end;
function TryTwo(const fName: TFileName): boolean; // seek in the given folder and its immediate parent
begin
Result := TryOne(fName + dllFN);
if not Result then
Result := TryOne(fName + '..' + dllFN); //
end;
begin
fPath := ExtractFilePath( ParamStr(0) );
if TryTwo( fPath ) then exit;
fPath := IncludeTrailingBackslash( GetCurrentDir() );
if TryTwo( fPath ) then exit;
fPath := RegisteredMidasPath;
if fPath > '' then
if TryOne( fPath ) then exit;
msg := 'This program needs the library ' + dllFN + ' version 16.0 or above.'#13#10 +
'It was not found, thus the program can not work.'#13#10 + #13#10 + msg;
Winapi.Windows.MessageBox(0, PChar(msg), 'Launch failure!',
MB_ICONSTOP or MB_TASKMODAL or MB_DEFAULT_DESKTOP_ONLY or MB_TOPMOST );
Halt(1);
end;
initialization
// RegisterMidasLib(@DllGetDataSnapClassObject); -- static linking does not work for utilities in sub-folders
TryFindMidas; // immediately terminates the application if not found
RegisterMidasLib(DllGetDataSnapClassObject);
finalization
if DllHandle <> 0 then
if FreeLibrary( DllHandle ) then
DllHandle := 0;
end.