Люди, подскажите, как можно получить список номеров СОМ портов компьютера.

Лови

Код

unit Port; interface uses  Windows, SysUtils, Classes, StdCtrls, VCLUtils;  procedure SelectPort(n :Integer; Cmb: TComboBox); implementation type  tComPortState = (csNotPresent,csAccessible,csNoAccessible); function ComPortState (n :Integer) :tComPortState; var h :tHandle; begin  h := CreateFile(pChar(Format('\\.\COM%d',[n])),     // name                  GENERIC_READ or GENERIC_WRITE,      // access attributes                  0,                                  // no sharing                  nil,                                // no security                  OPEN_EXISTING,                      // creation action                  FILE_ATTRIBUTE_NORMAL or                  FILE_FLAG_OVERLAPPED,               // attributes                  0);                                 // no template  if  h <> INVALID_HANDLE_VALUE  then begin    // порт открыли    Result := csAccessible;   // порт существует и доступен    CloseHandle(h);           // закроем обратно :)    end  else if  GetLastError = ERROR_ACCESS_DENIED  then begin    // порт не открыли по причине недоступности    Result := csNoAccessible; // порт существует но недоступен    end  else begin    // порт не открыли но не по причине недоступности    Result := csNotPresent;   // порт несуществует  end; end; const  MaxComNum = 32; procedure GetPortsList (List :tStrings);  // Заполняет List списком портов var n :Integer; begin  //if  List.Count > 0  then  Exit;  StartWait;  with  List  do try    BeginUpdate;    Clear;    for n := 1 to MaxComNum do      case ComPortState(n) of        csNotPresent   :; // несуществующие порты нам неинтересны        csAccessible   : AddObject('Com'+IntToStr(n)           , Pointer(n));        csNoAccessible : AddObject('Com'+IntToStr(n)+' (занят)', Pointer(n));      end;  finally    EndUpdate;    StopWait;  end; end; procedure SelectPort(n :Integer; Cmb: TComboBox); var  i :Integer; begin  with  Cmb.Items  do begin    if  Count <= 0  then      // список пуст, возможно еще не заполняли, сделаем это      GetPortsList(Cmb.Items);    // очистим список от несуществующих портов    i := 0;    while i < Count do      if  Pos('(не существует)',Strings[i]) > 0  then        Delete(i)      else        Inc(i);    // получим индекс выбираемого порта в списке    i := Cmb.Items.IndexOfObject(Pointer(n));    // если выбираемый порт не существует, занесем его в список    if  i < 0  then begin      // причем вставить его надо с учетом сортировки, поищем куда      i := 0;  while (i < Count) and (Integer(Objects[i]) < n)  do  Inc(i);      // ну и вставим конечно      InsertObject(i,'Com'+IntToStr(n)+' (не существует)', Pointer(n));    end;  end;  // теперь выберем его  Cmb.ItemIndex := i;  // надо уведомить заинтересованных об изменении выбора  //if  Assigned(ComboBox1.OnChange)  then  ComboBox1.OnChange(ComboBox1); end; end.

procedure TfrmSetPort.FormCreate(Sender: TObject);
var reg: TRegistry;
ts:TStrings;
i: integer;
setiniFile: TIniFile;
begin
iniFileName:= Application.ExeName;
iniFileName:= ExtractWord(1,iniFileName,['.']);
iniFileName:= iniFileName+'.ini';
setiniFile := TIniFile.Create(iniFileName);
{считываем активные каналы}
chPort1.Checked:= setiniFile.ReadBool('Active Chanel','Chanel#1',false);
chPort2.Checked:= setiniFile.ReadBool('Active Chanel','Chanel#2',false);
chPort3.Checked:= setiniFile.ReadBool('Active Chanel','Chanel#3',false);
chPort4.Checked:= setiniFile.ReadBool('Active Chanel','Chanel#4',false);
{считываем номера портов}
cbPort1.Text:= setiniFile.ReadString('Port Name','Chanel#1','COM%');
cbPort2.Text:= setiniFile.ReadString('Port Name','Chanel#2','COM%');
cbPort3.Text:= setiniFile.ReadString('Port Name','Chanel#3','COM%');
cbPort4.Text:= setiniFile.ReadString('Port Name','Chanel#4','COM%');
cbStartRun.Checked:= setiniFile.ReadBool('Start at run application','RunStart',false);
case cbStartRun.Checked of //
true: begin
btnApplay.Click;
btnApplay.Enabled:=false;
end;
false: begin

end;
end; // case

setiniFile.Free;

{установка флагов в 0};
flagPort1:=0;
flagPort2:=0;
flagPort3:=0;
flagPort4:=0;
{заполение именами портов}
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey('hardware\devicemap\serialcomm',false);
ts := TStringList.Create;
reg.GetValueNames(ts);
for i := 0 to ts.Count -1 do
begin
cbPort1.Items.Add(reg.ReadString(ts.Strings[i]));
cbPort2.Items.Add(reg.ReadString(ts.Strings[i]));
cbPort3.Items.Add(reg.ReadString(ts.Strings[i]));
cbPort4.Items.Add(reg.ReadString(ts.Strings[i]));
end;
ts.Free;
reg.CloseKey;
reg.free;
count_HSP_port1:=1;
lastHBCH1:=now;
flagErrorPort1:=0;
isOnLine1:= true;
end;