Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2017.07.09;
Скачать: CL | DM;

Вниз

Ошибка компиляции   Найти похожие ветки 

 
Михапыч   (2015-10-09 23:40) [0]

Доброго времени суток! Надо программно вкл./выкл устройствами ПК по ID
Нашел такую функцию:

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, Buttons,SetupApi;

const
   DIF_PROPERTYCHANGE                = $00000012;
   DICS_ENABLE     = $00000001;
   DICS_DISABLE    = $00000002;
   DICS_FLAG_GLOBAL         = $00000001;  // make change in all hardware profiles
   DIGCF_PRESENT         = $00000002;
   SPDRP_DEVICEDESC                  = $00000000; // DeviceDesc (R/W)
   SPDRP_CLASS                       = $00000007; // Class (R--tied to ClassGUID)
   SPDRP_CLASSGUID                   = $00000008; // ClassGUID (R/W)
   SPDRP_FRIENDLYNAME                = $0000000C; // FriendlyName (R/W)

type
 {$ifndef fpc}
 ULONG_PTR=DWORD;
 {$endif fpc}

 HDEVINFO = Pointer;
 DI_FUNCTION = LongWord;    // Function type for device installer

 PSPClassInstallHeader = ^TSPClassInstallHeader;
 SP_CLASSINSTALL_HEADER = packed record
   cbSize: DWORD;
   InstallFunction: DI_FUNCTION;
 end;
 TSPClassInstallHeader = SP_CLASSINSTALL_HEADER;

 PSPPropChangeParams = ^TSPPropChangeParams;
 SP_PROPCHANGE_PARAMS = packed record
   ClassInstallHeader: TSPClassInstallHeader;
   StateChange: DWORD;
   Scope: DWORD;
   HwProfile: DWORD;
 end;
 TSPPropChangeParams = SP_PROPCHANGE_PARAMS;

 PSPDevInfoData = ^TSPDevInfoData;
 SP_DEVINFO_DATA = packed record
   cbSize: DWORD;
   ClassGuid: TGUID;
   DevInst: DWORD; // DEVINST handle
   Reserved: ULONG_PTR;
 end;
 TSPDevInfoData = SP_DEVINFO_DATA;

function On_Off_Device(PnPID: PAnsiChar; State: Boolean): Boolean;

var
 DeviceInfoSet_ : HDEVINFO; // Хендл набора информации об устройствах.
 DeviceInfoData_ : TSPDevInfoData; // Структура информации об устройстве.
 SPPropChangeParams_ : TSPPropChangeParams;

begin
 DeviceInfoSet_ := nil;
// Получение хендла набора информации об устройстве по коду экземпляра устройства.
 DeviceInfoSet_ := SetupDiGetClassDevs(nil, PnPID, 0, DIGCF_ALLCLASSES or DIGCF_DEVICEINTERFACE);
 if Integer(DeviceInfoSet_) = INVALID_HANDLE_VALUE then
 begin
// Ошибка.
   Result := False;
   Exit;
 end
 else
 begin
// Хендл набора информации об устройстве получен.
   FillChar(DeviceInfoData_, SizeOf(TSPDevInfoData), 0);
   DeviceInfoData_.cbSize := SizeOf(TSPDevInfoData);
// Заполнение структуры информации об устройстве. Ошибка.
   if not SetupDiEnumDeviceInfo(DeviceInfoSet_, 0, DeviceInfoData_) then
   begin
     SetupDiDestroyDeviceInfoList(DeviceInfoSet_);
     Result := False;
     Exit;
   end;

// Установка полей структуры
   SPPropChangeParams_.ClassInstallHeader.cbSize := SizeOf(TSPClassInstallHeader);
   SPPropChangeParams_.ClassInstallHeader.InstallFunction := DIF_PROPERTYCHANGE;
   SPPropChangeParams_.Scope := DICS_FLAG_GLOBAL;

   if State then SPPropChangeParams_.StateChange := DICS_ENABLE
   else SPPropChangeParams_.StateChange := DICS_DISABLE;

// Изменение состояния устройства.
   if not SetupDiSetClassInstallParams(DeviceInfoSet_,
                                       @DeviceInfoData_,
                                       @SPPropChangeParams_,
                                       SizeOf(TSPPropChangeParams)) then
   begin
