Модераторы: Snowy, bartram, MetalFan, bems, Poseidon, Riply
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> нестабильная работа WMI 
:(
    Опции темы
Coder
Дата 17.2.2011, 04:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 733
Регистрация: 13.12.2004

Репутация: 1
Всего: 11
Здравствуйте!
Решил рассчитывать ID на основе некоторой системной информации. Использую WMI, разбирался, как с ним работать вот по этой статье http://www.delphisources.ru/pages/faq/base/wmi_use.html
Проблема в том, что обращение к WMI не всегда стабильно. Иногда программа висит, иногда вываливает AV. Но в 90% случаев все отрабатывается нормально.
Вот весь код (проект на чистом WinAPI). ID считается в потоке, который запускается в самом начале выполнения программы. 
В чем может быть проблема?

Код

function _Threaded_CalcCompID(lpParameter : Pointer) : DWORD; stdcall;
var
  SWbemLocator : TSWbemLocator;
  Service : ISWbemServices;
  SObject : ISWbemObject;
  ObjectSet : ISWbemObjectSet;
  PropEnum, Enum : IEnumVariant;
  TempObj : OleVariant;
  Value : Cardinal;
  PropSet : ISWbemPropertySet;
  SProp : ISWbemProperty;

  _temp : string;
begin
  result:=1;

  if g_CompID=nil then
    exit;

  CoInitialize(nil);

  SWbemLocator:=TSWbemLocator.Create(nil);
  Service:=SWbemLocator.ConnectServer('.', 'root\cimv2', '', '', '', '', 0, nil);

  SObject:=Service.Get('Win32_BIOS', wbemFlagUseAmendedQualifiers, nil);
  ObjectSet:= SObject.Instances_(0, nil);
  Enum:=(ObjectSet._NewEnum) as IEnumVariant;
  _temp:='';
  if (Enum.Next(1, TempObj, Value) = S_OK) then
    begin
      SObject:= IUnknown(TempObj) as SWBemObject;
      PropSet:= SObject.Properties_;
      PropEnum:= (PropSet._NewEnum) as IEnumVariant;
      // начинаю перебирать свойства
      while (PropEnum.Next(1, TempObj, Value) = S_OK) do
        begin
          SProp:= IUnknown(TempObj) as SWBemProperty;

          if LowerCase(SProp.Name)='releasedate' then
            _temp:=GetPropValue(SProp)
          else if LowerCase(SProp.Name)='version' then
            _temp:=GetPropValue(SProp);

          if _temp<>'' then
            begin
              g_CompID^:=g_CompID^+CalcStrHash(_temp);
              _temp:='';
            end;
        end;
    end;

  SObject:=Service.Get('Win32_BaseBoard', wbemFlagUseAmendedQualifiers, nil);
  ObjectSet:= SObject.Instances_(0, nil);
  Enum:=(ObjectSet._NewEnum) as IEnumVariant;
  _temp:='';
  if (Enum.Next(1, TempObj, Value) = S_OK) then
    begin
      SObject:= IUnknown(TempObj) as SWBemObject;
      PropSet:= SObject.Properties_;
      PropEnum:= (PropSet._NewEnum) as IEnumVariant;
      while (PropEnum.Next(1, TempObj, Value) = S_OK) do
        begin
          SProp:= IUnknown(TempObj) as SWBemProperty;

          if LowerCase(SProp.Name)='product' then
            _temp:=GetPropValue(SProp);

          if _temp<>'' then
            begin
              g_CompID^:=g_CompID^+CalcStrHash(_temp);
              _temp:='';
            end;
        end;
    end;

  Result:=0;
end;



Это сообщение отредактировал(а) Coder - 17.2.2011, 04:24
PM MAIL   Вверх
MetalFan
Дата 17.2.2011, 10:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Аццкий Сотона
****


Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 16
Всего: 128
мда... никакого контроля ошибок, или хотя бы на assigned возвращаемых интерфейсов...
Добавь хотя бы примитивное логирование, тогда и будет видно, на чем вылетает.


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
Coder
Дата 17.2.2011, 12:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 733
Регистрация: 13.12.2004

Репутация: 1
Всего: 11
Цитата(MetalFan @  17.2.2011,  18:09 Найти цитируемый пост)
мда... никакого контроля ошибок, или хотя бы на assigned возвращаемых интерфейсов...Добавь хотя бы примитивное логирование, тогда и будет видно, на чем вылетает.

Да, этим я не занимался. Фактически повторил все за автором статьи. ну и обнаружил, что код не стабилен. Сюда запостил, в надежде, что кто-нибудь знает нюансы или подводные камни работы с WMI.
Что же, сейчас сооружу лог. Посмотрим что там будет....

Добавлено через 6 минут и 12 секунд
Вот нашел отличный официальный пример
http://msdn.microsoft.com/en-us/library/aa...3(v=vs.85).aspx
PM MAIL   Вверх
cat512
Дата 17.2.2011, 14:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 438
Регистрация: 20.3.2007

Репутация: 1
Всего: 15
Не знаю, у меня никогда с wmi Access не вылетал, на некоторых запросах Wql, wmi тормозил серьёзно - это да, но Access-a никогда небыло.  
Кстати где Couninitialize?
PM MAIL   Вверх
Coder
Дата 17.2.2011, 15:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 733
Регистрация: 13.12.2004

Репутация: 1
Всего: 11
cat512, 
Вы можете показать свои примеры?

Цитата(cat512 @  17.2.2011,  22:13 Найти цитируемый пост)
Кстати где Couninitialize?

На нем всегда и однозначно AV! Даже в пустом консольном приложении (я сейчас там разбираюсь с WMI). 

Привожу код. Переписал по примеру с сайта MS. 
извиняюсь, что не прикрепил файл. прокси не позволяет )
Значит так, пока не расставил везде вывод лога в файл один раз поймал тот самый AV. Расставил, запускаю, но поймать уже не могу ))
AV проявляется так. Запускаю программу она подвисает на какой-то функции и AV...
Код

