kvk1989

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.

.

Hi , Please share if you have