Jump to content
kvk1989

comport output

Recommended Posts

hello all !

can someone help me to get comport output in combobox ?

 

output like this

cport.png

Edited by kvk1989

Share this post


Link to post
43 minutes ago, limelect said:

Put the picture here so we can see what you are talking about.

Cannot download the picture

 

cport.png

Share this post


Link to post

So you are looking for the friendly names for serial COM ports?  There are various methods to find them, depending on how were installed:

 

1 - Enumerate HLM\HARDWARE\DEVICEMAP\SERIALCOMM registry
2 - Enumerate Device Installation Class 'Ports' which finds most serial ports including USB
3 - Optionally add Disabled 'Ports' (hardware not currently installed)
4 - Enumerate Device Installation Class 'CNCPorts' (used by com0com serial port emulator)
5 - Enumerate Device Installation Class 'Modem' which finds USB and internal modems

 

I have an old component that does all this, never got around to publishing it, maybe in December.

 

Angus

Share this post


Link to post
7 hours ago, limelect said:

@kvk1989 It seems you do not understand

Your link does not work

PUT your picture here

 

 

cport.png

Share this post


Link to post

hi all,

problem solved thanks for all !

 

unit USBPort;

interface

uses
  Winapi.Windows, System.SysUtils, System.Variants, System.Classes, SetupApi,
  System.Win.Registry, Vcl.StdCtrls, Vcl.Graphics,Fungsi;

const
  GUID_DEVINTERFACE_COMPORT: TGUID = '{86E0D1E0-8089-11D0-9CE4-08003E301F73}';

 procedure SearchPort(cb: Tcombobox);
 Function GetPort(port:string):string;

implementation

uses Dos, Emmcdl, Unit1, XMLparser;

function SetupEnumAvailableComPorts: TstringList;
var
  RequiredSize: Cardinal;
  GUIDSize: DWORD;
  Guid: TGUID;
  DevInfoHandle: HDEVINFO;
  DeviceInfoData: TSPDevInfoData;
  MemberIndex: Cardinal;
  PropertyRegDataType: DWord;
  RegProperty: Cardinal;
  RegTyp: Cardinal;
  Key: Hkey;
  Info: TRegKeyInfo;
  S1, S2: string;
  hc: THandle;
begin
  Result := Nil;
  if not LoadsetupAPI then
    exit;
  try
    GUIDSize := 1;
    if SetupDiClassGuidsFromName('Ports', @Guid, GUIDSize, RequiredSize) then
    begin
      DevInfoHandle := SetupDiGetClassDevs(@Guid, Nil, 0, DIGCF_PRESENT);
      if Cardinal(DevInfoHandle) <> Invalid_Handle_Value then
      begin
        try
          MemberIndex := 0;
          result := TStringList.Create;
          repeat
            FillChar(DeviceInfoData, SizeOf(DeviceInfoData), 0);
            DeviceInfoData.cbSize := SizeOf(DeviceInfoData);

            if not SetupDiEnumDeviceInfo(DevInfoHandle, MemberIndex, DeviceInfoData) then
              break;
            RegProperty := SPDRP_FriendlyName;
            SetupDiGetDeviceRegistryProperty(DevInfoHandle, DeviceInfoData, RegProperty, PropertyRegDataType, NIL, 0, RequiredSize);
            SetLength(S1, RequiredSize);

            if SetupDiGetDeviceRegistryProperty(DevInfoHandle, DeviceInfoData, RegProperty, PropertyRegDataType, @S1[1], RequiredSize, RequiredSize) then
            begin
              Key := SetupDiOpenDevRegKey(DevInfoHandle, DeviceInfoData, DICS_FLAG_GLOBAL, 0, DIREG_DEV, KEY_READ);
              if Key <> INValid_Handle_Value then
              begin
                FillChar(Info, SizeOf(Info), 0);
                if RegQueryInfoKey(Key, nil, nil, nil, @Info.NumSubKeys, @Info.MaxSubKeyLen, nil, @Info.NumValues, @Info.MaxValueLen, @Info.MaxDataLen, nil, @Info.FileTime) = ERROR_SUCCESS then
                begin
                  RequiredSize := Info.MaxValueLen + 1;
                  SetLength(S2, RequiredSize);
                  if RegQueryValueEx(Key, 'PortName', Nil, @RegTyp, @S2[1], @RequiredSize) = Error_Success then
                  begin
                    if (Pos('COM', S2) = 1) then
                    begin
                      hc := CreateFile(pchar('\\.\' + S2 + #0), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
                      if hc <> INVALID_HANDLE_VALUE then
                      begin
                        Result.Add(StrPas(PansiChar(S1)));
                        CloseHandle(hc);
                      end;
                    end;
                  end;
                end;
                RegCloseKey(Key);
              end;
            end;
            Inc(MemberIndex);
          until False;
          if Result.Count = 0 then
          begin
            Result.Free;
            Result := NIL;

          end
        finally
          SetupDiDestroyDeviceInfoList(DevInfoHandle);
        end;
      end;
    end;
  finally
    UnloadSetupApi;
  end;
end;

procedure SearchPort(cb: Tcombobox);
var
  ComPortString: TStringList;
  i: integer;
  nameport: string;
begin
  cb.Items.Clear;
  ComPortString := TStringList.Create;
  try
    ComPortString := SetupEnumAvailableComPorts;
    if (ComPortString <> nil) and (ComPortString.Count > 0) then
    begin
      for i := 0 to ComPortString.Count - 1 do
      begin
        nameport := ComPortString[i].trim;
        cb.items.add(nameport);
        cb.itemindex := 0;
      end;
    end;
  finally
    ComPortString.free;
  end;
end;

Function GetPort(port:string):string;
begin
  result := RightStr(port, 7).Replace('(', '').Replace('C', '').Replace('O', '').Replace('M', '').Replace(')', '').trim;
end;

end.

 

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×