1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:

procedure PortList(var Strings: TStrings);
var
  Reg : TRegistry;

  procedure ScanRegHardware;
  var
    i : integer;
    PortName : string;
    LName : TStringList;
  begin
    if Reg.OpenKeyReadOnly('\hardware\devicemap\serialcomm') then
    begin
      LName := TStringList.Create;
      Reg.GetValueNames(LName);
      for i := 0 to LName.Count - 1 do
      begin
        if Reg.GetDataType(LName.Strings[i]) = rdString then
        begin
          PortName := Reg.ReadString(LName.Strings[i]);
          if Strings.IndexOf(PortName) < 0 then Strings.Add(PortName);
        end;
      end;
      LName.Free;
    end;
  end;

  procedure ScanRegEnum(Key : String);
  var
    LKey : TStringList;
    LName : TStringList;
    i : Integer;
    Driver, PortName : String;
    PortSubClass : Byte;
  begin
    if not Reg.OpenKeyReadOnly(Key) then Exit;
    LName := TStringList.Create;
    Reg.GetValueNames(LName);
    i := LName.IndexOf('class');
    if i >= 0 then
    begin
      if (Reg.GetDataType('class') = rdString) and
         (LowerCase(Reg.ReadString('class')) = 'ports') and
         (Reg.GetDataType('driver') = rdString) and
         (Reg.GetDataType('portname') = rdString) then
      begin
        Driver := Reg.ReadString('driver');
        PortName := Reg.ReadString('portname');
        if(Reg.OpenKeyReadOnly('\System\CurrentControlSet\Services\Class\'+ Driver)) and
          (Reg.ReadBinaryData('PortSubClass',PortSubClass,1) = 1) and
          (PortSubClass = 1) and (Strings.IndexOf(PortName) < 0) then
          Strings.Add(PortName);
      end;
    end;
    LName.Free;
    Reg.OpenKeyReadOnly(Key);
    if Reg.HasSubKeys then
    begin
      LKey := TStringList.Create;
      Reg.GetKeyNames(LKey);
      for i := 0 to LKey.Count - 1 do
      begin
        ScanRegEnum(Key + '\' + LKey[i]);
      end;
      LKey.Free;
    end;
  end;

var
  VersionInfo : TOSVersionInfo;
begin
  if CheckOS(VersionInfo) > 0 then
    if VersionInfo.dwMajorVersion >= 4 then
    begin
      Reg := TRegistry.Create;
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      if VersionInfo.dwMajorVersion > 4 then ScanRegHardware //Win 2k, XP
      else if VersionInfo.dwMinorVersion > 0 then ScanRegEnum('\enum') //Win9x, mE
      else ScanRegHardware; //WinNT
      Reg.Free;
    end;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

function ComAvailable(ComNr: byte): boolean;
var
  TestHandle : integer;
begin
  TestHandle :=
  CreateFile(PChar('\\.\COM'+IntToStr(ComNr)),GENERIC_READ or GENERIC_WRITE,0,
             nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED,LongInt(0));
  if (TestHandle = -1) then
    Result := false
  else
  begin
    Result := true;
    CloseHandle(TestHandle);
  end;
end;					

1:
2:
3:
4:
5:

for i:=1 to 255 do
begin
  if ComAvailable(i) then //mach was 
  else break;
end;