unit EnumCom;
 
// ****************************************************************************
// EnumCom - jvn@vns - 2006 may 24
// ****************************************************************************
// This unit is the result of intensive work to obtain a serial port
// enumeration routine that also provides UART BaseAddress information
// for use with TPortTalk
// ****************************************************************************
 
interface
 
uses
  Classes;
 
function EnumComPorts(ComList: TStringList; Verbose: Boolean): Boolean;
 
implementation
 
uses
  Windows,
  SysUtils;
 
// ****************************************************************************
// Interface to NTDDK
// ****************************************************************************
 
// Initially based on published Interface of Unit MiTec_NTDDK that is part of
// the 'MiTeC System Information Component Suite', by Michal Mutl,
// Code is carefully rephrased, with some simplifications and corrections.
// Many relevant things can be found at www.koders.com where it is possible to
// search for / download open source ports of e.d. winddk.h
 
type
  UCHAR = Byte;
  USHORT = Word;
  ULONG = DWORD;                      // Is LongWord = unsigned 32bit
  CM_RESOURCE_TYPE = Cardinal;        // Is unsigned 32bit
  PHYSICAL_ADDRESS = LARGE_INTEGER;   // Is Int64 as a splittable record
 
const
  CmResourceTypeNull           = 0;   // Meaning 'All' or 'None'
  CmResourceTypePort           = 1;
  CmResourceTypeInterrupt      = 2;
  CmResourceTypeMemory         = 3;
  CmResourceTypeDma            = 4;
  CmResourceTypeDeviceSpecific = 5;
  CmResourceTypeBusNumber      = 6;
  CmResourceTypeMaximum        = 7;
 
{ Defines the ShareDisposition in the RESOURCE_DESCRIPTOR }
 
type
  CM_SHARE_DISPOSITION = (
    CmResourceShareUndetermined,
    CmResourceShareDeviceExclusive,  { Reserved }
    CmResourceShareDriverExclusive);
 
const
{ Define the bit masks for Flags common for all Cm Resource types }
  CM_RESOURCE_COMMON_COMPUTE_LENGTH_FROM_DEPENDENTS = $8000;
  CM_RESOURCE_COMMON_NOT_REASSIGNED                 = $4000;
  CM_RESOURCE_COMMON_SUBSTRACTIVE                   = $2000;
 
{ Define the bit masks for Flags when type is CmResourceTypeInterrupt }
  CM_RESOURCE_INTERRUPT_LEVEL_SENSITIVE = 0;
  CM_RESOURCE_INTERRUPT_LATCHED         = 1;
 
{ Define the bit masks for Flags when type is CmResourceTypeMemory }
  CM_RESOURCE_MEMORY_READ_WRITE         = $0000;
  CM_RESOURCE_MEMORY_READ_ONLY          = $0001;
  CM_RESOURCE_MEMORY_WRITE_ONLY         = $0002;
  CM_RESOURCE_MEMORY_PREFETCHABLE       = $0004;
  CM_RESOURCE_MEMORY_COMBINEDWRITE      = $0008;
  CM_RESOURCE_MEMORY_24                 = $0010;
 
{ Define the bit masks for Flags when type is CmResourceTypePort }
  CM_RESOURCE_PORT_MEMORY               = $0000;
  CM_RESOURCE_PORT_IO                   = $0001;
  CM_RESOURCE_PORT_10_BIT_DECODE        = $0004;
  CM_RESOURCE_PORT_12_BIT_DECODE        = $0008;
  CM_RESOURCE_PORT_16_BIT_DECODE        = $0010;
  CM_RESOURCE_PORT_POSITIVE_DECODE      = $0020;
 
{ Define the bit masks for Flags when type is CmResourceTypeDma }
  CM_RESOURCE_DMA_8                     = $0000;
  CM_RESOURCE_DMA_16                    = $0001;
  CM_RESOURCE_DMA_32                    = $0002;
 
type
 