// Ошибка.
     SetupDiDestroyDeviceInfoList(DeviceInfoSet_);
     Result := False;
     Exit;
   end;
// Подтверждение изменения состояния устройства
// (повторный вызов функции SetupDiSetClassInstallParams).
   if not SetupDiSetClassInstallParams(DeviceInfoSet_,
                                       @DeviceInfoData_,
                                       @SPPropChangeParams_,
                                       SizeOf(TSPPropChangeParams)) then
   begin
// Ошибка.
     SetupDiDestroyDeviceInfoList(DeviceInfoSet_);
     Result := False;
     Exit;
   end;

// Вызов установщика классов.
   if not SetupDiCallClassInstaller(DIF_PROPERTYCHANGE, DeviceInfoSet_, @DeviceInfoData_) then
   begin
// Ошибка.
     SetupDiDestroyDeviceInfoList(DeviceInfoSet_);
     Result := False;
     Exit;
   end;

 end; // Integer(DeviceInfoSet_) <> INVALID_HANDLE_VALUE

 Result := True;
// Освобождение хендла набора информации об устройствах.
 SetupDiDestroyDeviceInfoList(DeviceInfoSet_);
end;

При компиляции получаю ошибку:

[DCC Error] Unit1.pas(96): E2033 Types of actual and formal var parameters must be identical

на строке:

if not SetupDiEnumDeviceInfo(DeviceInfoSet_, 0, DeviceInfoData_) then

Куда копать..?


 
Михалыч   (2015-10-09 23:51) [1]

Delphi 2010


 
Dmk ©   (2015-10-10 00:08) [2]

Несовпадение объявленного типа и требуемого.


 
Германн ©   (2015-10-10 00:57) [3]


> Куда копать..?

В msdn по функции SetupDiEnumDeviceInfo. Конкретно по её третьему параметру PSP_DEVINFO_DATA. Именно этот параметр имеет не тот тип, который ждёт функция.


 
Михалыч   (2015-10-10 12:06) [4]

Автор функции на сайте уверяет что она рабочая. Может в D2010 чего наменяли?


 
Михалыч   (2015-10-10 12:42) [5]

Win7 x64 если че..


 
Михалыч   (2015-10-10 12:48) [6]

Нашел SetupAPI поновее за 2008 год, теперь ошибка:

[DCC Error] Unit1.pas(83): E2010 Incompatible types: "Pointer" and "Cardinal"

на этой строке:

DeviceInfoSet_ := SetupDiGetClassDevs(nil, PnPID, 0, DIGCF_ALLCLASSES or DIGCF_DEVICEINTERFACE);

И опять все не слава Богу... :(


 
Михалыч   (2015-10-10 12:53) [7]

Различия в описании функций в разных версиях SetupAPI:
Старый:
function SetupDiGetClassDevs(ClassGuid: PGUID; const Enumerator: PChar;
 hwndParent: HWND; Flags: DWORD): HDEVINFO; stdcall;
{$EXTERNALSYM SetupDiGetClassDevs}

Новый:
function SetupDiGetClassDevs(ClassGuid: PGUID; const Enumerator: PAnsiChar;
 hwndParent: HWND; Flags: DWORD): HDEVINFO; stdcall; external SetupApiModuleName
  name "SetupDiGetClassDevsA";


 
Михалыч   (2015-10-11 15:55) [8]

Есть у кого новее SetupAPI , может там нет ошибок?



Страницы: 1 вся ветка

Текущий архив: 2017.07.09;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.004 c
2-1445034926
shkolnik
2015-10-17 01:35
2017.07.09
Задача по программированию


6-1283427469
dmitrynpk
2010-09-02 15:37
2017.07.09
Ограничение доступа к Серверу на TIdTCPServer


4-1281966850
istok
2010-08-16 17:54
2017.07.09
узнать, находится ли фокус ввода в окне или нет...


2-1444440112
Е95
2015-10-10 04:21
2017.07.09
Как можно экспортировать функцию по EntryPoint (ordinal)?


2-1445006653
AndrG
2015-10-16 17:44
2017.07.09
constant expression violates subrange bounds