Check how many COM ports are available (Views: 32)
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; |