Password-Manager/delphi-backend/Source/PM.MachineId.pas

unit PM.MachineId;

{
  Empreinte de la machine : carte mere + disque systeme.

  Sert a lier une licence a UN poste (PM.Licence). Deux sources, melangees puis
  hachees, dont on ne publie que 16 caracteres hexadecimaux :

  - UUID de la carte mere, lu dans le SMBIOS via Win32_ComputerSystemProduct.
  - Numero de serie du volume systeme (GetVolumeInformation).

  POURQUOI HACHER PLUTOT QUE CONCATENER. L'empreinte se recopie dans un
  courriel pour demander une licence. L'UUID brut de la carte mere est un
  identifiant materiel stable et mondialement unique : il n'a pas a circuler
  en clair, ni a se retrouver dans nos journaux. Le condense suffit a comparer,
  et ne se remonte pas.

  CE QUI LA CHANGE, ET DONC CASSE LA LICENCE : remplacer la carte mere,
  remplacer le disque systeme, reinstaller Windows sur un autre volume, ou
  cloner vers une autre machine. C'est le prix assume du liage — la reparation
  est une reemission, pas un correctif.

  QUAND LE SMBIOS MENT. Beaucoup de machines virtuelles et d'images clonees
  annoncent un UUID nul ou tout a FF. S'en contenter ferait tomber des postes
  differents sur la MEME empreinte, et une licence emise pour l'un ouvrirait
  chez l'autre. On retombe alors sur MachineGuid, pose par Windows a
  l'installation et distinct sur chaque installation.
}

interface

// 16 caracteres hexadecimaux, minuscules. Calcule une fois, puis retenu :
// l'appel WMI coute quelques centaines de millisecondes.
function MachineFingerprint: string;

// La meme, en groupes de quatre — c'est un code qu'un humain recopie a la
// main dans un courriel, et le decoupage divise les fautes de transcription.
function MachineFingerprintDisplay: string;

implementation

uses
  System.SysUtils, System.Win.ComObj, System.Win.Registry, System.Variants,
  Winapi.Windows, Winapi.ActiveX, PM.Crypto;

var
  CachedPrint: string = '';

function BoardUUID: string;
var
  LLocator, LServices, LSet, LItem: OleVariant;
  LEnum: IEnumVariant;
  LFetched: LongWord;
begin
  Result := '';
  try
    LLocator  := CreateOleObject('WbemScripting.SWbemLocator');
    LServices := LLocator.ConnectServer('.', 'root\CIMV2');
    LSet      := LServices.ExecQuery('SELECT UUID FROM Win32_ComputerSystemProduct');
    LEnum     := IUnknown(LSet._NewEnum) as IEnumVariant;
    if LEnum.Next(1, LItem, LFetched) = S_OK then
      if not VarIsNull(LItem.UUID) then
        Result := UpperCase(Trim(string(LItem.UUID)));
  except
    // WMI desactive, service arrete, droits refuses : ce n'est pas une panne,
    // c'est une source en moins. L'appelant retombe sur MachineGuid.
    Result := '';
  end;

  // Un UUID nul ou tout a FF n'identifie rien : il est partage par toutes les
  // machines qui portent le meme defaut de micrologiciel.
  if (Result = '00000000-0000-0000-0000-000000000000') or
     (Result = 'FFFFFFFF-FFFF-FFFF-FFFF-FFFFFFFFFFFF') then
    Result := '';
end;

function MachineGuid: string;
var
  LReg: TRegistry;
begin
  Result := '';
  LReg := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY);
  try
    LReg.RootKey := HKEY_LOCAL_MACHINE;
    if LReg.OpenKeyReadOnly('SOFTWARE\Microsoft\Cryptography') then
      Result := LReg.ReadString('MachineGuid');
  except
    Result := '';
  end;
  LReg.Free;
end;

function SystemVolumeSerial: string;
var
  LRoot: array[0..MAX_PATH] of Char;
  LSerial, LMaxLen, LFlags: DWORD;
begin
  Result := '';
  if GetWindowsDirectory(LRoot, MAX_PATH) = 0 then Exit;
  // "C:\" — la racine du volume qui porte Windows.
  var LDrive := Copy(string(LRoot), 1, 3);
  LSerial := 0;
  if GetVolumeInformation(PChar(LDrive), nil, 0, @LSerial, LMaxLen, LFlags, nil, 0) then
    Result := IntToHex(LSerial, 8);
end;

function MachineFingerprint: string;
var
  LBoard, LVolume, LSeed: string;
begin
  if CachedPrint <> '' then
    Exit(CachedPrint);

  LBoard := BoardUUID;
  if LBoard = '' then
    LBoard := MachineGuid;
  LVolume := SystemVolumeSerial;

  // Les deux sources peuvent manquer sur un poste verrouille a l'extreme.
  // Une empreinte vide serait la MEME partout : mieux vaut une chaine qui ne
  // correspondra a aucune licence qu'une chaine qui les accepterait toutes.
  if (LBoard = '') and (LVolume = '') then
    Exit('unavailable');

  LSeed := 'pmserver/machine/v1|' + LBoard + '|' + LVolume;
  CachedPrint := Copy(PM.Crypto.SHA256Hex(LSeed), 1, 16);
  Result := CachedPrint;
end;

function MachineFingerprintDisplay: string;
var
  LRaw: string;
  I: Integer;
begin
  LRaw   := UpperCase(MachineFingerprint);
  Result := '';
  for I := 1 to Length(LRaw) do
  begin
    if (I > 1) and ((I - 1) mod 4 = 0) then
      Result := Result + '-';
    Result := Result + LRaw[I];
  end;
end;

end.