Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
シリアルポートをフレンドリ名で列挙
{ Setup APIs }
type
{ HDEVINFO }
HDEVINFO = THandle;
{$EXTERNALSYM HDEVINFO}
{ SP_DEVINFO_DATA }
SP_DEVINFO_DATA = packed record
cbSize: DWORD;
ClassGuid: TGUID;
DevInst: DWORD;
Reserved: ULONG_PTR;
end;
{$EXTERNALSYM SP_DEVINFO_DATA}
const
{ Flags for SetupDiGetClassDevs }
DIGCF_DEFAULT = $00000001;
{$EXTERNALSYM DIGCF_DEFAULT}
DIGCF_PRESENT = $00000002;
{$EXTERNALSYM DIGCF_PRESENT}
DIGCF_ALLCLASSES = $00000004;
{$EXTERNALSYM DIGCF_ALLCLASSES}
DIGCF_PROFILE = $00000008;
{$EXTERNALSYM DIGCF_PROFILE}
DIGCF_DEVICEINTERFACE = $00000010;
{$EXTERNALSYM DIGCF_DEVICEINTERFACE}
{ Property for SetupDiGetDeviceRegistryProperty }
SPDRP_DEVICEDESC = $00000000;
{$EXTERNALSYM SPDRP_DEVICEDESC}
SPDRP_FRIENDLYNAME = $0000000C;
{$EXTERNALSYM SPDRP_FRIENDLYNAME}
{ Scope for SetupDiOpenDevRegKey }
DICS_FLAG_GLOBAL = $00000001;
{$EXTERNALSYM DICS_FLAG_GLOBAL}
{ KeyType for SetupDiOpenDevRegKey }
DIREG_DEV = $00000001;
{$EXTERNALSYM DIREG_DEV}
{ SetupDiClassGuidsFromName }
function SetupDiClassGuidsFromName(const ClassName: PChar;
ClassGuidList: PGUID;
ClassGuidListSize: DWORD;
var RequiredSize: DWORD): BOOL; stdcall;
external 'SetupApi.dll' name
{$IFDEF UNICODE}
'SetupDiClassGuidsFromNameW';
{$ELSE}
'SetupDiClassGuidsFromNameA';
{$ENDIF}
{$EXTERNALSYM SetupDiClassGuidsFromName}
{ SetupDiGetClassDevs }
function SetupDiGetClassDevs(ClassGuid: PGUID;
const Enumerator: PChar;
hwndParent: HWND;
Flags: DWORD): HDEVINFO; stdcall;
external 'SetupApi.dll' name
{$IFDEF UNICODE}
'SetupDiGetClassDevsW';
{$ELSE}
'SetupDiGetClassDevsA';
{$ENDIF}
{$EXTERNALSYM SetupDiGetClassDevs}
{ SetupDiDestroyDeviceInfoList }
function SetupDiDestroyDeviceInfoList(DeviceInfoSet: HDEVINFO): BOOL; stdcall;
external 'SetupApi.dll' name 'SetupDiDestroyDeviceInfoList';
{$EXTERNALSYM SetupDiDestroyDeviceInfoList}
{ SetupDiEnumDeviceInfo }
function SetupDiEnumDeviceInfo(DeviceInfoSet: HDEVINFO;
MemberIndex: DWORD;
var DeviceInfoData: SP_DEVINFO_DATA): BOOL; stdcall;
external 'SetupApi.dll' name 'SetupDiEnumDeviceInfo';
{$EXTERNALSYM SetupDiEnumDeviceInfo}
{ SetupDiGetDeviceRegistryProperty }
function SetupDiGetDeviceRegistryProperty(DeviceInfoSet: HDEVINFO;
const DeviceInfoData: SP_DEVINFO_DATA;
Prop: DWORD;
PropertyRegDataType: PDWORD;
PropertyBuffer: Pointer;
PropertyBufferSize: DWORD;
var RequiredSize: DWORD): BOOL; stdcall;
external 'SetupApi.dll' name
{$IFDEF UNICODE}
'SetupDiGetDeviceRegistryPropertyW';
{$ELSE}
'SetupDiGetDeviceRegistryPropertyA';
{$ENDIF}
{$EXTERNALSYM SetupDiGetDeviceRegistryProperty}
{ SetupDiOpenDevRegKey }
function SetupDiOpenDevRegKey(DeviceInfoSet: HDEVINFO;
var DeviceInfoData: SP_DEVINFO_DATA;
Scope: DWORD;
HwProfile: DWORD;
KeyType: DWORD;
samDesired: REGSAM): HKEY; stdcall;
external 'SetupApi.dll' name 'SetupDiOpenDevRegKey';
{$EXTERNALSYM SetupDiOpenDevRegKey}
function EnumSerialCommWithFriendlyName(const S: TStrings): Integer;
var
Guid: TGUID;
Size: DWORD;
hDevInf: HDEVINFO;
Index: DWORD;
DevInfoData: SP_DEVINFO_DATA;
S1: String;
hRegKey: HKEY;
S2: String;
RegType: DWORD;
PortNo: Integer;
begin
Result := 0;
Size := 0;
if SetupDiClassGuidsFromName('Ports',@Guid,1,Size) = False then
begin
RaiseLastOSError;
end;
hDevInf := SetupDiGetClassDevs(@Guid,nil,0,DIGCF_PRESENT);
if hDevInf = INVALID_HANDLE_VALUE then
begin
RaiseLastOSError;
end;
try
Index := 0;
while True do
begin
FillChar(DevInfoData,SizeOf(DevInfoData),0);
DevInfoData.cbSize := SizeOf(DevInfoData);
if SetupDiEnumDeviceInfo(hDevInf,Index,DevInfoData) = False then
begin
Break;
end;
SetupDiGetDeviceRegistryProperty(hDevInf,DevInfoData,SPDRP_FRIENDLYNAME,
nil,nil,0,Size);
SetLength(S1,(Size + SizeOf(Char)) div SizeOf(Char));
if SetupDiGetDeviceRegistryProperty(hDevInf,DevInfoData,SPDRP_FRIENDLYNAME,
nil,PChar(S1),Size,Size) = True then
begin
SetLength(S1,StrLen(PChar(S1)));
hRegKey := SetupDiOpenDevRegKey(hDevInf,DevInfoData,DICS_FLAG_GLOBAL,0,DIREG_DEV,KEY_READ);
if hRegKey <> INVALID_HANDLE_VALUE then
begin
try
if RegQueryInfoKey(hRegKey,nil,nil,nil,nil,nil,nil,nil,nil,
@Size,nil,nil) = ERROR_SUCCESS then
begin
SetLength(S2,(Size + SizeOf(Char)) div SizeOf(Char));
if (RegQueryValueEx(hRegKey,'PortName',nil,@RegType,Pointer(PChar(S2)),
@Size) = ERROR_SUCCESS) and
(RegType = REG_SZ) then
begin
SetLength(S2,StrLen(PChar(S2)));
if CompareText(Copy(S2,1,3),'COM') = 0 then
begin
if TryStrToInt(Copy(S2,4,Length(S2)),PortNo) = True then
begin
S.AddObject(S1,Pointer(PortNo));
if Result < PortNo then
begin
Result := PortNo;
end;
end;
end;
end;
end;
finally
RegCloseKey(hRegKey);
end;
end;
end;
Index := Index + 1;
end;
finally
SetupDiDestroyDeviceInfoList(hDevInf);
end;
end;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.