Попытка вызвать WMI в DLL библиотеке приводит к зависанию
Я столкнулся с неприятной проблемой. Мне нужно получить уникальный HWID компьютера через WMI. Вот код:
library gguard;
uses
Windows,
SysUtils,
ActiveX,
ComObj;
{$R *.res}
function GetWMIstring(wmiHost, root, wmiClass, wmiProperty: string): string;
var
objWMIService : OLEVariant;
colItems : OLEVariant;
colItem : OLEVariant;
oEnum : IEnumvariant;
iValue : LongWord;
function GetWMIObject(const objectName: String): IDispatch;
var
chEaten: Integer;
BindCtx: IBindCtx;//for access to a bind context
Moniker: IMoniker;//Enables you to use a moniker object
begin
OleCheck(CreateBindCtx(0, bindCtx));
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));//Converts a string into a moniker that identifies the object named by the string
OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));//Binds to the specified object
end;
begin
objWMIService := GetWMIObject(Format('winmgmts:\\%s\%s',[wmiHost,root]));
colItems := objWMIService.ExecQuery(Format('SELECT * FROM %s',[wmiClass]),'WQL',0);
oEnum := IUnknown(colItems._NewEnum) as IEnumVariant;
while oEnum.Next(1, colItem, iValue) = 0 do
begin
Result:=colItem.Properties_.Item(wmiProperty, 0); //you can improve this code ;) , storing the results in an TString.
end;
end;
var
i,HWID: Integer;
TString: String;
begin
try
HWID := 0;
CoInitialize(nil);
try
TString := GetWMIstring('.', 'root\CIMV2', 'Win32_BIOS','SerialNumber');
for i:=1 to length(TString) do HWID := HWID xor (ord(TString[i]) shl (i-1)*2);
TString := GetWMIstring('.', 'root\CIMV2', 'Win32_BaseBoard','Manufacturer');
for i:=1 to length(TString) do HWID := HWID xor (ord(TString[i]) shl (i-1)*2);
TString := GetWMIstring('.', 'root\CIMV2', 'Win32_BaseBoard','Product');
for i:=1 to length(TString) do HWID := HWID xor (ord(TString[i]) shl (i-1)*2);
TString := GetWMIstring('.', 'root\CIMV2', 'Win32_BaseBoard','SerialNumber');
for i:=1 to length(TString) do HWID := HWID xor (ord(TString[i]) shl (i-1)*2);
TString := GetWMIstring('.', 'root\CIMV2', 'Win32_Processor','Name');
for i:=1 to length(TString) do HWID := HWID xor (ord(TString[i]) shl (i-1)*2);
TString := GetWMIstring('.', 'root\CIMV2', 'Win32_Processor','ProcessorId');
HWID := HWID xor StrToInt(GetWMIstring('.', 'root\CIMV2', 'Win32_Processor','UpgradeMethod'))
xor StrToInt('$'+Copy(TString,9,8)) xor StrToInt('$'+Copy(TString,1,8));
finally
CoUninitialize;
MessageBox(0,Pchar('Ну вот =)'+IntToHex(HWID,8)),'HWID Generator',MB_OK + MB_ICONSTOP + MB_DEFBUTTON1);
end;
except
on E:Exception do
Begin
MessageBox(0,Pchar('Произошла ошибка :('+#13#10+E.Classname+': '+E.Message+#13#10+TString),'HWID Generator',MB_OK + MB_ICONSTOP + MB_DEFBUTTON1);
TerminateProcess(GetCurrentProcess,1);
End;
end;
end.
Запускаю DLLку через EXEшник этим кодом:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var h: THandle;
begin
h := LoadLibrary('gguard.dll');
if bool(h) then
FreeLibrary(h);
end;
end.
Но вот проблема. Если этот код выполнить под DLLкой, то напрочь зависает на строчке
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));
А именно зависает функция MkParseDisplayName()
.
Но если пустить этот код прямо под EXEшник, то всё отлично, код работает. В чём может быть причина такого?