[Lazarus] devmgmt.msc

[José Mejuto]

El 28/03/2018 a las 22:48, duilio foschi via Lazarus escribió:
> if I run devmgmt.msc on W7 I get this info on screen:
> Is there a Winows API I can call from my Lazarus program and get the same info ?
> My aim is to detect which COM number was assigned to the USB device
> "MSP Application UART1"

Hello,

Attached unit will help you to implement a COM port browsing. There is a 
bit of extra code as original comes from a bigger unit, and this is an 
extract.


-- 

-------------- next part --------------
unit udeviceenumwin;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;


function EnumDevices: integer;

implementation

uses
  windows;

const
  WINDOWS_SETUPAPI_NAME='setupapi.dll';

  DIGCF_DEFAULT =          $00000001;
  DIGCF_PRESENT =          $00000002;
  DIGCF_ALLCLASSES =       $00000004;
  DIGCF_PROFILE =          $00000008;
  DIGCF_DEVICEINTERFACE =  $00000010;

  SPDRP_FRIENDLYNAME = $0000000C;

type

{$PackRecords C}

  HDEVINFO = type THANDLE;

  SP_DEVINFO_DATA = record
      cbSize: DWORD;
      ClassGuid: TGUID;
      DevInst: DWORD;    // DEVINST handle
      Reserved: Pointer;
  end;
  PSP_DEVINFO_DATA=^SP_DEVINFO_DATA;

  SP_DEVICE_INTERFACE_DATA = record
      cbSize: DWORD;
      InterfaceClassGuid: TGUID;
      Flags: DWORD;
      Reserved: Pointer;
  end;
  PSP_DEVICE_INTERFACE_DATA= ^SP_DEVICE_INTERFACE_DATA;

  SP_DEVICE_INTERFACE_DETAIL_DATA_W = packed record
      cbSize: DWORD;
      DevicePath: array [0..0] of WideChar;
  end;
  PSP_DEVICE_INTERFACE_DETAIL_DATA_W = ^SP_DEVICE_INTERFACE_DETAIL_DATA_W;

  // SETUPAPI.DLL
  TSetupDiGetClassDevs = function (var aGUID: TGUID; aEnumerator: PWideChar; hwndParent: SizeInt; aFlags: DWORD): HDEVINFO; stdcall;
  TSetupDiEnumDeviceInterfaces = function (DeviceInfoSet: HDEVINFO; DeviceInfoData: PSP_DEVINFO_DATA; var InterfaceClassGuid: TGUID; MemberIndex: DWORD; var DeviceInterfaceData: SP_DEVICE_INTERFACE_DATA): WINBOOL; stdcall;
  TSetupDiGetDeviceInterfaceDetailW = function (DeviceInfoSet: HDEVINFO; DeviceInterfaceData: PSP_DEVICE_INTERFACE_DATA;
                                              DeviceInterfaceDetailData: PSP_DEVICE_INTERFACE_DETAIL_DATA_W;
                                              DeviceInterfaceDetailDataSize: DWORD; var RequiredSize: DWORD;
                                              DeviceInfoData: PSP_DEVINFO_DATA): WINBOOL; stdcall;
  TSetupDiDestroyDeviceInfoList = function (DeviceInfoSet: HDEVINFO): WINBOOL; stdcall;
  TSetupDiGetDeviceRegistryPropertyA = function (DeviceInfoSet: HDEVINFO; DeviceInfoData: PSP_DEVINFO_DATA;
                                              PropertyID: DWORD; PropertyRegDataType: PDWORD;
                                              PropertyBuffer: PBYTE; PropertyBufferSize: DWORD;
                                              RequiredSize: PDWORD): WINBOOL; stdcall;
  TSetupDiEnumDeviceInfo = function (DeviceInfoSet: HDEVINFO; MemberIndex: DWORD; var DeviceInterfaceData: SP_DEVICE_INTERFACE_DATA): WINBOOL; stdcall;

type

  TDLLSetupAPIEntriesRecord=record
    SetupDiGetClassDevs: TSetupDiGetClassDevs;
    SetupDiEnumDeviceInterfaces: TSetupDiEnumDeviceInterfaces;
    SetupDiGetDeviceInterfaceDetailW: TSetupDiGetDeviceInterfaceDetailW;
    SetupDiDestroyDeviceInfoList: TSetupDiDestroyDeviceInfoList;
    SetupDiGetDeviceRegistryPropertyA: TSetupDiGetDeviceRegistryPropertyA;
    SetupDiEnumDeviceInfo: TSetupDiEnumDeviceInfo;
  end;

var
  DLLSetupAPIHandle: TLibHandle;
  DLLInitializedFlag: Boolean=false;
  DLLInitializedSuccess: Boolean=false;
  DLLSetupAPIFunctions: TDLLSetupAPIEntriesRecord;

function InitializeLibraries: Boolean; forward;