{ Range of resources, inclusive.  These are physical, bus relative. }
{ Port and Memory below have the same layout as (unused) Generic }
{ Note: these RDD records need to be Packed to arrive unalligned in }
{ the variant record CM_PARTIAL_RESOURCE_DESCRIPTOR }
 
  RDD_Generic = packed record
   Start: PHYSICAL_ADDRESS;
   Length: ULONG;
  end;
  PRDD_Generic = ^RDD_Generic;
 
  RDD_Port  = RDD_Generic;
  PRDD_Port = ^RDD_Port;
 
  RDD_Memory  = RDD_Generic;
  PRDD_Memory = ^RDD_Memory;
 
{ IRQL and vector. Should be same values as were passed to }
{ HalGetInterruptVector(). }
 
  RDD_Interrupt = packed record
    Level: ULONG;
    Vector: ULONG;
    Affinity: ULONG;
  end;
  PRDD_Interrupt = ^RDD_Interrupt;
 
{ Physical DMA channel. }
 
  RDD_DMA = packed record
    Channel: ULONG;
    Port: ULONG;
    Reserved1: ULONG;
  end;
  PRDD_DMA = ^RDD_DMA;
 
{ Device driver private data, usually used to help it figure }
{ what the resource assignments decisions that were made. }
 
  RDD_DevicePrivate = packed record
    Data: array [0..2] of ULONG;
  end;
  PRDD_DevicePrivate = ^RDD_DevicePrivate;
 
{ Bus Number information. }
 
  RDD_BusNumber = packed record
    Start: ULONG;
    Length: ULONG;
    Reserved: ULONG;
  end;
  PRDD_BusNumber = ^RDD_BusNumber;
 
{ Device Specific information defined by the driver. }
{ The DataSize field indicates the size of the data in bytes. The }
{ data is located immediately after the DeviceSpecificData field in }
{ the structure. }
 
  RDD_DeviceSpecificData = packed record
    DataSize: ULONG;
    Reserved1: ULONG;
    Reserved2: ULONG;
  end;
  PRDD_DeviceSpecificData = ^RDD_DeviceSpecificData;
 
{ Partial Resource Descriptor }
 
  CM_PARTIAL_RESOURCE_DESCRIPTOR = record
    ResType: UCHAR;
    ShareDisposition: CM_SHARE_DISPOSITION;  // has UCHAR = Byte size
    Flags: USHORT;
    case Byte of
      0: (Generic: RDD_Generic);
      1: (Port: RDD_Port);
      2: (Interrupt: RDD_Interrupt);
      3: (Memory: RDD_Memory);
      4: (Dma: RDD_DMA);
      5: (DevicePrivate: RDD_DevicePrivate);
      6: (BusNumber: RDD_BusNumber);
      7: (DeviceSpecificData: RDD_DeviceSpecificData);
  end;
 
  PCM_PARTIAL_RESOURCE_DESCRIPTOR = ^CM_PARTIAL_RESOURCE_DESCRIPTOR;
 
{ Partial Resource List }
 
  CM_PARTIAL_RESOURCE_LIST = record
    Version: USHORT;
    Revision: USHORT;
    Count: ULONG;
    PartialDescriptors: {array of} CM_PARTIAL_RESOURCE_DESCRIPTOR;
  end;
 
  PCM_PARTIAL_RESOURCE_LIST = ^CM_PARTIAL_RESOURCE_LIST;
 
{ Define the I/O bus interface types. }
 
  INTERFACE_TYPE = ( // InterfaceTypeUndefined = -1
    Internal, Isa, Eisa, MicroChannel, TurboChannel, PCIBus, VMEBus,
    NuBus, PCMCIABus, CBus, MPIBus, MPSABus, ProcessorInternal,
    InternalPowerBus, PNPISABus, PNPBus);
 
{ Define the DMA transfer widths. }
 
  DMA_WIDTH = (Width8Bits, Width16Bits, Width32Bits);
 
{ Define DMA transfer speeds. }
 
   DMA_SPEED = (Compatible, TypeA, TypeB, TypeC);
 
{ Define types of bus information. }
 
   BUS_DATA_TYPE = (//ConfigurationSpaceUndefined = -1
     Cmos, EisaConfiguration, Pos1, CbusConfiguration,
     PCIConfiguration, VMEConfiguration, NuBusConfiguration,
     PCMCIAConfiguration, MPIConfiguration, MPSAConfiguration,
     PNPISAConfiguration);
 
