问题
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.
来源:https://stackoverflow.com/questions/15449386/midaslib-dcu-makes-the-application-slower