MidasLib.dcu замедляет работу приложения

Я объявляю MidasLib, чтобы избежать ада dll, вызванного Midas.dll в некоторых клиентах.

Приведенный ниже код работает примерно за 2350 мс. Если я удалю объявление MidaLib при использовании, оно начнет работать всего за 45 мс !!

Файл data.xml был сохранен с помощью метода TClientDataSet.SaveToFile, имеет 5000 записей и его размер составляет около 600 КБ.

Кто-нибудь знает, как объяснить это странное поведение?

Я могу подтвердить проблему в 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.

delphi tclientdataset
person Roger Perezin    schedule 16.03.2013    source источник
comment
существующие отчеты об ошибках qc.embarcadero.com/wc/qcmain.aspx?d=109476, qc.embarcadero.com/wc/qcmain.aspx?d= 107346   -  person bummi    schedule 16.03.2013
comment
Какая версия Delphi?   -  person Mason Wheeler    schedule 16.03.2013
comment
А какая именно версия Midas.dll используется?   -  person afrazier    schedule 16.03.2013
comment
@bummi Да, похоже, это известная ошибка. Проголосовал. Судя по всему, мне пока придется с этим жить, спасибо   -  person Roger Perezin    schedule 16.03.2013
comment
@afrazier Проблема в MidasLib.dcu. Midas.dll работает нормально.   -  person Roger Perezin    schedule 16.03.2013
comment
Здесь есть вопрос?   -  person Nick Hodges    schedule 17.03.2013
comment
Да, вопрос в том, знает ли кто-нибудь, как объяснить это странное поведение? в сочетании с заголовком MidasLib.dcu замедляет работу приложения   -  person Wodzu    schedule 08.04.2013
comment
Привет, пожалуйста, подумайте, чтобы принять ответ   -  person mjn    schedule 17.05.2017

Ответы (2)


arrow_upward
7
arrow_downward

Это известная ошибка / регресс, см. Отчеты QC.

person mjn    schedule 16.04.2013
comment
Обратите внимание, что QualityCentral теперь закрыт, так что вы можете Больше нет доступа к qc.embarcadero.com ссылкам. Если вам нужен доступ к старым данным QC, посмотрите QCScraper. - person Remy Lebeau; 09.06.2017

arrow_upward
1
arrow_downward

Мы просто используем локальную копию Midas DLL независимо от того, что установлено в системе, и только откатываемся к глобальной, если локальная не найдена.

Мы используем XE2 upd4 hf1, а позже мы перешли на Midas DLL из XE4 (основной проект по-прежнему выполняется с 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.
person Arioch 'The    schedule 17.05.2017