-------------- 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 DLLSetupAPIHandle0 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 (DLLSetupAPIHandle0) then FreeLibrary(DLLSetupAPIHandle); end; end.

-------------- next part -------------- A non-text attachment was scrubbed... Name: enumdevicessample.zip Type: application/x-zip-compressed Size: 3912 bytes Desc: not available URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20180330/6e89a2c1/attachment.bin>