I'm声明MidasLib避免一些客户造成MIDAS.DLL DLL地狱。
下面的代码运行在约2350ms。 如果我删除MidaLib声明中使用它开始在短短的45ms运行！
data.xml文件的保存与TClientDataSet.SaveToFile方法，有5000条记录，其大小约的600Kb。
有谁知道如何解释这种怪异的行为？
我可以证实在Delphi XE2 UPD 3和德尔福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.
我们只是用迈达斯DLL的本地副本，无论是什么安装在系统中，只有回落到全球性的，如果当地的一个也没有找到。
我们使用XE2 upd4 HF1，我们后来改用XE4的迈达斯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.
我不知道为什么你认为你需要使用MidasLib“避免DLL地狱”。
当RTL调用TCustomClientDataSet.CreateDSBase ，这叫CheckDbClient在DSIntf.Pas。 正是这种程序确定，其这MIDAS.DLL实例被加载，通过检查注册表。
所以，你可以确保MIDAS.DLL的特定实例用来通过确保注册表反映其位置之前CheckDbClient被调用。 注册表设置是InProcServer32下HK_Classes_Root\CLSId\{9E8D2FA1-591C-11D0-BF52-0020AF32BD64} 。 它可以通过调用更新RegisterComServer指定课程的迈达斯路径和文件名，如有必要注册表的访问权限。
