|
14.02.2018, 14:10
#39601792
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
Ссылка на профиль пользователя:
|
|
|
Модератор форума
Сообщения: 41 886
Рейтинг:
4
/ 6
|
|
|
|
YuRockБрюсВсемогущий,
на вот тебе, из старых запасов, нормальную функцию EnumComPorts:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
// Возвращает текст последней ошибки Windows и ее код в []
function LastOSErrorWithCode( dwErrorCode: DWORD ): String; overload;
begin
Result := Format( '[%d] %s', [ dwErrorCode, SysErrorMessage( dwErrorCode ) ] );
end;
// Возвращает текст последней ошибки Windows и ее код в []
function LastOSErrorWithCode: String; overload;
begin
Result := LastOSErrorWithCode( GetLastError );
end;
function GetPortName( h_DevInfo: HDEVINFO; const DevData: TSPDevInfoData; var SName: String ): Boolean;
var
hDeviceKey: HKEY;
szData: Array[ 0 .. 255 ] of Char;
dwType, dwSize: DWORD;
begin
hDeviceKey := SetupDiOpenDevRegKey( h_DevInfo, DevData, DICS_FLAG_GLOBAL, 0, DIREG_DEV, KEY_QUERY_VALUE );
Result := hDeviceKey <> INVALID_HANDLE_VALUE;
if not Result then
Exit;
try
szData[ 0 ] := #0;
dwSize := sizeof( szData );
dwType := 0;
Result := ( ERROR_SUCCESS = RegQueryValueEx( hDeviceKey, 'PortName', nil, @dwType, @szData, @dwSize ) ) and ( dwSize > 3 );
if Result then
SName := String( PChar( @szData ) );
finally
RegCloseKey( hDeviceKey );
end;
end;
// Заполняет список компортов. В Objects заполняет номер порта (Integer)
// Если bNameWithComment=True - вместо имен COM1,COM2,... заполняет имена, как в диспетчере задач.
function EnumComPorts( List: TStrings; bNameWithComment: Boolean; var SError: String ): Boolean;
const
LOCATION_INFO_LENGTH = 64;
var
h_DevInfo: HDEVINFO;
DeviceNumber: DWORD;
DevData: TSPDevInfoData;
RES: BOOL;
SCurName: String;
nPortNumber: DWORD;
cLocationInfo: Array[ 0..LOCATION_INFO_LENGTH - 1 ] of Char;
dwRegType: DWORD;
predictedLength: DWORD;
begin
h_DevInfo := SetupDiGetClassDevs( @GUID_DEVINTERFACE_SERENUM_BUS_ENUMERATOR, nil, 0, DIGCF_PRESENT );
Result := THandle( h_DevInfo ) <> INVALID_HANDLE_VALUE;
if not Result then begin
SError := 'Не удалось прочитать список устройств: ' + LastOSErrorWithCode;
Exit;
end;
try
List.Clear;
DeviceNumber := 0;
repeat
DevData.cbSize := SizeOf( TSPDevInfoData );
RES := SetupDiEnumDeviceInfo( h_DevInfo, DeviceNumber, DevData );
if RES then begin
if GetPortName( h_DevInfo, DevData, SCurName ) then begin
nPortNumber := StrToIntDef( Copy( SCurName, 4, MaxInt ), 0 );
if bNameWithComment then begin
FillChar( cLocationInfo, sizeof( cLocationInfo ), 0 );
dwRegType := 0;
predictedLength := 0;
if SetupDiGetDeviceRegistryProperty(
h_DevInfo,
DevData,
SPDRP_FRIENDLYNAME,
dwRegType,
@cLocationInfo,
sizeof( cLocationInfo ),
predictedLength
) then
SCurName := String( PChar( @cLocationInfo ) );
end;
List.AddObject( SCurName, TObject( nPortNumber ) );
end;
Inc( DeviceNumber );
end;
until not RES;
finally
SetupDiDestroyDeviceInfoList(h_DevInfo);
end;
end;
Понадобится модуль setupapi, у меня он такой:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
unit setupapi;
interface
uses Windows;
const
ANYSIZE_ARRAY = 1;
GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
GUID_DEVINTERFACE_USBPRINT: TGUID = '{28d78fad-5a12-11D1-ae5b-0000f803a8c2}';
GUID_DEVINTERFACE_COMPORT: TGUID = '{86e0d1e0-8089-11d0-9ce4-08003e301f73}';
GUID_DEVINTERFACE_SERENUM_BUS_ENUMERATOR: TGUID = '{4D36E978-E325-11CE-BFC1-08002BE10318}';
GUID_DEVINTERFACE_PRINTER: TGUID = '{4D36E979-E325-11CE-BFC1-08002BE10318}';
GUID_DEVINTERFACE_PARCLASS: TGUID = '{811FC6A5-F728-11D0-A537-0000F8753ED1}';
GUID_DEVINTERFACE_PARALLEL: TGUID = '{97F76EF0-F883-11D0-AF1F-0000F800845C}';
GUID_DEVINTERFACE_MODEM: TGUID = '{2C7089AA-2E0E-11D1-B114-00C04FC2AAE4}';
GUID_DEVINTERFACE_STORAGE_PORT: TGUID = '{2accfe60-c130-11d2-b082-00a0c91efb8b}';
DIGCF_PRESENT = $00000002;
DIGCF_DEVICEINTERFACE = $00000010;
DIGCF_ALLCLASSES = $00000004;
DIGCF_PROFILE = $00000008;
SPDRP_DEVICEDESC = $00000000;
SPDRP_HARDWAREID = $00000001;
SPDRP_SERVICE = $00000004;
SPDRP_CLASS = $00000007;
SPDRP_CLASSGUID = $00000008;
SPDRP_FRIENDLYNAME = $0000000C;
SPDRP_LOCATION_INFORMATION = $0000000D;
SPDRP_PHYSICAL_DEVICE_OBJECT_NAME = $0000000E;
SPDRP_UI_NUMBER = $00000010;
SPDRP_BUSNUMBER = $00000015;
SPDRP_ENUMERATOR_NAME = $00000016;
CR_SUCCESS = 0;
//cfgmgr32.h
CM_DRP_DEVICEDESC = $00000001;
CM_DRP_HARDWAREID = $00000002;
CM_DRP_PHYSICAL_DEVICE_OBJECT_NAME = $0000000F;
CM_DRP_UI_NUMBER = $00000011;
CM_DRP_BUSNUMBER = $00000016;
CM_DRP_ENUMERATOR_NAME = $00000017;
CM_DRP_UI_NUMBER_DESC_FORMAT = $0000001E;
DICS_ENABLE = $00000001;
DICS_DISABLE = $00000002;
DICS_FLAG_GLOBAL = $00000001;
DICS_FLAG_CONFIGSPECIFIC = $00000002; // make change in specified profile only
DIREG_DEV = $00000001;
DIF_PROPERTYCHANGE = $00000012;
type
ULONG_PTR = DWORD;
PTSTR = PAnsiChar;
HDEVINFO = Pointer;
PSPDevInfoData = ^TSPDevInfoData;
SP_DEVINFO_DATA = packed record
cbSize: DWORD;
ClassGuid: TGUID;
DevInst: DWORD; // DEVINST handle
Reserved: ULONG_PTR;
end;
TSPDevInfoData = SP_DEVINFO_DATA;
PSPDeviceInterfaceData = ^TSPDeviceInterfaceData;
SP_DEVICE_INTERFACE_DATA = packed record
cbSize: DWORD;
InterfaceClassGuid: TGUID;
Flags: DWORD;
Reserved: ULONG_PTR;
end;
TSPDeviceInterfaceData = SP_DEVICE_INTERFACE_DATA;
TSPInterfaceDeviceData = TSPDeviceInterfaceData;
PSPDeviceInterfaceDetailDataA = ^TSPDeviceInterfaceDetailDataA;
SP_DEVICE_INTERFACE_DETAIL_DATA_A = packed record
cbSize: DWORD;
DevicePath: array [0..ANYSIZE_ARRAY - 1] of AnsiChar;
end;
TSPDeviceInterfaceDetailDataA = SP_DEVICE_INTERFACE_DETAIL_DATA_A;
TSPDeviceInterfaceDetailData = TSPDeviceInterfaceDetailDataA;
TSPInterfaceDeviceDetailData = TSPDeviceInterfaceDetailData;
PSPDeviceInterfaceDetailData = PSPDeviceInterfaceDetailDataA;
PSPInterfaceDeviceDetailData = PSPDeviceInterfaceDetailData;
DI_FUNCTION = UINT;
TSPClassInstallHeader = record
cbSize: DWORD;
InstallFunction: DI_FUNCTION;
end;
PSPClassInstallHeader = ^TSPClassInstallHeader;
TSPPropChangeParams = record
ClassInstallHeader: TSPClassInstallHeader;
StateChange: DWORD;
Scope: DWORD;
HwProfile: DWORD;
end;
function SetupDiGetClassDevs( ClassGuid: PGUID; const Enumerator: PTSTR; hwndParent: HWND; Flags: DWORD ): HDEVINFO; stdcall; external 'setupapi.dll' name 'SetupDiGetClassDevsA';
function SetupDiEnumDeviceInfo( DeviceInfoSet: HDEVINFO; MemberIndex: DWORD; var DeviceInfoData: TSPDevInfoData ): BOOL; stdcall; external 'setupapi.dll';
function SetupDiEnumDeviceInterfaces( DeviceInfoSet: HDEVINFO; DeviceInfoData: PSPDevInfoData; const InterfaceClassGuid: TGUID; MemberIndex: DWORD; var DeviceInterfaceData: TSPDeviceInterfaceData ): BOOL; stdcall; external 'setupapi.dll';
function SetupDiGetDeviceInterfaceDetail( DeviceInfoSet: HDEVINFO; DeviceInterfaceData: PSPDeviceInterfaceData; DeviceInterfaceDetailData: PSPDeviceInterfaceDetailData; DeviceInterfaceDetailDataSize: DWORD; RequiredSize: PDWORD; Device: PSPDevInfoData ): BOOL; stdcall; external 'setupapi.dll' name 'SetupDiGetDeviceInterfaceDetailA';
function SetupDiDestroyDeviceInfoList( DeviceInfoSet: HDEVINFO ): BOOL; stdcall; external 'setupapi.dll';
function SetupDiGetDeviceRegistryProperty( DeviceInfoSet: HDEVINFO; const DeviceInfoData: TSPDevInfoData; Property_: DWORD; var PropertyRegDataType: DWORD; PropertyBuffer: PBYTE; PropertyBufferSize: DWORD; var RequiredSize: DWORD ): BOOL; stdcall; external 'setupapi.dll' name 'SetupDiGetDeviceRegistryPropertyA';
function SetupDiOpenDevRegKey( DeviceInfoSet: HDEVINFO; const DeviceInfoData: TSPDevInfoData; Scope, HwProfile, KeyType: DWORD; samDesired: REGSAM ): HKEY; stdcall; external 'setupapi.dll';
function SetupDiCallClassInstaller( InstallFunction: DI_FUNCTION; DeviceInfoSet: HDEVINFO; pDeviceInfoData: PSPDevInfoData ): BOOL; stdcall; external 'setupapi.dll';
function SetupDiSetClassInstallParams( DeviceInfoSet: HDEVINFO; pDeviceInfoData: PSPDevInfoData; pClassInstallParams: PSPClassInstallHeader; ClassInstallParamsSize: DWORD ): BOOL; stdcall; external 'setupapi.dll' name 'SetupDiSetClassInstallParamsA';
function SetupDiClassGuidsFromName( ClassName: PChar; ClassGuidList: PGUID; ClassGuidListSize: DWORD; var RequiredSize: DWORD ): BOOL; stdcall; external 'setupapi.dll' name 'SetupDiClassGuidsFromNameA';
function CM_Get_Child( out pdnDevInst: DWORD; dnDevInst: DWORD; ulFlags: ULONG ): DWORD; stdcall; external 'CfgMgr32.dll';
function CM_Get_Sibling( out pdnDevInst: DWORD; dnDevInst: DWORD; ulFlags: ULONG ): DWORD; stdcall; external 'CfgMgr32.dll';
function CM_Get_DevNode_Registry_PropertyW( dnDevInst: DWORD; ulProperty: ULONG; pulRegDataType: PULONG; Buffer: Pointer; pulLength: PULONG; ulFlags: ULONG ): DWORD; stdcall; external 'CfgMgr32.dll';
implementation
end.
Использование:
1.
2.
3.
4.
5.
6.
7.
procedure TForm1.Button1Click(Sender: TObject);
var
SError: String;
begin
if not EnumComPorts( Memo1.Lines, True, SError ) then
ShowMessage( SError );
end;
Точно работает до D7, дальше не проверял (должно работать).
зачем столько мильёнов строк кода и лишние юниты ?
Вот простой код на 43 строки, который делает ровно то же самое:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
procedure EnumComPorts(Ports: TStrings);
var
KeyHandle: HKEY;
ErrCode, Index: Integer;
ValueName, Data: string;
ValueLen, DataLen, ValueType: DWORD;
TmpPorts: TStringList;
begin
ErrCode := RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'HARDWARE\DEVICEMAP\SERIALCOMM',
0, KEY_READ, KeyHandle);
if ErrCode <> ERROR_SUCCESS
then raise EComPort.Create(CError_RegError, ErrCode);
TmpPorts := TStringList.Create;
try
Index := 0;
repeat
ValueLen := 256;
DataLen := 256;
SetLength(ValueName, ValueLen);
SetLength(Data, DataLen);
ErrCode := RegEnumValue(KeyHandle, Index, PChar(ValueName),
Cardinal(ValueLen), nil, @ValueType,
PByte(PChar(Data)), @DataLen);
if ErrCode = ERROR_SUCCESS then
begin
SetLength(Data, DataLen);
TmpPorts.Add(Data);
Inc(Index);
end else
if ErrCode <> ERROR_NO_MORE_ITEMS
then raise EComPort.Create(CError_RegError, ErrCode);
until (ErrCode <> ERROR_SUCCESS) ;
TmpPorts.Sort;
Ports.Assign(TmpPorts);
finally
RegCloseKey(KeyHandle);
TmpPorts.Free;
end;
end;
|
|
|
