MidasLib.dcu makes the application slower

问题:

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 starts to run in just 45ms!!

The data.xml file was saved with TClientDataSet.SaveToFile method, has 5000 records and its size is about 600Kb.

Does anybody knows how to explain this weird behavior?

I can confirm the problem in Delphi XE2 upd 3 and in Delphi XE3 upd 2.

Thanks.

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.

回答1:

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

回答2:

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.

回答3:

I'm not sure why you think you need to use MidasLib to "avoid DLL hell".

When the RTL calls TCustomClientDataSet.CreateDSBase, this calls CheckDbClient in DSIntf.Pas. It is this routine which determines which instance of Midas.Dll is loaded, by examining the registry.

So, you could ensure that a particular instance of Midas.Dll is used by ensuring that the registry reflects its location before CheckDbClient is called. The registry setting is InProcServer32 under HK_Classes_Root\CLSId\{9E8D2FA1-591C-11D0-BF52-0020AF32BD64}. It can be updated by calling RegisterComServer specifying the Midas path and filename, subject to necessary registry access permissions, of course.