Get Windows 7 (8/8.1) Product Key

function GetWinProductKey: string;
const
  KeyOffset    = 52;
  Symbols      = 'BCDFGHJKMPQRTVWXY2346789';
  SymbolCount  = Length(Symbols);  // = 24
  RegKeyName   = 'SOFTWARE\Microsoft\Windows NT\CurrentVersion';
  RegValueName = 'DigitalProductID';
  // KEY_WOW64_64KEY = $0100;
  SRegOpenErrMsg = 'Error while opening registry key "%s":'#10'%s';
  SRegValueExistErrMsg = 'Registry value "%s" does not exist';
  SRegValueSizeErrMsg = 'Registry value "%s" is too small (%d bytes)';
var
  Reg: TRegistry;
  AAccess: Longword;
  DigitalProductID: array of Byte; // TBytes
  Decoded: string;
  i, j, x: Integer;
  IsWin8: Boolean;
begin
  AAccess := KEY_READ;
  // on a 64 bit OS, make sure to read the 64 bit version of the registry key
  if TOSVersion.Architecture = arIntelX64 then
    AAccess := AAccess or KEY_WOW64_64KEY;

  Reg := TRegistry.Create(AAccess);
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if not Reg.OpenKey(RegKeyName, FALSE) then
      raise Exception.CreateFmt(SRegOpenErrMsg, [RegKeyName, Reg.LastErrorMsg]);
    if not Reg.ValueExists(RegValueName) then
      raise Exception.CreateFmt(SRegValueExistErrMsg, [RegValueName]);
    i := Reg.GetDataSize(RegValueName);
    if (i >= 67) then
    begin
      SetLength(DigitalProductID, i);
      Reg.ReadBinaryData(RegValueName, DigitalProductID[0], i);
      // Windows 8 requires a tweak
      x := 66;
      IsWin8 := Odd(DigitalProductID[x] div 6);
      if IsWin8 then
        DigitalProductID[x] := DigitalProductID[x] and $F7;
      // decode
      SetLength(Decoded, 25);
      for i := High(Decoded) downto Low(Decoded) do
      begin
        x := 0;
        for j := 14 downto 0 do
        begin
          x := (x shl 8) + DigitalProductID[KeyOffset + j];
          DigitalProductID[KeyOffset + j] := x div SymbolCount;
          x := x mod SymbolCount;
        end;
        Decoded[i] := Symbols[Low(Symbols) + x];
      end;
      if IsWin8 then
        // discard the first symbol and insert an "N" somewhere in the middle
        Decoded := Copy(Decoded, 2, x) + 'N' + Copy(Decoded, 2 + x, MaxInt);
      // produce final output, separated with "-"
      for i := 0 to 4 do
      begin
        if i > 0 then Result := Result + '-';
        Result := Result + Copy(Decoded, 1 + i * 5, 5);
      end;
    end
    else
      raise Exception.CreateFmt(SRegValueSizeErrMsg, [RegValueName, i]);
  finally
    Reg.Free;
  end;
end;

Beispiel :

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.Text := GetWinProductKey
end;