如何取得PC上的所有串口

Question

我想取得 PC上的所有的串口名，
并且想通过这些串口名 跟MSCOM控件逐个对应起来怎么操作

Answer 1

{列出所有可用的串口}
function TForm1.ListAllComm: TStrings;
var
   TmpReg:  TRegistry;
   TmpPath,  TmpKey,  TmpComName:  string;
   i:  Integer;
   ComStrings:TStrings ;
begin
   TmpReg  :=  TRegistry.Create;
   ComStrings:=TStringList.Create;
   ComStrings.Clear;
   try
       TmpReg.RootKey  :=  HKEY_LOCAL_MACHINE;
       TmpPath  :=  '\HARDWARE\DEVICEMAP\SERIALCOMM';       if  TmpReg.OpenKeyReadOnly(TmpPath)  then
           for  i  :=  0  to  9  do
           begin
               TmpKey  :=  Format('\Device\Serial%d',  [i]);
               TmpComName  :=  TmpReg.ReadString(TmpKey);
               if  TmpComName  <>  ''  then
                   ComStrings.Add(TmpComName);
           end;
   finally
       TmpReg.Free;
   end;
   Result:=ComStrings;
   //ComStrings.Free;end;procedure TForm1.Button1Click(Sender: TObject);
begin
    ListBox1.Items.Clear;
    ListBox1.Items:=ListAllComm;
end;

Answer 2

function GetComPortList: TStrings;
var
  Reg: TRegistry;
  sts1,sts2: TStrings;
  i: Integer;
  RegPath: string;  //注册表中存放串口路径
begin
  Result := nil;
  Reg := TRegistry.Create;
  try
    sts1 := TStringList.Create;
    try
      sts2 := TStringList.Create;
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      RegPath := 'hardware\devicemap\SerialComm';
      if Reg.OpenKey(RegPath, False) then
      begin
        Reg.GetValueNames(sts1);
        for i := 0 to sts1.Count-1 do
          sts2.Add(Reg.ReadString(sts1.Strings[i]));
      end;
      Result := sts2;
      sts2 := nil;
    finally
      FreeAndNil(sts1);
    end;
  finally
    Reg.CloseKey;
    FreeAndNil(Reg);
  end;
end;

Answer 3

uses 
  Registry; procedure TForm1.Button1Click(Sender: TObject); 
var 
  reg: TRegistry; 
  st: Tstrings; 
  i: Integer; 
begin 
  reg := TRegistry.Create; 
  try 
    reg.RootKey := HKEY_LOCAL_MACHINE; 
    reg.OpenKey('hardware\devicemap\serialcomm', False); 
    st := TstringList.Create; 
    try 
      reg.GetValueNames(st); 
      for i := 0 to st.Count - 1 do  
        Memo1.Lines.Add(reg.Readstring(st.strings[i])); 
    finally 
      st.Free; 
    end; 
    reg.CloseKey; 
  finally 
    reg.Free; 
  end; 
end; 

Answer 4

procedure EnumComPorts(Ports: TStrings);
var
  KeyHandle: HKEY;
  ErrCode, Index: Integer;
  ValueName, Data: string;
  ValueLen, DataLen, ValueType: DWORD;
  TmpPorts: TStringList;
begin
  ErrCode := RegOpenKeyEx(
    HKEY_LOCAL_MACHINE,
    'HARDWARE\DEVICEMAP\SERIALCOMM',
    0,
    KEY_READ,
    KeyHandle);  if ErrCode <> ERROR_SUCCESS then
    Exit;  // raise EComPort.Create(CError_RegError, ErrCode);  TmpPorts := TStringList.Create;
  try
    Index := 0;
    repeat
      ValueLen := 256;
      DataLen := 256;
      SetLength(ValueName, ValueLen);
      SetLength(Data, DataLen);
      ErrCode := RegEnumValue(
        KeyHandle,
        Index,
        PChar(ValueName),
        Cardinal(ValueLen),
        nil,
        @ValueType,
        PByte(PChar(Data)),
        @DataLen);      if ErrCode = ERROR_SUCCESS then
      begin
        SetLength(Data, DataLen);
        TmpPorts.Add(Data);
        Inc(Index);
      end
      else
        if ErrCode <> ERROR_NO_MORE_ITEMS then
          exit; //raise EComPort.Create(CError_RegError, ErrCode);    until (ErrCode <> ERROR_SUCCESS) ;    TmpPorts.Sort;
    Ports.Assign(TmpPorts);
  finally
    RegCloseKey(KeyHandle);
    TmpPorts.Free;
  end;end;

Answer 5

procedure TFrmCommSet.GetComm;
var
  Registry: TRegistry;
  str : string;
  i: integer;
begin
  cbComm.Items.Clear;
  Registry := TRegistry.Create(KEY_READ);
  try
    Registry.RootKey := HKEY_LOCAL_MACHINE;
    Registry.OpenKey('HARDWARE\DEVICEMAP\SERIALCOMM', False);
    for i := 0 to 100 do
    begin
      str := '\Device\Serial' + inttostr(i);
      str := Registry.ReadString(str);
      if str <> '' then
        cbComm.Items.Add(str);
    end;
  finally
    Registry.Free;
  end;
  cbComm.ItemIndex := 0;
end;

Answer 6

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Registry, StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
var 
  reg: TRegistry; 
  st: Tstrings; 
  i: Integer; 
begin 
  reg := TRegistry.Create;
  try 
    reg.RootKey := HKEY_LOCAL_MACHINE; 
    reg.OpenKey('hardware\devicemap\serialcomm', False); 
    st := TstringList.Create; 
    try 
      reg.GetValueNames(st); 
      for i := 0 to st.Count - 1 do  
        Memo1.Lines.Add(reg.Readstring(st.strings[i]));
    finally
      st.Free;
    end;
    reg.CloseKey;
  finally 
    reg.Free; 
  end; 
end;end.