Newsgroup: it.comp.lang.delphi
Titolo: Elenco porte seriali disponibili

Ciao a tutti, vorrei sapere se c'è un modo per ottenere l'elenco delle
porte seriali disponibili in un sistema.
Uso il componente TurboPower ma non ho trovato nulla di quello che mi serve
Grazie mille a turri.
Giuseppe

Questa funzione ritorna la lista delle seriali libere nel sistema:
// ------------------------------------
// Usate per Lista_Seriali_Disponibili
// ------------------------------------
Const
     Max_Seriali = 100; // e' molto improbabile avere piu' di 100 seriali
Type
    TPorte_Disponibili  = Array[1..Max_Seriali] Of Byte;
Function Lista_Seriali_Disponibili(Var Porte_Disponibili : 
TPorte_Disponibili) : Byte;
Var
   I       : Byte;
   S       : String;
   N_Porte : Byte;
   Handle  : THandle;
Begin
   // ------------------------------
   // Nessuna porta trovata
   // ------------------------------
   N_Porte := 0;
   // ------------------------------
   // Ciclo per tutte le porte
   // ------------------------------
   For I := 1 To Max_Seriali Do
       Begin
         // ------------------------------------------------
         // Il nome del file deve essere del tipo '\\.\COMx'
         // ------------------------------------------------
          SysUtils.FmtStr(S, '\\.\COM%-d', [I] );
         // ------------------------------------------------
         // Tento di aprire la seriale
         // ------------------------------------------------
         Handle := CreateFile(PChar(S),
                              GENERIC_READ or GENERIC_WRITE,
                              0,
                              Nil,
                              OPEN_EXISTING,
                              FILE_ATTRIBUTE_NORMAL,
                              0);
         // ------------------------------------------------
         // Se l'handle e' uguale a INVALID_HANDLE_VALUE
         // non sono riuscito ad aprirla
         // (o perche' non esiste o perche' e' gia' in uso)
         // ------------------------------------------------
         If Handle <> INVALID_HANDLE_VALUE Then
            Begin
              // ------------------------------------------------
              // Incremento il numero di porte trovate
              // ------------------------------------------------
              Inc(N_Porte);
              // ------------------------------------------------
              // Memorizzo il numero della porta
              // ------------------------------------------------
              Porte_Disponibili[N_Porte] := I;
              // ------------------------------------------------
              // Chiudo la COM
              // ------------------------------------------------
              CloseHandle(Handle);
            End;
       End;
   Result := N_Porte;
End;
Ciao,
David



Grazie mille per la tua disponibilità, mi sarà di grande aiuto.
Giuseppe

 porte seriali disponibili in un sistema.
Oltra al contributo di DAvid aggiungo questa che e' stata copiata da un
post usenet (
http://tinyurl.com/6v44e
), cosi' le teniamo archiviate qui su
ICLD.
=========== 
The following bit of code checked both the Comm Ports and the JoyStick
Ports,
placing them in a combobox. Those which were used were displayed grey
and those
free were displayed black. A log message was constructed during the
enumeration
and could be displayed to show what was found.
The comm ports are held in two places in the registry and are slightly
different for Win9? and NT.
If you have problems with this code I can send you the exe and other
stuff, and
might be able to answer other questions.
procedure GetCommNames(CommNames : TStringList);
{searches the *PNP0501 and SerialComm entries in the registry fo
commport
names}
var
  Reg : TRegistry;
  SerPtSL : TStringList;
  i : integer;
  CommStr : string;
const
  CommPNPKey : string = '\Enum\BIOS\*PNP0501';
  HardwareKey : string = '\hardware\devicemap\serialcomm';