procedure DEBUG_OUTPUT(msg: string);
begin
  writeln(msg);
end;

function EnumDevices(): integer;
var
  lGUID: TGUID='{4d36e978-e325-11ce-bfc1-08002be10318}'; // COM PORTS and LPT
  lDeviceInfoList: HDEVINFO;
  lDeviceInfo: SP_DEVICE_INTERFACE_DATA;

  lMemberIndex: integer;
  lStopEnumeration: Boolean=false;
  lIndex: integer;
  lFriendlyName: array [0..511] of char;
begin
  if not InitializeLibraries then exit(1);
  ldeviceInfoList := DLLSetupAPIFunctions.SetupDiGetClassDevs(lGUID, nil, 0, DIGCF_PRESENT or DIGCF_DEVICEINTERFACE);
  if lDeviceInfoList=INVALID_HANDLE_VALUE then begin
    exit(2);
  end;
  lDeviceInfo.cbSize:=SizeOf(lDeviceInfo);
  lMemberIndex:=0;
  while true do begin
    if not DLLSetupAPIFunctions.SetupDiEnumDeviceInterfaces(ldeviceInfoList, nil, lGUID, lMemberIndex, lDeviceInfo) then begin
      // Browse finished
      lStopEnumeration:=true;
      break;
    end;
    lIndex:=0;
    while true do begin
      if DLLSetupAPIFunctions.SetupDiEnumDeviceInfo(lDeviceInfoList,lIndex,lDeviceInfo)=FALSE then begin
        break;
      end;
      if DLLSetupAPIFunctions.SetupDiGetDeviceRegistryPropertyA(lDeviceInfoList, at lDeviceInfo,SPDRP_FRIENDLYNAME,nil, at lFriendlyName[0],sizeof(lFriendlyName)-1,nil) then begin
        DEBUG_OUTPUT(lFriendlyName);
      end;
      inc(lIndex);
    end;
    if lStopEnumeration then break;
    inc(lMemberIndex);
  end;
  DLLSetupAPIFunctions.SetupDiDestroyDeviceInfoList(lDeviceInfoList);
  Result:=0;
end;


function InitializeLibraries: Boolean;
var
  lSuccessFunctions: Boolean=true;
  function CheckFunctionsRecord(p: Pointer; aEntries: integer): Boolean;
  var
    j: integer;
    pProc: Pointer;
    lAssigned: Boolean=true;
    pp: PPointer;
  begin
    pp:=p;
    for j := 0 to Pred(aEntries) do begin
      pProc:=pp^;
      if not Assigned(pProc) then begin
        lAssigned:=false;
        break;
      end;
      inc(pp);
    end;
    Result:=lAssigned;
  end;
begin
  if DLLInitializedFlag then exit(DLLInitializedSuccess);
  DLLSetupAPIFunctions:=Default(TDLLSetupAPIEntriesRecord);
  DLLInitializedFlag:=true;

  DLLSetupAPIHandle:=LoadLibrary(WINDOWS_SETUPAPI_NAME);
  if DLLSetupAPIHandle<>0 then begin
    Pointer(DLLSetupAPIFunctions.SetupDiGetClassDevs):=GetProcAddress(DLLSetupAPIHandle,'SetupDiGetClassDevsW');
    Pointer(DLLSetupAPIFunctions.SetupDiEnumDeviceInterfaces):=GetProcAddress(DLLSetupAPIHandle,'SetupDiEnumDeviceInterfaces');
    Pointer(DLLSetupAPIFunctions.SetupDiGetDeviceInterfaceDetailW):=GetProcAddress(DLLSetupAPIHandle,'SetupDiGetDeviceInterfaceDetailW');
    Pointer(DLLSetupAPIFunctions.SetupDiDestroyDeviceInfoList):=GetProcAddress(DLLSetupAPIHandle,'SetupDiDestroyDeviceInfoList');
    Pointer(DLLSetupAPIFunctions.SetupDiGetDeviceRegistryPropertyA):=GetProcAddress(DLLSetupAPIHandle,'SetupDiGetDeviceRegistryPropertyA');
    Pointer(DLLSetupAPIFunctions.SetupDiEnumDeviceInfo):=GetProcAddress(DLLSetupAPIHandle,'SetupDiEnumDeviceInfo');
  end;
  if lSuccessFunctions then begin
    lSuccessFunctions:=CheckFunctionsRecord(@DLLSetupAPIFunctions,sizeof(DLLSetupAPIFunctions) div sizeof(Pointer));
  end;
  if not lSuccessFunctions then begin
    DEBUG_OUTPUT('LoadLibrary error');
  end;
  DLLInitializedSuccess:=lSuccessFunctions;
  Result:=DLLInitializedSuccess;
end;

finalization
  if DLLInitializedFlag then begin
    if (DLLSetupAPIHandle<>0) then FreeLibrary(DLLSetupAPIHandle);
  end;


end.