Попытка вызвать WMI в DLL библиотеке приводит к зависанию

Рейтинг: 0Ответов: 1Опубликовано: 13.02.2015

Я столкнулся с неприятной проблемой. Мне нужно получить уникальный 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шник, то всё отлично, код работает. В чём может быть причина такого?

Ответы

▲ 1

Она у вас не просто зависает, а попадает в DeadLock. Почему это происходит написано здесь и здесь. В двух словах:

Функция LoadLibrary работает так: Если указанный моудь (библиотека) еще не загружена для вызывающего приложения, система вызывает из библиотеки функцию DllMain. Это и есть ваш код между главными begin и end в библиотеке. В данном случае это конструкция try..except.

На картинке видно, что перед выполнением DllMain система входит в критическую секцию (LoaderLock) и только после выполнения выходит из нее. Если во время выполнения DllMain системе понадобится загрузить другую библиотеку, это приведет к тому, что она попытается снова войти в эту же самую критическую секцию, только уже из другого потока. Таким образом ваш DllMain зависнет в бесконечном ожидании загрузки требуемой библиотеки. Что вы и наблюдаете.

Чуть ниже картинки написано, что нельзя делать в DllMain: создавать потоки, процессы, загружать библиотеки, выходить из потока и т.д. Там большой список.

Чтобы этого всего избежать, вам нужно свой код вынести из DllMain в экспортируемую функцию (см. справку по ключевому слову exports). И после загрузки библиотеки из приложения, получить адрес нужной функции (GetProcAddress) и пользоваться ей.