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.
|