Check how many COM ports are available

Problem/Question/Abstract:

How to check how many COM ports are available

Answer:

Solve 1:

function ExtComName(ComNr: DWORD): string;
begin
  if ComNr > 9 then
    Result := Format('\\\\.\\COM%d', [ComNr])
  else
    Result := Format('COM%d', [ComNr]);
end;

function CheckCom(AComNumber: Integer): Integer;
var
  FHandle: THandle;
begin
  Result := 0;
  FHandle := CreateFile(PChar(ExtComName(AComNumber)),
    GENERIC_READ or GENERIC_WRITE,
    0, {exclusive access}
    nil, {no security attrs}
    OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL,
    0);
  if FHandle <> INVALID_HANDLE_VALUE then
    CloseHandle(FHandle)
  else
    Result := GetLastError;
end;

var
  XX, Err: Integer;

  for XX := 1 to 20 do
  begin
    Err := CheckCom(XX);
    if (Err = 0) or (Err = ERROR_ACCESS_DENIED) then
      {the Port exists, if  Err = ERROR_ACCESS_DENIED then the port is already open}
    else if (Err = ERROR_FILE_NOT_FOUND) then
      {the Port does not exists}
    else
      {another Error}
  end;


Solve 2:

The following bit of code checks both the Comm Ports and the JoyStick Ports, placing them in a combobox. Those which were used were displayed grey and those free were displayed black. A log message was constructed during the enumeration and could be displayed to show what was found. The comm ports are held in two places in the registry and are slightly different for Win9? and NT.

procedure GetCommNames(CommNames: TStringList);
{searches the *PNP0501 and SerialComm entries in the registry fo commport names}
var
  Reg: TRegistry;
  SerPtSL: TStringList;
  i: integer;
  CommStr: string;
const
  CommPNPKey: string = '\Enum\BIOS\*PNP0501';
  HardwareKey: string = '\hardware\devicemap\serialcomm';