{ Full Resource Descriptor }
 
  CM_FULL_RESOURCE_DESCRIPTOR = record
     InterfaceType: ULONG;//INTERFACE_TYPE;
     BusNumber: ULONG;
     PartialResourceList: CM_PARTIAL_RESOURCE_LIST;
  end;
 
  PCM_FULL_RESOURCE_DESCRIPTOR = ^CM_FULL_RESOURCE_DESCRIPTOR;
 
{ Full Resource List }
 
  CM_RESOURCE_LIST = record
    Count: ULONG;
    List: {array of} CM_FULL_RESOURCE_DESCRIPTOR;
  end;
 
  PCM_RESOURCE_LIST = ^CM_RESOURCE_LIST;
 
// ****************************************************************************
// Interface to Setup API
// ****************************************************************************
 
// Information gathered by own research and from the Delphi ports of
// the windows API by Project JEDI (Joint Endeavour of Delphi Innovators)
// at SourceForge. Many many thanks to the latter because I was lost..
// The Project JEDI API Library provides many Delphi conversions of the
// Platform SDK and is found at http://sourceforge.net/projects/jedi-aplib.
 
const
  ANYSIZE_ARRAY = 1;
 
type
  ULONG_PTR = Longword;
  HDEVINFO = THandle;          //Jedi says: Pointer;
  TCHAR = Char;
  DEVINST = Cardinal;
 
  // Device information structure (references a device instance
  // that is a member of a device information set)
 
  PSPDevInfoData = ^TSPDevInfoData;
  SP_DEVINFO_DATA = packed record
    cbSize: DWORD;
    ClassGuid: TGUID;
    DevInst: DWORD;          // DEVINST handle
    Reserved: ULONG_PTR;
  end;
  TSPDevInfoData = SP_DEVINFO_DATA;
 
