原理是查看注册表中对应键值。

procedure GetComList(const ComList: TStrings);
var
reg:TRegistry;
List :TStringList;
i:Integer;
s:string;
begin
reg := TRegistry.Create;
List := TStringList.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey('HARDWARE\DEVICEMAP\SERIALCOMM',True);
reg.GetValueNames(List);
   for i:=0 to List.Count-1 do
   begin
      s:=List[i];
      if (s='')or(strlicomp(@s[1],'com',3)<>0) then
      begin
         s:=reg.ReadString(s);
         if (s='')or(strlicomp(@s[1],'com',3)<>0) then continue;
      end;
      comList.Add(s);
   end;
end;

procedure GetModemList(ModemList:TStrings);
const
   Path1='System\CurrentControlSet\Services\Class\Modem\';
   Path2='System\CurrentControlSet\Control\Class\{4D36E96D-E325-11CE-BFC1-08002BE10318}\';
var
   reg:tregistry;
   i:integer;
   list:TStringList;
   s:string;
begin
   List:=Tstringlist.create;
   reg:=tregistry.create;
   reg.RootKey:=HKEY_LOCAL_MACHINE;

   //Windows 9x
   if reg.openkey(Path1,false) then
   begin
      reg.GetKeyNames(List);
      reg.CloseKey;
      for i:=0 to List.count-1 do
      begin
         reg.openkey(Path1+List[i],true);
         if reg.ValueExists('model') then
            ModemList.add(reg.ReadString('model'));
         if reg.ValueExists('AttachedTo') then
         begin
            s:=reg.ReadString('AttachedTo');
            if (s='')or(strlicomp(@s[1],'com',3)<>0) then //
            else if ModemList.IndexOf(s)=-1 then ModemList.Add(s);
         end;
         reg.closekey;
      end;
   end;

   //Windows XP
   if reg.openkey(Path2,false) then
   begin
      reg.GetKeyNames(List);
      reg.CloseKey;
      for i:=0 to List.count-1 do
      begin
         reg.openkey(Path2+List[i],true);
         if reg.ValueExists('FriendlyName') then
            ModemList.add(reg.ReadString('FriendlyName'));
         if reg.ValueExists('AttachedTo') then
         begin
            s:=reg.ReadString('AttachedTo');
            if (s='')or(strlicomp(@s[1],'com',3)<>0) then //
            else if ModemList.IndexOf(s)=-1 then ModemList.Add(s);
         end;
         reg.closekey;
      end;
   end;
   reg.free;
   List.free;
end;