MidasLib.dcu 使应用程序变慢。

12

为了避免一些客户端中Midas.dll所造成的动态链接库混乱,我声明了MidasLib。

下面的代码运行大约需要2350毫秒。如果我移除uses中的MidasLib声明,它将在仅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.

6
现有的缺陷报告链接:http://qc.embarcadero.com/wc/qcmain.aspx?d=109476,http://qc.embarcadero.com/wc/qcmain.aspx?d=107346。 - bummi
哪个版本的 Delphi? - Mason Wheeler
这里有问题吗? - Nick Hodges
3
问题是:“有人知道如何解释这种奇怪的行为吗?” 这与标题“MidasLib.dcu使应用程序变慢”有关。 - Wodzu
1
嗨,请考虑接受一个答案。 - mjn
显示剩余3条评论
2个回答

7

请注意,QualityCentral现已关闭,因此您无法再访问qc.embarcadero.com链接。如果您需要访问旧的QC数据,请查看QCScraper - Remy Lebeau

2
我们只使用本地副本的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.

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接