const
  // GUIDs of some System Supplied Device Setup Classes
  // The Port class includes serial and parallel port devices.
  // The MultiPortSerial class includes intelligent multiport serial cards,
  // but not peripheral devices that connect to its ports. It does not include
  // unintelligent (16550-type) mutiport serial controllers or single-port
  // serial controllers.
  // Note that Delphi allows a TGUID structure to be guid string initialized.
 
  cPortClassGUID            : TGUID = '{4d36e978-e325-11ce-bfc1-08002be10318}';
  cMultiPortSerialClassGUID : TGUID = '{50906cb8-ba12-11d1-bf5d-0000f805f530}';
 
  // Flags controlling what is included in the device information set built
  // by SetupDiGetClassDevs
  DIGCF_DEFAULT         = $00000001; // only valid with DIGCF_DEVICEINTERFACE
  DIGCF_PRESENT         = $00000002;
  DIGCF_ALLCLASSES      = $00000004;
  DIGCF_PROFILE         = $00000008;
  DIGCF_DEVICEINTERFACE = $00000010;
 
  // Device registry property codes. Codes marked as read-only (R) may only
  // be used for SetupDiGetDeviceRegistryProperty)
  SPDRP_DEVICEDESC                  = $00000000; // DeviceDesc (R/W)
  SPDRP_HARDWAREID                  = $00000001; // HardwareID (R/W)
  SPDRP_COMPATIBLEIDS               = $00000002; // CompatibleIDs (R/W)
  SPDRP_UNUSED0                     = $00000003; // unused
  SPDRP_SERVICE                     = $00000004; // Service (R/W)
  SPDRP_UNUSED1                     = $00000005; // unused
  SPDRP_UNUSED2                     = $00000006; // unused
  SPDRP_CLASS                       = $00000007; // Class (R--tied to ClassGUID)
  SPDRP_CLASSGUID                   = $00000008; // ClassGUID (R/W)
  SPDRP_DRIVER                      = $00000009; // Driver (R/W)
  SPDRP_CONFIGFLAGS                 = $0000000A; // ConfigFlags (R/W)
  SPDRP_MFG                         = $0000000B; // Mfg (R/W)
  SPDRP_FRIENDLYNAME                = $0000000C; // FriendlyName (R/W)
  SPDRP_LOCATION_INFORMATION        = $0000000D; // LocationInformation (R/W)
  SPDRP_PHYSICAL_DEVICE_OBJECT_NAME = $0000000E; // PhysicalDeviceObjectName (R)
  SPDRP_CAPABILITIES                = $0000000F; // Capabilities (R)
  SPDRP_UI_NUMBER                   = $00000010; // UiNumber (R)
  SPDRP_UPPERFILTERS                = $00000011; // UpperFilters (R/W)
  SPDRP_LOWERFILTERS                = $00000012; // LowerFilters (R/W)
  SPDRP_BUSTYPEGUID                 = $00000013; // BusTypeGUID (R)
  SPDRP_LEGACYBUSTYPE               = $00000014; // LegacyBusType (R)
  SPDRP_BUSNUMBER                   = $00000015; // BusNumber (R)
  SPDRP_ENUMERATOR_NAME             = $00000016; // Enumerator Name (R)
  SPDRP_SECURITY                    = $00000017; // Security (R/W, binary form)
  SPDRP_SECURITY_SDS                = $00000018; // Security (W, SDS form)
  SPDRP_DEVTYPE                     = $00000019; // Device Type (R/W)
  SPDRP_EXCLUSIVE                   = $0000001A; // Device is exclusive-access (R/W)
  SPDRP_CHARACTERISTICS             = $0000001B; // Device Characteristics (R/W)
  SPDRP_ADDRESS                     = $0000001C; // Device Address (R)
  SPDRP_UI_NUMBER_DESC_FORMAT       = $0000001D; // UiNumberDescFormat (R/W)
  SPDRP_DEVICE_POWER_DATA           = $0000001E; // Device Power Data (R)
  SPDRP_REMOVAL_POLICY              = $0000001F; // Removal Policy (R)
  SPDRP_REMOVAL_POLICY_HW_DEFAULT   = $00000020; // Hardware Removal Policy (R)
  SPDRP_REMOVAL_POLICY_OVERRIDE     = $00000021; // Removal Policy Override (RW)
  SPDRP_INSTALL_STATE               = $00000022; // Device Install State (R)
  SPDRP_MAXIMUM_PROPERTY            = $00000023; // Upper bound on ordinals
 
  // Values specifying the scope of a device property access
  DICS_FLAG_GLOBAL         = $00000001;
  DICS_FLAG_CONFIGSPECIFIC = $00000002;
  DICS_FLAG_CONFIGGENERAL  = $00000004;
 
  // KeyType values for SetupDiCreateDevRegKey, SetupDiOpenDevRegKey, and
  // SetupDiDeleteDevRegKey.
  DIREG_DEV  = $00000001;   // Open/Create/Delete device key
  DIREG_DRV  = $00000002;   // Open/Create/Delete driver key
  DIREG_BOTH = $00000004;   // Delete both driver and Device key
 
// Some import functions for the Setup API DLL
// Note some functions are in fact 'A' versions, where the 'A' suffix stands
// for ANSI vs. 'W' for Wide ('Unicode')
 
const
  SetupAPI = 'setupapi.dll';
 
function SetupDiGetClassDevs
 (ClassGuid: PGUID; const Enumerator: PAnsiChar;
  hwndParent: HWND; Flags: DWORD): HDEVINFO;
  stdcall; external SetupAPI name 'SetupDiGetClassDevsA';
 
function SetupDiDestroyDeviceInfoList
 (DeviceInfoSet: HDEVINFO): BOOL;
  stdcall; external SetupAPI;
 
function SetupDiEnumDeviceInfo
 (DeviceInfoSet: HDEVINFO; MemberIndex: DWORD;
  var DevInfoData: TSPDevInfoData): BOOL;
  stdcall; external SetupAPI;
 
function SetupDiGetDeviceInstanceId
 (DeviceInfoSet: HDEVINFO; DevInfoData: PSPDevInfoData;
  DeviceInstanceId: PAnsiChar; DeviceInstanceIdSize: DWORD;
  RequiredSize: PDWORD): BOOL;
  stdcall; external SetupAPI name 'SetupDiGetDeviceInstanceIdA';
 