program WMI_Test;

{$APPTYPE CONSOLE}

uses
  SysUtils, ActiveX, WbemScripting_TLB,ComObj;

var
  log : TextFile;

  hres : HRESULT;

  pLoc  : TSWbemLocator;
  pSvc  : ISWbemServices;
  pObjSet : ISWbemObjectSet;
  pObj, pObj2 : ISWbemObject;
  PropEnum, Enum:      IEnumVariant;
  TempObj:             OleVariant;
  Value:               Cardinal;
  PropSet:             ISWbemPropertySet;
  SProp:               ISWbemProperty;


procedure to_log(_str : string);
begin
  writeln(log,_str);
  flush(log);
end;

begin
  try
    AssignFile(log,'c:\wmi_log.txt');
    Append(log);
    to_log('************************************');    
    to_log('Programm started!');

    // Step 1: --------------------------------------------------
    // Initialize COM. ------------------------------------------
    to_log('CoInitializeEx');
    hres := CoInitializeEx(nil, COINIT_MULTITHREADED);
    if (FAILED(hres)) then
      begin
        to_log(#9'CoInitializeEx - ERROR');
        exit;
      end;
    to_log(#9'CoInitializeEx - OK');

    // Step 2: --------------------------------------------------
    // Set general COM security levels --------------------------
    // Note: If you are using Windows 2000, you need to specify -
    // the default authentication credentials for a user by using
    // a SOLE_AUTHENTICATION_LIST structure in the pAuthList ----
    // parameter of CoInitializeSecurity ------------------------
    to_log('CoInitializeSecurity');
    hres :=  CoInitializeSecurity(
        nil,
        -1,                          // COM authentication
        nil,                        // Authentication services
        nil,                        // Reserved
        {RPC_C_AUTHN_LEVEL_DEFAULT}0,   // Default authentication
        {RPC_C_IMP_LEVEL_IMPERSONATE}3, // Default Impersonation
        nil,                        // Authentication info
        {EOAC_NONE}0,                   // Additional capabilities
        nil                         // Reserved
        );
    if (FAILED(hres)) then
      begin
        to_log(#9'CoInitializeSecurity - ERROR');
        exit;
      end;
    to_log(#9'CoInitializeSecurity - OK');

    // Step 3: ---------------------------------------------------
    // Obtain the initial locator to WMI -------------------------

    to_log('TSWbemLocator.Create');
    pLoc := TSWbemLocator.Create(nil);
    if not Assigned(pLoc) then
      begin
        to_log(#9'TSWbemLocator.Create - ERROR');
        exit;
      end;
    to_log(#9'TSWbemLocator.Create - OK');      

    // Step 4: -----------------------------------------------------
    // Connect to WMI through the IWbemLocator::ConnectServer method
    // Connect to the root\cimv2 namespace with
    // the current user and obtain pointer pSvc
    // to make IWbemServices calls.
    to_log('pLoc.ConnectServer');
    pSvc:=pLoc.ConnectServer('','root\cimv2','','','','',0,nil);
      if not Assigned(pSvc) then
      begin
        to_log(#9'pLoc.ConnectServer - ERROR');
        exit;
      end;
    to_log(#9'pLoc.ConnectServer - OK');

    // Step 5: --------------------------------------------------
    // Set security levels on the proxy -------------------------
    to_log('CoSetProxyBlanket');
    hres := CoSetProxyBlanket(
       pSvc,                        // Indicates the proxy to set
       {RPC_C_AUTHN_WINNT}10,           // RPC_C_AUTHN_xxx
       {RPC_C_AUTHZ_NONE}0,            // RPC_C_AUTHZ_xxx
       nil,                        // Server principal name
       {RPC_C_AUTHN_LEVEL_CALL}3,      // RPC_C_AUTHN_LEVEL_xxx
       {RPC_C_IMP_LEVEL_IMPERSONATE}3, // RPC_C_IMP_LEVEL_xxx
       nil,                        // client identity
       {EOAC_NONE}0                    // proxy capabilities
    );
    if (FAILED(hres)) then
      begin
        to_log(#9'CoSetProxyBlanket - ERROR');
        exit;
      end;
    to_log(#9'CoSetProxyBlanket - OK');

    // ISWbemObjectSet = IEnumWbemClassObject

    // Step 6: --------------------------------------------------
    to_log('pSvc.Get');
    pObj:=pSvc.Get('Win32_BIOS',wbemFlagUseAmendedQualifiers,nil);
    if not Assigned(pObj) then
      begin
        to_log(#9'pSvc.Get - ERROR');
//        pSvc._Release;
//        pLoc.Free;
//        CoUninitialize();
        exit;
      end;
    to_log(#9'pSvc.Get - OK');

    to_log('pObj.Instances_');
    pObjSet:=pObj.Instances_(0,nil);
    if not Assigned(pObjSet) then
      begin
        to_log(#9'pObj.Instances_ - ERROR');
        exit;
      end;
    to_log(#9'pObj.Instances_ - OK');      

    to_log('Enum');
    Enum:=(pObjSet._NewEnum) as IEnumVariant;
    if not Assigned(Enum) then
      begin
        to_log(#9'Enum - ERROR');
        exit;
      end;
    to_log(#9'Enum - OK');      

    to_log('Enum.Next');
    if (Enum.Next(1, TempObj, Value) = S_OK) then
      begin
        // здесь по идеет должно быть все валидно. цепочка от TempObj
        pObj2:= IUnknown(TempObj) as SWBemObject;
        PropSet:= pObj2.Properties_;
        PropEnum:= (PropSet._NewEnum) as IEnumVariant;
        // начинаю перебирать свойства
        while (PropEnum.Next(1, TempObj, Value) = S_OK) do
          begin
            SProp:= IUnknown(TempObj) as SWBemProperty;
            Writeln(SProp.Name);
          end;

        to_log(#9'Enum.Next - OK');
      end
    else
      to_log(#9'Enum.Next - ERROR');

//    CoUninitialize;   <<<< AV here!!

    to_log('End of programm!');
    CloseFile(log);
  except
    on E:Exception do
      to_log('!!!VA - '+E.Classname+': '+E.Message);
  end;
end.
PM MAIL   Вверх
cat512
Дата 17.2.2011, 16:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 438
Регистрация: 20.3.2007

Репутация: 1
Всего: 15
Да, как только найду выложу. Наводящий вопрос: А будет ли AV если этот код выполнить в основном потоке? 
PM MAIL   Вверх
Coder
Дата 18.2.2011, 01:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 733
Регистрация: 13.12.2004

Репутация: 1
Всего: 11
Цитата(cat512 @  18.2.2011,  00:04 Найти цитируемый пост)
Да, как только найду выложу. Наводящий вопрос: А будет ли AV если этот код выполнить в основном потоке? 

Первый мой пример в отдельном потоке, второй в основном. Разницы нет, иногда выпадают.... Проверял на двух компьютерах с WinXP SP3.
PM MAIL   Вверх
northener
Дата 18.2.2011, 02:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1361
Регистрация: 2.9.2010

Репутация: нет
Всего: 20
Цитата(Coder @  17.2.2011,  12:46 Найти цитируемый пост)
Да, этим я не занимался. Фактически повторил все за автором статьи

Стандартная судьба "копипастера".


--------------------
Но только лошади летают вдохновенно.
Иначе лошади разбились бы мгновенно!
PM MAIL   Вверх
Coder
Дата 18.2.2011, 03:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 733
Регистрация: 13.12.2004

Репутация: 1
Всего: 11
Цитата(northener @  18.2.2011,  10:45 Найти цитируемый пост)
Стандартная судьба "копипастера".

Смотрите ниже я все переделал.
PM MAIL   Вверх
cat512
Дата 18.2.2011, 09:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 438
Регистрация: 20.3.2007

Репутация: 1
Всего: 15
Вот часть кода из моих исходников, выполняется в основном потоке
Код

Type
  TUsbController = class
  private
    FLock: TCriticalSection;
    FUsbDrives: TObjectList;
    FActiveUsbIndex: integer;
    FWmiLocator: ISWbemLocator;
    FWmiServices: ISWbemServices;
    FWmiCreationSinkObj,
    FWmiDeletionSinkObj: TSWbemSink;
............................................................
............................................................
............................................................
   end;

implementation

constructor TUsbController.Create;
begin
  FUsbDrives := TObjectList.Create(True);
  FActiveUsbIndex := -1;
  if not CfgMgr32.IsConfigManagerApiLoaded then
    LoadConfigManagerApi;

  FWmiLocator := CoSWbemLocator.Create;
    FWmiServices :=
      FWmiLocator.ConnectServer(
        '.',
        'root\CIMV2',
        '',
        '',
        '',
        '',
        0,
        nil
        );
    FWmiCreationSinkObj := TSWbemSink.Create(nil);
    FWmiDeletionSinkObj := TSWbemSink.Create(nil);
    FWmiCreationSinkObj.OnObjectReady := DoUpdateDevices;
//    FWmiCreationSinkObjSinkObj.OnCompleted := DoCompleeteEvent;
    FWmiDeletionSinkObj.OnObjectReady := DoUpdateDevices;
    //FWmiDeletionSinkObjSinkObj.OnCompleted := DoCompleeteEvent;
    FSplashFormClass := TfmMdlDetectHardware;
    SetEventsHandlers;
end;


destructor TUsbController.Destroy;
begin
  FUsbDrives.Clear;
  FUsbDrives.Free;
  FWmiServices := nil;
  FWmiLocator := nil;
  FWmiCreationSinkObj.free;
  FWmiDeletionSinkObj.Free;
  if IsConfigManagerApiLoaded then
    UnloadConfigManagerApi;
  if IsSetupApiLoaded then
    UnloadSetupApi;
  inherited;
end;

procedure TUsbController.GetRemovableUsbDrives(UsbDrives: TList);
const
  cSelectLogical =
      'SELECT * FROM WIN32_DISKDRIVE  WHERE InterfaceType = USB';

var
//  WmiLocator: ISWbemLocator;
//  FWmiServices : ISWbemServices;
  Obj, LogObj, DiskPartitionObj, LogPartitionObj: ISWbemObject;
  Objs, DiskPartitionObjs, PartitionObjs, LogPartitionObjs: ISWbemObjectSet;
  ResultObj: OleVariant;
  Enum, DsckPartitionEnum, PartitionEnum, LogPartitionEnum: IEnumVariant;
  qSelectLogical, qTemp, Buf: Widestring;
  Value: Cardinal;
  Drivetype,
  Name,
  DeviceID,
  Description,
  PnpdeviceId,
  Vendor: ISWbemProperty;
  Info: TUsbInfo;
begin

    if not Assigned(FWmiServices ) then Exit;

    Objs :=
      FWmiServices .ExecQuery(
        cSelectLogical,
        'WQL',
        wbemFlagReturnImmediately,
        nil
        );

    if not Assigned(Objs) and
      VarIsNull(Objs.Count) and (Objs.Count <= 0) then Exit;

    Enum := Objs._NewEnum as IEnumVariant;
    while Enum.Next(1, ResultObj, Value) = S_OK do
    begin
      Obj := IUnknown(ResultObj) as ISWbemObject;
  //    Name := Obj.Properties_.Item('Name', 0);
      PnpDeviceId := Obj.Properties_.Item('PnpDeviceId', 0);
      Vendor := Obj.Properties_.Item('Model', 0);
      DeviceId := Obj.Properties_.Item('DeviceId', 0);
      Buf :=
        WideString(
          StringReplace(
            VarToStrDef(
              DeviceId.Get_Value,
              ''
              ),
              '\',
              '\\',
              [rfReplaceAll]
            )
          );
...
...
...
end;



Добавлено через 4 минуты и 27 секунд
Когда то взял себе за правило- с COM всегда работать через описания интерфейсов (не используя vcl-враперы TOleServer)
PM MAIL   Вверх
Coder
Дата 18.2.2011, 15:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 733
Регистрация: 13.12.2004

Репутация: 1
Всего: 11
cat512, спасибо протестирую Ваш вариант на стабильность. У вас же все нормально работало? Может и правда дело в моей среде.... на двух компьютерах стоит XP  с одного диска.
PM MAIL   Вверх
cat512
Дата 18.2.2011, 16:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 438
Регистрация: 20.3.2007

Репутация: 1
Всего: 15
Да, у меня wmi работал стабильно
PM MAIL   Вверх
Coder
Дата 22.2.2011, 15:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 733
Регистрация: 13.12.2004

Репутация: 1
Всего: 11
cat512, 
Погонял программу с вашим кодом.... и я понял в чем проблема - периодически программа не может достучатся до некоторых классов WMI через WQL запрос. Возможно дело в флаге wbemFlagReturnImmediately, но как задать тайм аут на выполнение запроса не нашел. может система не успевает отвечать .... ?
PM MAIL   Вверх
cat512
Дата 22.2.2011, 16:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 438
Регистрация: 20.3.2007

Репутация: 1
Всего: 15
Цитата(Coder @ 22.2.2011,  15:16)
cat512, 
Погонял программу с вашим кодом.... и я понял в чем проблема - периодически программа не может достучатся до некоторых классов WMI через WQL запрос.

Каким образом это проявляется? Вылетает AV? Нет ответа длятельное время от сервиса?
Можешь попробовать wbemFlagReturnWhenComplete (синхронный режим), но тогда будешь ожидать окончания запроса. Либо асинхронный (надо создовать объекты события)
http://msdn.microsoft.com/en-us/library/aa...0(v=vs.85).aspx

Это сообщение отредактировал(а) cat512 - 22.2.2011, 17:12
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: WinAPI и системное программирование"
Snowybartram
MetalFanbems
PoseidonRrader
Riply

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • 99% ответов по WinAPI можно найти в MSDN Library, оставшиеся 1% здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, bartram, MetalFan, bems, Poseidon, Rrader, Riply.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: WinAPI и системное программирование | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0649 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.