MidasLib.dcu делает приложение медленнее


6

Это известная ошибка / регрессия, см. Отчеты QC


0

Я не уверен, почему вы думаете, что вам нужно использовать MidasLib для «избежания аддона DLL».

Когда звонит RTL TCustomClientDataSet.CreateDSBase, это вызывает CheckDbClientDSIntf.Pas. Именно эта процедура определяет, какой экземпляр Midas.Dll загружен, путем изучения реестра.

Таким образом, вы можете убедиться, что конкретный экземпляр Midas.Dll используется для обеспечения того, что реестр отражает его местоположение до вызова CheckDbClient. Параметр реестра находится InProcServer32ниже HK_Classes_RootCLSId{9E8D2FA1-591C-11D0-BF52-0020AF32BD64}. Он может быть обновлен, вызывая RegisterComServerуказание пути Midas и имени файла, с учетом необходимых разрешений на доступ к реестру, конечно.


0

Мы просто используем локальную копию 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.
Дельфы, TClientDataSet,

delphi,tclientdataset,

10

Ответов: 3


6

Это известная ошибка / регрессия, см. Отчеты QC


0

Я не уверен, почему вы думаете, что вам нужно использовать MidasLib для «избежания аддона DLL».

Когда звонит RTL TCustomClientDataSet.CreateDSBase, это вызывает CheckDbClientDSIntf.Pas. Именно эта процедура определяет, какой экземпляр Midas.Dll загружен, путем изучения реестра.

Таким образом, вы можете убедиться, что конкретный экземпляр Midas.Dll используется для обеспечения того, что реестр отражает его местоположение до вызова CheckDbClient. Параметр реестра находится InProcServer32ниже HK_Classes_RootCLSId{9E8D2FA1-591C-11D0-BF52-0020AF32BD64}. Он может быть обновлен, вызывая RegisterComServerуказание пути Midas и имени файла, с учетом необходимых разрешений на доступ к реестру, конечно.


0

Мы просто используем локальную копию 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.
Дельфы, TClientDataSet,
Похожие вопросы