MidasLib.dcu makes the application slower

后端 未结 2 1593
佛祖请我去吃肉
佛祖请我去吃肉 2020-12-06 17:33

I´m declaring MidasLib to avoid dll hell caused by Midas.dll in some clients.

The code below runs in about 2350ms. If I remove the MidaLib declaration in uses it sta

相关标签:
2条回答
  • 2020-12-06 17:34

    It is a known bug/regression, see the QC reports

    • http://qc.embarcadero.com/wc/qcmain.aspx?d=109476
    • http://qc.embarcadero.com/wc/qcmain.aspx?d=107346
    0 讨论(0)
  • 2020-12-06 17:54

    We just use local copy of Midas DLL regardless of what is installed in the system, and only falling back to global one, if local one is not found.

    We use XE2 upd4 hf1 and we later switched to Midas DLL of XE4 ( main project still is made with 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 = '\SOFTWARE\Classes\CLSID\{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.
    
    0 讨论(0)
提交回复
热议问题