function SetupDiGetDeviceRegistryProperty
 (DeviceInfoSet: HDEVINFO; const DevInfoData: TSPDevInfoData;
  Property_: DWORD; var PropertyRegDataType: DWORD;
  PropertyBuffer: PBYTE; PropertyBufferSize: DWORD;
  var RequiredSize: DWORD): BOOL;
  stdcall; external SetupAPI name 'SetupDiGetDeviceRegistryPropertyA';
 
function SetupDiOpenDevRegKey
 (DeviceInfoSet: HDEVINFO; var DevInfoData: TSPDevInfoData;
  Scope, HwProfile, KeyType: DWORD; samDesired: REGSAM): HKEY;
  stdcall; external SetupAPI;
 
// Utility wrapper for SetupDiGetDeviceRegistryProperty that retrieves
// Plug & Play properties of the device instance from the registry.
// The function returns a string for properties having various Registry
// Data Types.
 
function GetDevRegPropStr(DevInfo: HDEVINFO;
  const DevInfoData: TSPDevInfoData; Prop: DWORD): string;
var
  BytesReturned, I: DWORD;
  RegDataType: DWORD;
  Buffer: array [0..1023] of TCHAR;
  PW: PDWORD;
begin
  Result:='';
  Buffer[0]:=#0;
  if not SetupDiGetDeviceRegistryProperty(DevInfo, DevInfoData, Prop,
    RegDataType, PByte(@Buffer[0]), SizeOf(Buffer), BytesReturned) then Exit;
  case RegDataType of
    REG_SZ:
    begin
      // Zero terminated string
      Result:=Buffer;
    end;
    REG_DWORD:
    begin
      // Four byte binary DWORD
      PW:=@Buffer;
      Result:='$'+IntToHex(PW^, SizeOf(DWORD));
    end;
    REG_MULTI_SZ:
    begin
      // Multi zero terminated strings, followed by zero string
      // Replace first zeros by space as concatenation char
      // RegEdit also shows it like that..
      for I:=0 to BytesReturned-2 do
        if Buffer[I]=#0 then Buffer[I]:=' ';
      Result:=Buffer;
    end;
  end;
end;
 
// Utility wrapper for SetupDiGetDeviceInstanceId
 
function GetDevInstIdStr(DevInfo: HDEVINFO;
  DevInfoData: TSPDevInfoData): string;
var
  Buffer: array [0..1023] of TCHAR;
  BufSize: DWORD;
begin
  Buffer[0]:=#0;
  BufSize:=SizeOf(Buffer);
  SetupDiGetDeviceInstanceId(DevInfo, @DevInfoData,
    PChar(@Buffer[0]), BufSize, nil);
  Result:=Buffer;
end;
 
// Utility wrapper for RegQueryValueEx
 
function RegQueryValueExStr(DevInfo: HDEVINFO;
  DevInfoData: TSPDevInfoData; const ValueName: string): string;
var
  RegKey: HKEY;
  Buffer: array [0..1023] of Char;
  BufSize, RegType: DWORD;
begin
  Result:='';
  RegKey:=SetupDiOpenDevRegKey(DevInfo, DevInfoData,
    DICS_FLAG_GLOBAL, 0, DIREG_DEV, KEY_READ);
  if RegKey=INVALID_HANDLE_VALUE then Exit;
  BufSize:=SizeOf(Buffer);
  if RegQueryValueEx(RegKey, PChar(ValueName), nil, @RegType,
    @Buffer[0], @BufSize) = ERROR_SUCCESS then
  begin
    if RegType=REG_SZ
      then Result:=Buffer else
    if RegType=REG_DWORD
      then Result:='$'+IntToHex(PDWORD(@Buffer)^, SizeOf(DWORD));
  end;
  RegCloseKey(RegKey);
end;
 
// Utility to get BaseAddress and Interrupt for as long we haven't a better
// method (IoGetDeviceProperty obtaining CM_RESOURCE_LIST etc)
 
function RegGetPortResources(DeviceInstanceId: string;
  var BaseAddress: Word; var IRQLevel: Word): Boolean;
