Delphi par l'exemple

 

Retour accueil

Partie 1 : affichage des ports série de l'ordinateur Partie 2 Partie 3

 

Pour cet exercice, il n'y a qu'un élément de type TComboBox sur la fiche.

Code source de l'unité :

unit u_portcom;
interface
uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
  TForm1 = class(TForm)
    ListeCom: TComboBox;
    procedure FormCreate(Sender: TObject);
private
  { Déclarations privées }
public
  { Déclarations publiques }
end;
var
  Form1: TForm1;
function CherchePort(Nomport:string):TStrings; implementation
{$R *.DFM} {---------------------------------------------------------------------------}
{ Cette fonction explore la base de registre à la recherche des ports série }
{ disponibles de l'ordinateur.                                    }
{ avant: rien                                           }
{ après: retour de la liste des ports série sous forme de TSrings         }
{ documentation : }
{ http://www.delphifr.com/codes/RECHERCHE-AUTOMATIQUE-PORT-SERIE_34072.aspx } { auteur : graccus } { première implémentation : 07 avril 2007 } { dernière modification : }
{---------------------------------------------------------------------------}
function CherchePort(Nomport:string): 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
    raise Exception.Create('erreur d''ouverture');
  TmpPorts := TStringList.Create;
  Index := 0;
  repeat
    ValueLen := 256;
    DataLen := 256;
    SetLength(ValueName, ValueLen);
    SetLength(Data, DataLen);
ErrCode := RegEnumValue(KeyHandle, Index, PChar(ValueName),
{$IFDEF DELPHI_4_OR_HIGHER} // directive de compilation
Cardinal(ValueLen), // si on utilise une version de Delphi 4 ou
{$ELSE} // supérieure ValueLen est de type Cardinal
ValueLen, // sinon ValueLen est de type DWord
{$ENDIF}
nil, @ValueType, PByte(PChar(Data)), @DataLen);
if ErrCode = ERROR_SUCCESS then begin
TmpPorts.Add('COM' + IntToStr(Index + 1)); // ajout du nouveau port à la
Inc(Index) // liste end; until (ErrCode <> ERROR_SUCCESS);
RegCloseKey(KeyHandle);
Result := TmpPorts
end;
{ la fonction est appelée dès la création de la fiche } procedure TForm1.FormCreate(Sender: TObject);
begin ListeCom.Items := CherchePort('') end;
end.

Fichier source portcom.zip

Retour accueil Partie 2 Partie 3