begin
  {stringlist to hold key or value names during search}
  SerPtSL := TStringList.Create;
  Reg := TRegistry.Create;
  with Reg do
  begin
    RootKey := HKEY_LOCAL_MACHINE;
    LogStr := LogStr + '  HKEY_LOCAL_MACHINE' + #13;
    {check PNP entries}
    if OpenKey(CommPNPKey, false) then
    begin
      LogStr := Format('%s  %s opened%s', [LogStr, CommPNPKey, #13]);
      {get all serial port keys - one key for each interupt used}
      GetKeyNames(SerPtSL);
      {get the Comm names for all the keys - into CommSL}
      for i := 0 to SerPtSL.Count - 1 do
      begin
        OpenKey(CommPNPKey + '\' + SerPtSL.Strings[i], false);
        if GetDataType('PortName') = rdString then
        begin
          CommNames.Add(ReadString('PortName'));
          LogStr := Format('%s  %s%s', [LogStr, CommNames.Strings[i], #13]);
        end;
      end;
    end
    else
      LogStr := LogStr + '  Unable to open ' + CommPNPKey + #13;
    SerPtSL.Clear; {to use for hardware value names}
    {check the hardware entries}
    if OpenKey(HardwareKey, false) then
    begin
      LogStr := Format('%s  %s opened%s', [LogStr, HardwareKey, #13]);
      {get the value names for the commports - NT is "Serialn" W95 is "COMn"}
      GetValueNames(SerPtSL);
      {now get the data value for each commport}
      for i := 0 to SerPtSL.Count - 1 do
        if GetDataType(SerPtSL.Strings[i]) = rdString then
        begin
          CommStr := ReadString(SerPtSL.Strings[i]);
          LogStr := LogStr + '    ' + CommStr;
          {if it's not in CommNames already ...}
          if CommNames.IndexOf(CommStr) < 0 then
          begin
            {... add it}
            CommNames.Add(CommStr);
            LogStr := LogStr + ' added' + #13;
          end
          else
            LogStr := LogStr + ' already in list' + #13;
        end;
    end
    else
      LogStr := Format('%s  Unable to open %s', [LogStr, HardwareKey, #13]);
    Free; {TRegistry}
  end;
  SerPtSL.Free;
end;

procedure TForm1.GetComBtnClick(Sender: TObject);
{this is the initiator of the "fill combobox with com ports" action}
var
  PortList: TStringList;
begin
  LogStr := '';
  LogBtn.Enabled := false;
  PortList := TStringList.Create;
  GetAvailableJoyPort(PortList);
  GetAvailableCommPorts(PortList);
  with PortComboBox do
  begin
    {put the stringlist into the combobox}
    Items.Assign(PortList);
    {select the first available port to show}
    ItemIndex := PortComboBox.Items.IndexOfObject(pointer(true));
    if Pos('COM', Items[ItemIndex]) > 0 then
      EnableDCBBtns(ItemIndex > -1);
    Enabled := true;
  end;
  PortList.Free;
  LogBtn.Enabled := true;
end;

procedure TForm1.GetAvailableJoyPort(JoyList: TStringList);
{gets the joystick ports - they are available only if a joystick is plugged in}
var
  Res: DWord;
begin
  LogStr := 'JoyPort' + #13;
  Res := JoySetCapture(Self.Handle, JOYSTICKID1, 0, true);
  JoyReleaseCapture(JOYSTICKID1);
  case Res of
    JOYERR_NOERROR:
      begin
        JoyList.AddObject('Joystick', pointer(true));
        LogStr := LogStr + '  OK : JOYERR_NOERROR' + #13;
      end;
    JOYERR_PARMS:
      LogStr := LogStr + '  Error : JOYERR_PARMS' + #13;
    JOYERR_NOCANDO:
      LogStr := LogStr + '  Error : JOYERR_NOCANDO' + #13;
    JOYERR_UNPLUGGED:
      begin
        JoyList.AddObject('Joystick', pointer(false));
        LogStr := LogStr + '  Eror : JOYERR_UNPLUGGED' + #13;
      end;
  else
    LogStr := Format('%s  Unknown Error : %d%s', [LogStr, Res, #13]);
  end;
end;

procedure TForm1.GetAvailableCommPorts(ComList: TStringList);
{puts the COM ports into a list. available ports have the stringlist objects
set to a non-nil value. to be available the ports must be a hardware port (in
the registry list comm ports) and have a ProviderSubType of PST_RS232}
var
  CommSL: TStringList;
  CommName: string;
  hComm: THandle;
  PtrCommConfig: PCommConfig;
  i, CommConfigSize: integer;
  Available: boolean;
begin
  LogStr := LogStr + 'CommPorts' + #13;
  CommSL := TStringList.Create;
  GetCommNames(CommSL);
  LogStr := Format('%s  %d Different CommPorts Found in Registry%s',
    [LogStr, CommSL.Count, #13]);
  LogStr := Format('%sOpening Ports as a File%s', [LogStr, #13]);
  {CommSL now contains the list of commports from the registry}
  for i := 0 to CommSL.Count - 1 do
  begin
    CommName := CommSL.Strings[i]; {Format('COM%d', [i]);}
    Available := false;
    LogStr := LogStr + '    ' + CommName + ' : ';
    {open the port as a file}
    hComm := CreateFile(PChar(CommName), GENERIC_READ or GENERIC_WRITE,
      0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
    if hComm <> INVALID_HANDLE_VALUE then
    begin
      {its a useable COM port - check if its an RS232 type}
      CommConfigSize := SizeOf(TCommConfig);
      PtrCommConfig := AllocMem(CommConfigSize);
      if not GetCommConfig(hComm, PtrCommConfig^, CommConfigSize) then
      begin
        {not enough memory - get what's needed}
        ReAllocMem(PtrCommConfig, CommConfigSize);
        GetCommConfig(hComm, PtrCommConfig^, CommConfigSize);
      end;
      Available := (PtrCommConfig^.dwProviderSubType = PST_RS232);
      if Available then
        LogStr := LogStr + 'PST_RS232' + #13
      else
        LogStr := Format('%sdwProviderSubType : %d%s', [LogStr,
          PtrCommConfig^.dwProviderSubType, #13]);
      FreeMem(PtrCommConfig);
    end
    else
    begin
      Available := false;
      LogStr := LogStr + ' Not Available - INVALID_HANDLE_VALUE' + #13;
    end;
    CloseHandle(hComm);
    ComList.AddObject(CommName, pointer((Available)))
  end;
  CommSL.Free;
end;

procedure TForm1.PortComboBoxDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
{draws items in gray if the Items.Objects[n] is nil, in black if it is <> nil}
begin
  with PortComboBox do
  begin
    if not bool(Items.Objects[Index]) then
    begin
      {item is not available ...}
      Canvas.Brush.Color := clWhite; { never indicate as selected}
      Canvas.Font.Color := clBtnFace; {grey out text}
    end;
    {now draw background and text}
    Canvas.FillRect(Rect);
    Canvas.TextOut(Rect.Left, Rect.Top, Items[Index]);
  end;
end;


Solve 3:

This checks for LPT1:

uses
  WinSpool;

type
  TArrayPORT_INFO_1 = array[0..0] of PORT_INFO_1;
  PArrayPORT_INFO_1 = ^TArrayPORT_INFO_1;

procedure LPT1Check();
var
  apiBuffer: PArrayPORT_INFO_1;
  lwBufferSize: LongWord;
  lwPortCount: LongWord;
  lwIndex: LongWord;
  sMessage: string;
begin
  {Find required size of the buffer}
  EnumPorts(nil, 1, nil, 0, lwBufferSize, lwPortCount);
  {Alloc and fill buffer}
  apiBuffer := AllocMem(lwBufferSize);
  EnumPorts(nil, 1, apiBuffer, lwBufferSize, lwBufferSize, lwPortCount);
  {Search returned buffer}
  {Using word so must check for 0 as 0 - 1 = 4294967295  not -1!}
  if lwPortCount = 0 then
    sMessage := 'No ports installed on this system'
  else
  begin
    sMessage := 'LPT1: not found on this system';
    for lwIndex := 0 to lwPortCount - 1 do
    begin
      if UpperCase(apiBuffer[lwIndex].pName) = 'LPT1:' then
      begin
        sMessage := 'LPT1: exists';
        Break;
      end;
    end;
  end;
  {Free the buffer and show result}
  FreeMem(apiBuffer);
  ShowMessage(sMessage);
end;