MidasLib.dcu spowalnia aplikację

Question

Zgłaszam MidasLib, aby uniknąć piekła dll spowodowanego przez Midas.dll w niektórych klientach.

Poniższy kod trwa około 2350ms. Jeśli usunę deklarację MidaLib w użyciu, zacznie działać w ciągu 45 ms !!

Plik data.xml został zapisany metodą TClientDataSet.SaveToFile, ma 5000 rekordów, a jego rozmiar to około 600 KB.

Czy ktoś wie, jak wyjaśnić to dziwne zachowanie?

mogę potwierdzić problem w Delphi XE2 UPD 3 oraz w Delphi XE3 UPD 2.

Dzięki.

program Loader; 

{$APPTYPE CONSOLE} 

{$R *.res} 

uses 
    MidasLib, 
    System.SysUtils, 
    Winapi.Windows, 
    Data.DB, 
    Datasnap.DBClient; 

var 
    cds : TClientDataSet; 
    start, stop : Cardinal; 
begin 
    cds := TClientDataSet.Create(nil); 
    try 
    start := GetTickCount; 
    cds.LoadFromFile('c:\temp\data.xml'); 
    stop := GetTickCount; 
    Writeln(Format('Time elapsed: %dms', [stop-start])); 
    finally 
    cds.Free; 
    end; 
end. 

Answer 1

Jest to znany bug/regresja, zobacz QC donosi

• http://qc.embarcadero.com/wc/qcmain.aspx?d=109476
• http://qc.embarcadero.com/wc/qcmain.aspx?d=107346

Answer 2

Nie jestem pewien, dlaczego uważasz, że trzeba użyć do MidasLib "unikaj piekła DLL".

Gdy połączenie RTL wywołuje TCustomClientDataSet.CreateDSBase, wywołuje to CheckDbClient w DSIntf.Pas. Ta procedura określa, która instancja pliku Midas.Dll jest ładowana, sprawdzając rejestr.

Dzięki temu można upewnić się, że konkretna instancja pliku Midas.Dll jest używana, zapewniając, że rejestr będzie odzwierciedlał swoją lokalizację przed wywołaniem CheckDbClient. Ustawienie rejestru to InProcServer32 pod numerem HK_Classes_Root\CLSId\{9E8D2FA1-591C-11D0-BF52-0020AF32BD64}. Można go zaktualizować, dzwoniąc pod numer RegisterComServer, określając ścieżkę i nazwę pliku Midas, oczywiście z zastrzeżeniem koniecznych uprawnień dostępu do rejestru.

Answer 3

Używamy tylko lokalnej kopii biblioteki DLL Midas, niezależnie od tego, co jest zainstalowane w systemie, i cofamy się do globalnej, jeśli nie znaleziono lokalnej.

Używamy xe2 HF1 upd4 a my później włączony do Midas DLL z XE4 (głównego projektu nadal jest wykonany z 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.