type
  TMyPartResDescr = array[0..1] of CM_PARTIAL_RESOURCE_DESCRIPTOR;
  pMyPartResDescr = ^TMyPartResDescr;
var
  RegKey: HKEY;
  ErrCode, Index: Integer;
  Buffer: array [0..1023] of Byte;
  BufSize, RegType: DWORD;
  pRL: PCM_RESOURCE_LIST;
  pFRD: PCM_FULL_RESOURCE_DESCRIPTOR;
  pPRL: PCM_PARTIAL_RESOURCE_LIST;
  pPRD: pMyPartResDescr;
begin
  Result:=False;
  BaseAddress:=0;
  IRQLevel:=0;
  ErrCode:=RegOpenKeyEx(
    HKEY_LOCAL_MACHINE,
    PChar('SYSTEM\CURRENTCONTROLSET\ENUM\'+DeviceInstanceId+'\CONTROL'),
    0, KEY_READ, RegKey);
  if ErrCode<;>;ERROR_SUCCESS then Exit;
  ErrCode:=RegQueryValueEx(RegKey, PChar('AllocConfig'),
    nil, @RegType, @Buffer[0], @BufSize);
  if (ErrCode=ERROR_SUCCESS)
    and (RegType=REG_RESOURCE_LIST) then
  begin
    pRL:=PCM_RESOURCE_LIST(@Buffer);
    // The Count in the Resource List should be 1 as we're looking
    // at an assigned set of Resources, not to a list of alternative
    // sets as would be the case when assigning resources. We can
    // therefor take pRL^.List as being one Full Resource Decriptor
    if pRL^.Count=1 then
    begin
      pFRD:=PCM_FULL_RESOURCE_DESCRIPTOR(@pRL^.List);
      pPRL:=PCM_PARTIAL_RESOURCE_LIST(@pFRD^.PartialResourceList);
      // The count in the Partial Resource List should be 2; one
      // for baseaddress, one for IRQ. We need to accomodate this by
      // using a local Partial Resource Descriptor array of 2-wide.
      if pPRL^.Count=2 then
      begin
        pPRD:=pMyPartResDescr(@pPRL^.PartialDescriptors);
        for Index:=0 to 1 do
        case pPRD^[Index].ResType of
          CmResourceTypePort:
            BaseAddress:=pPRD^[Index].Port.Start.LowPart;
          CmResourceTypeInterrupt:
            IRQLevel:=pPRD^[Index].Interrupt.Level;
        end;
      end;
    end;
  end;
  // Close Registry
  RegCloseKey(RegKey);
  // Evaluate Results
  Result:=(BaseAddress<;>;0) and (IRQLevel<;>;0);
end;
 
// ****************************************************************************
// Enumerate COM ports - WinXP style..
// ****************************************************************************
 
procedure EnumComPortsXP(ComList: TStringList; Verbose: Boolean);
var
  ClassGUID: TGUID;
  DevInfo: HDEVINFO;
  DevInfoData: TSPDevInfoData;
  More: Boolean;
  Index: DWORD;
  BaseAddress, IRQLevel: Word;
  S: string;
begin
  // Get a device information set that contains all devices or all devices
  // of a specified class. Using here the latter for the Port class.
  // Leaving out DIGCF_DEVICEINTERFACE in the Flags causes search of the
  // Setup Classes conforming ClassGUID, which would also report parallel
  // ports.. Leaving in DIGCF_DEVICEINTERFACE finds devices that expose
  // interfaces of the interface class specified by ClassGUID, which results
  // in serial ports only. Replacing DIGCF_DEVICEINTERFACE by DIGCF_ALLCLASSES
  // would ignore ClassGUID and find all devices..
 
  ClassGUID:=cPortClassGUID;
  DevInfo:=SetupDiGetClassDevs(@ClassGUID, nil, 0,
    DIGCF_PRESENT or DIGCF_DEVICEINTERFACE);
  if DevInfo=INVALID_HANDLE_VALUE then Exit;
 
  // Using SetupDiEnumDeviceInfo to get DevInfoData
  DevInfoData.cbSize:=SizeOf(SP_DEVINFO_DATA);
  Index:=0;
  repeat
    More:=SetupDiEnumDeviceInfo(DevInfo, Index, DevInfoData);
    if More then
    begin
      Inc(Index);
      if Verbose then
      begin
        ComList.Add(StringOfChar('=',50));
        S:=GetDevRegPropStr(DevInfo, DevInfoData, SPDRP_FRIENDLYNAME);
        ComList.Add('FriendlyName = '+S);
        S:=GetDevRegPropStr(DevInfo, DevInfoData, SPDRP_DEVICEDESC);
        ComList.Add('DeviceDescription = '+S);
        S:=GetDevRegPropStr(DevInfo, DevInfoData, SPDRP_SERVICE);
        ComList.Add('Service = '+S);
        S:=GetDevRegPropStr(DevInfo, DevInfoData, SPDRP_CLASSGUID);
        ComList.Add('ClassGuid = '+S);
        S:=GetDevRegPropStr(DevInfo, DevInfoData, SPDRP_PHYSICAL_DEVICE_OBJECT_NAME);
        ComList.Add('PhysDevObjName = '+S);
        S:=GetDevRegPropStr(DevInfo, DevInfoData, SPDRP_HARDWAREID);
        ComList.Add('HardwareIds = '+S);
 
        // Obtain DeviceInstanceID
        S:=GetDevInstIdStr(DevInfo, DevInfoData);
        ComList.Add('DeviceInstanceID = '+S);
 
        // Obtain BaseAddress and Interrupt from registry key
        // under DeviceInstanceID
        RegGetPortResources(S, BaseAddress, IRQLevel);
        S:='BaseAddress = $'+IntToHex(BaseAddress, 4);
        S:=S+' - IRQLevel = '+IntToStr(IRQLevel);
        ComList.Add(S);
 
        // Obtain Fifo settings
        S:='ForceFifoEnable = ';
        S:=S+RegQueryValueExStr(DevInfo, DevInfoData, 'ForceFifoEnable');
        S:=S+' - RxFIFO = ';
        S:=S+RegQueryValueExStr(DevInfo, DevInfoData, 'RxFIFO');
        S:=S+' - TxFIFO = ';
        S:=S+RegQueryValueExStr(DevInfo, DevInfoData, 'TxFIFO');
        ComList.Add(S);
 
        // Obtain PortName
        S:=RegQueryValueExStr(DevInfo, DevInfoData, 'PortName');
        ComList.Add('PortName = '+S);
 
      end else
      begin
        // Do quietly as above
        S:=GetDevInstIdStr(DevInfo, DevInfoData);
        RegGetPortResources(S, BaseAddress, IRQLevel);
        S:=RegQueryValueExStr(DevInfo, DevInfoData, 'PortName');
        ComList.AddObject(S, TObject(BaseAddress));
      end;
    end;
  until not More;
 
  // CleanUp
  SetupDiDestroyDeviceInfoList(DevInfo);
end;
 
// ****************************************************************************
// Enumerate Comports, WinXX style  (Win9X/WinNT)
// ****************************************************************************
 
// Helper function for EnumComPortsXX
// Test whether a given ComPort can be opened.
// If so then return True and try to specify the Baseaddress of
// the involved UART.
 
function TestComport(ComName: string; var BaseAddr: Word): Boolean;
var
  ComHandle: THandle;
  W: Word;
begin
  Result:=False;
  BaseAddr:=0;
  if ComName='' then Exit;
  ComHandle:=CreateFile(PChar(ComName),
    GENERIC_READ or GENERIC_WRITE, 0, nil,
    OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if ComHandle<;>;INVALID_HANDLE_VALUE then
  begin
    Result:=True;
    if (Win32Platform=VER_PLATFORM_WIN32_WINDOWS) then
    begin
      // Win95/Win98/WinME; use undocumented dwFunc=10 of EscapeCommFunction
      // to obtain the base address. This trick is from the AsyncPro library
      if EscapeCommFunction(ComHandle, 10) then
      begin
        asm
          mov W, dx
        end;
        BaseAddr:=W;
      end;
    end else
    begin
      // Whatever other windows (expect NT); use some assumption or
      // leave BaseAddr zero for 'exotic' COM ports
      ComName:=UpperCase(ComName);
      if ComName='COM1' then BaseAddr:=$3F8 else
      if ComName='COM2' then BaseAddr:=$2F8 else
      if ComName='COM3' then BaseAddr:=$3E8 else
      if ComName='COM4' then BaseAddr:=$2E8;
    end;
  end;
  CloseHandle(ComHandle);
end;
 
// List usable entries from HKLM\HARDWARE\DEVICEMAP\SERIALCOMM
 
procedure EnumComPortsXX(ComList: TStringList; Verbose: Boolean);
var
  KeyHandle: HKEY;
  ErrCode: Integer;
  Index, ValueLen: Cardinal;
  ValueType, DataLen: DWORD;
  ValueName, Data, S: string;
  BaseAddr: Word;
begin
  // Open relevant key in the Registry.
  ErrCode:=RegOpenKeyEx(
    HKEY_LOCAL_MACHINE,
    'HARDWARE\DEVICEMAP\SERIALCOMM',
    0,
    KEY_READ,
    KeyHandle);
  if ErrCode<;>;ERROR_SUCCESS then Exit;
  // Enumerate the values of the Key
  Index:=0;
  repeat
    ValueLen:=256;
    DataLen:=256;
    SetLength(ValueName, ValueLen);
    SetLength(Data, DataLen);
    ErrCode:=RegEnumValue(
      KeyHandle,
      Index,
      PChar(ValueName),
      ValueLen,
      nil,
      @ValueType,
      PByte(PChar(Data)),
      @DataLen);
    if (ErrCode=ERROR_SUCCESS)
      and (ValueType=REG_SZ) then
    begin
      SetLength(ValueName, ValueLen - 1);
      SetLength(Data, DataLen - 1);
      Inc(Index);
      if TestComPort(Data, BaseAddr) then
      begin
        if Verbose then
        begin
          S:=ValueName+' - '+Data+' - $'+IntToHex(BaseAddr, 4);
          ComList.Add(S);
        end else
        begin
          S:=Data;
          ComList.AddObject(S, TObject(BaseAddr));
        end
      end else if Verbose then
      begin
        S:=ValueName+' - '+Data+' - Cannot Open';
        ComList.Add(S);
      end;
    end
  until (ErrCode <;>; ERROR_SUCCESS);
  // Close Registry Key
  RegCloseKey(KeyHandle);
end;
 
// ****************************************************************************
// Enumerate Comports, Generic
// ****************************************************************************
 
// When Verbose, the strings will contain more info than the port name,
// and can have entries also for Com ports that cannot be opened.
// When not Verbose, the name of port is placed in StringList strings and
// the base address (if found) is placed in StringList objects.
// Returns True when we have at least one entry in the strings; when not
// Verbose this means we have at least one COM port.
 
function EnumComPorts(ComList: TStringList; Verbose: Boolean): Boolean;
begin
  Result:=False;
  if not Assigned(ComList) then Exit;
  // Prepare ComList for update and clear it
  ComList.BeginUpdate;
  ComList.Clear;
  // Determine what specialized method to call..
  case Win32Platform of
    VER_PLATFORM_WIN32s:
    begin
      if Verbose then ComList.Add('Cannot enumerate ComPorts for Win32s.');
    end;
    VER_PLATFORM_WIN32_WINDOWS:
    begin
      if Verbose then ComList.Add('Enumerating ComPorts for Win9X.');
      EnumComPortsXX(ComList, Verbose);
    end;
    VER_PLATFORM_WIN32_NT:
    begin
      if (Win32MajorVersion<;5) then
      begin
        // WinNT 3/4
        if Verbose then ComList.Add('Enumerating ComPorts for WinNT');
        EnumComPortsXX(ComList, Verbose);
      end else
      begin
        // Win2k, WinXP, Vista
        if Verbose then ComList.Add('Enumerating ComPorts for WinXP');
        EnumComPortsXP(ComList, Verbose);
      end;
    end;
  end;
  // Sort the ComList if not Verbose then EndUpdate
  if not Verbose then ComList.Sort;
  ComList.EndUpdate;
  // Return True if we have at least one entry / one COM port
  Result:=(ComList.Count>;0);
end;
 
end.