begin
  {stringlist to hold key or value names during search}
  SerPtSL := TStringList.Create;
  Reg := TRegistry.Create;
  with Reg do begin
    RootKey := HKEY LOCAL MACHINE;
    LogStr := LogStr + '  HKEY LOCAL MACHINE' + #13;
    {check PNP entries}
    if OpenKey(CommPNPKey, false) then begin
      LogStr := Format('%s  %s opened%s', [LogStr, CommPNPKey, #13]);
      {get all serial port keys - one key for each interupt used}
      GetKeyNames(SerPtSL);
      {get the Comm names for all the keys - into CommSL}
      for i := 0 to SerPtSL.Count - 1 do begin
        OpenKey(CommPNPKey + '\' + SerPtSL.Strings[i], false);
        if GetDataType('PortName') = rdString then begin
          CommNames.Add(ReadString('PortName'));
          LogStr := Format('%s    %s%s', [LogStr, CommNames.Strings[i],
#13]);
        end;
      end; {for i := 0 to SerPtSL.Count - 1}
      end {if OpenKey(CommPNP, false) else}
    else
      LogStr := LogStr + '  Unable to open ' + CommPNPKey + #13;
    SerPtSL.Clear; // to use for hardware value names
    {check the hardware entries}
    if OpenKey(HardwareKey, false) then begin
      LogStr := Format('%s  %s opened%s', [LogStr, HardwareKey, #13]);
      {get the value names for the commports - NT is "Serialn" W95 is
"COMn"}
      GetValueNames(SerPtSL);
      {now get the data value for each commport}
      for i := 0 to SerPtSL.Count - 1 do
        if GetDataType(SerPtSL.Strings[i]) = rdString then begin
          CommStr := ReadString(SerPtSL.Strings[i]);
          LogStr := LogStr + '    ' + CommStr;
          {if its not in CommNames already ...}
          if CommNames.IndexOf(CommStr) < 0 then begin
            {... add it}
            CommNames.Add(CommStr);
            LogStr := LogStr + ' added' + #13;
            end
          else
            LogStr := LogStr + ' already in list' + #13;
          end;
        end {if GetDataType(SerPtSL.Strings[i]) = rdString}
      {end; for i := 0 to SerPtSL.Count - 1}
    else
      LogStr := Format('%s  Unable to open %s', [LogStr, HardwareKey,
#13]);
    {end; if OpenKey(HardwareKey, false) else}
    Free; // TFegistry
  end;
  SerPtSL.Free;
end;
procedure TForm1.GetComBtnClick(Sender: TObject);
{this is the initiator of the "fill combobox with com ports" action}
var
  PortList : TStringList;
begin
  LogStr := '';
  LogBtn.Enabled := false;
  PortList := TStringList.Create;
  GetAvailableJoyPort(PortList);
  GetAvailableCommPorts(PortList);
  with PortComboBox do begin
    {put the stringlist into the combobox}
    Items.Assign(PortList);
    {select the first available port to show}
    ItemIndex := PortComboBox.Items.IndexOfObject(pointer(true));
    if Pos('COM', Items[ItemIndex]) > 0 then
      EnableDCBBtns(ItemIndex > -1);
    Enabled := true;
  end;
  PortList.Free;
  LogBtn.Enabled := true;
end;
procedure TForm1.GetAvailableJoyPort(JoyList : TStringList);
{gets the joystick ports - they are available only if a joystick is
plugged in}
var
  Res : DWord;
begin
  LogStr := 'JoyPort' + #13;
  Res :=  JoySetCapture(Self.Handle, JOYSTICKID1, 0, true);
  JoyReleaseCapture(JOYSTICKID1);
  case Res of
    JOYERR NOERROR : begin
                       JoyList.AddObject('Joystick', pointer(true));
                       LogStr := LogStr + '  OK : JOYERR NOERROR' + #13
;
                     end;
    JOYERR PARMS :  LogStr := LogStr + '  Error : JOYERR PARMS' + #13;
    JOYERR NOCANDO :  LogStr := LogStr + '  Error : JOYERR NOCANDO' +
#13;
    JOYERR UNPLUGGED : begin
                         JoyList.AddObject('Joystick', pointer(false));
                         LogStr := LogStr + '  Eror : JOYERR UNPLUGGED'
+ #13;
                       end;
    else LogStr := Format('%s  Unknown Error : %d%s',[LogStr, Res,
#13]);
  end;
end;
procedure TForm1.GetAvailableCommPorts(ComList : TStringList);
{puts the COM ports into a list. available ports have the stringlist
objects
 set to a non-nil value. to be available the ports must be a hardware
port (in
 the registry list comm ports) and have a ProviderSubType of PST RS232}
var
  CommSL : TStringList;
  CommName : string;
  hComm : THandle;
  PtrCommConfig : PCommConfig;
  i, CommConfigSize : integer;
  Available : boolean;
begin
  LogStr := LogStr + 'CommPorts' + #13;
  CommSL := TStringList.Create;
  GetCommNames(CommSL);
  LogStr := Format('%s  %d Different CommPorts Found in Registry%s',
                   [LogStr, CommSL.Count, #13]);
  LogStr := Format('%sOpening Ports as a File%s', [LogStr, #13]);
  {CommSL now contains the list of commports from the registry}
  for i := 0 to CommSL.Count - 1 do begin
    CommName := CommSL.Strings[i]; {Format('COM%d', [i]);}
    Available := false;
    LogStr := LogStr + '    ' + CommName + ' : ';
    {open the port as a file}
    hComm := CreateFile(PChar(CommName), GENERIC READ or GENERIC WRITE,
                        0, nil, OPEN EXISTING,
                        FILE ATTRIBUTE NORMAL, 0);
    if hComm <> INVALID HANDLE VALUE then begin
      {its a useable COM port - check if its an RS232 type}
      CommConfigSize := SizeOf(TCommConfig);
      PtrCommConfig := AllocMem(CommConfigSize);
      if not GetCommConfig(hComm, PtrCommConfig^, CommConfigSize) then
begin
        {not enough memory - get what's needed}
        ReAllocMem(PtrCommConfig, CommConfigSize);
        GetCommConfig(hComm, PtrCommConfig^, CommConfigSize);
      end;
      Available := (PtrCommConfig^.dwProviderSubType = PST RS232);
      if Available then
        LogStr := LogStr + 'PST RS232' + #13
      else
        LogStr := Format('%sdwProviderSubType : %d%s',
                         [LogStr, PtrCommConfig^.dwProviderSubType,
#13]);
      FreeMem(PtrCommConfig);
      end {if hComm <> INVALID HANDLE VALUE}
    else begin
      Available := false;
      LogStr := LogStr + ' Not Available - INVALID HANDLE VALUE' + #13;
    end; {if hComm <> INVALID HANDLE VALUE else}
    CloseHandle(hComm);
    ComList.AddObject(CommName, pointer((Available)))
  end; {for i := 0 to CommSL.Count - 1}
  CommSL.Free;
end;
procedure TForm1.PortComboBoxDrawItem(Control: TWinControl; Index:
Integer;
                                      Rect: TRect; State:
TOwnerDrawState);
{draws items in gray if the Items.Objects[n] is nil, in black if it is
<> nil}
begin
  with PortComboBox do begin
    if not bool(Items.Objects[Index]) then begin
      {item is not available ...}
      Canvas.Brush.Color := clWhite; // ... never indicate as selected
      Canvas.Font.Color := clBtnFace; // ... grey out text
    end;
    {now draw background and text}
    Canvas.FillRect(Rect);
    Canvas.TextOut(Rect.Left, Rect.Top, Items[Index]);
  end;
end;
{
code by: Alan Lloyd, 
alang...@aol.com
}
=========== 
-- 
Morde. 
M-List di icld: 
http://it.groups.yahoo.com/group/icld/

 wrote in message
news:19b3ae829cg6q$.1x8ba6zn0kzij$.dlg@40tude.net...

Basta leggere il registry, l'ho trovato da qualche parte su Torry, fino ad
adesso ha sempre funzionato, ho visto che riesce a riconoscere anche le
porte com create da qualche driver (es. per dispositivi usb)
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;