MidasLib.dcu 使应用程序变慢

Question

我声明 MidasLib 是为了避免在某些客户端中由 Midas.dll 引起的 dll 地狱。

下面的代码运行大约 2350 毫秒。如果我删除使用中的 MidaLib 声明，它会在 45 毫秒内开始运行！！

data.xml文件是用TClientDataSet.SaveToFile方法保存的，有5000条记录，大小约为600Kb。

有人知道如何解释这种奇怪的行为吗？

我可以在 Delphi XE2 upd 3 和 Delphi XE3 upd 2 中确认问题。

谢谢。

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

无论系统中安装了什么，我们都只使用Midas DLL的本地副本，如果没有找到本地的，则只回退到全局的。

我们使用XE2 upd4 hf1，后来我们切换到XE4的Midas DLL（主要项目仍然是用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.

Answer 2

这是一个已知的错误/回归，请参阅 QC 报告

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