1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:

#include <iostream>
#include <windows.h>

int main () {
    //Zeichenvorrat Buchstaben,Ziffern ohne AEIOU01 (24)
    UCHAR digits[] = {'B','C','D','F','G','H','J','K','M','P','Q','R','T','V','W','X','Y','2','3','4','6','7','8','9'};
    PUCHAR strresult = new UCHAR[26];
    PUCHAR buf = new UCHAR[200];
   
    HKEY key = NULL;
    DWORD datasize = 200;
    DWORD dwRet = 0;

    ZeroMemory((PVOID)strresult,26);

    dwRet = RegOpenKeyEx(HKEY_LOCAL_MACHINE,"SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion",0,KEY_READ,&key);                      
    dwRet = RegQueryValueEx(key,"DigitalProductID",NULL,NULL,(LPBYTE)buf,&datasize);
   
    if (dwRet != ERROR_SUCCESS) {
        return -1;
    }
   
    RegCloseKey(key);

    for (int i=24;i>=0;i--) {
        int x=0;

        for (int j=14;j>=0;j--) {
            x = (x<<8) + (buf+0x34)[j];
            (buf+0x34)[j] = x / 24;
            x = x % 24;
        }
        strresult[i]=digits[x];
    }
   
    std::cout << strresult;
   
    std::cin.get();
    return 0;
}                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:

function GetWinProductID: String;
  const
    Digits = 'BCDFGHJKMPQRTVWXY2346789';
  var
    Reg: TRegistry;
    Value: String;
    i,j,x: Integer;
begin
  Result := '';
  Reg := TRegistry.Create(KEY_READ);
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey('SOFTWARE\Microsoft\Windows NT\CurrentVersion',FALSE);
    SetLength(Value,Reg.GetDataSize('DigitalProductID'));
    if (Length(Value) >= 67) then begin
      Reg.ReadBinaryData('DigitalProductID',Value[1],Length(Value));
      for i := 24 downto 0 do begin
        x := 0;
        for j := 14 downto 0 do begin
          x := (x shl 8) +Ord(Value[53+j]);
          Value[53+j] := Char(x div 24);
          x := x mod 24;
        end;
        Result := Digits[x+1] +Result;
        if ( (i > 0) and ((i mod 5) = 0) ) then
          Result := '-' +Result;
      end;
    end;
  finally
    Reg.Free;
  end;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:

// Get Windows product key, adapted by SMO from open source examples
// tested on Windows 7 and 8.1
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;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:

function IsWow64Process: Boolean;
type
  TIsWow64Process = function(hProcess: THandle; var Wow64Process: BOOL): BOOL; stdcall;
// const kernel32 = 'kernel32.dll'; // defined in Winapi.Windows
var
  LIsWow64Process: TIsWow64Process;
  Wow64Process: BOOL;
begin
  Result := False;
  LIsWow64Process := GetProcAddress(GetModuleHandle(kernel32), 'IsWow64Process');
  if Assigned(LIsWow64Process) then
  begin
    if not LIsWow64Process(GetCurrentProcess, Wow64Process) then
      raise Exception.Create('Invalid handle');
    Result := Wow64Process;
  end;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:

// Get Windows product key, adapted by SMO from open source examples
// tested on Windows 7 and 8.1
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 not LIsWow64Process(GetCurrentProcess, Wow64Process) then
      raise Exception.Create('Invalid handle');
    Result := Wow64Process;
  end;

  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
      for i := 24 downto 0 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 := Symbols[Low(Symbols) + x] + Decoded;
      end;
      if IsWin8 then
        // discard the first symbol and insert an "N" somewhere in the middle
        Decoded := Copy(Decoded, 2, x) + 'N' + Copy(Decoded, 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;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

function GetWinProductKey: string;
const
// ...
  SymbolCount = 24;
  KEY_WOW64_64KEY = $0100; 
// ...
begin
// ...
  if IsWow64Process then
    AAccess := AAccess or KEY_WOW64_64KEY;
// ...
    for i := Length(Decoded) downto 1 do
    begin
// ...
      Decoded[i] := Symbols[1 + x];
// ...                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:

program WIN8_Info;

{$APPTYPE CONSOLE}

uses
{$if CompilerVersion < 21}
  SysUtils,
  Registry;
{$endif}
{$if CompilerVersion > 20}
  System.SysUtils,
  System.Win.Registry;
{$endif}

const KEY_WOW64_64KEY = 256; KEY_READ = 131097; HKEY_LOCAL_MACHINE = $80000002;


function BinToInt(Value: String): Integer;
var i, vSize: Integer;
begin
  Result := 0; vSize := Length(Value);
  for i := vSize downTo 1 do
    if Value[i] = '1' then begin Result := Result + (1 shl (vSize - i)); end;
end;

function DecodeProductKey8(Const HexSrc: Array Of Byte): String;
Const
  StarToffset: Integer = $34;
  EndOffset: Integer = $34 + 17;
  Digits: Array[0..23] of Char =
  ('B','C','D','F','G','H','J','K','M','P','Q','R','T','V','W','X','Y','2','3','4','6','7','8','9');
  dLen: Integer = 29;
  KeyOffset :Integer = 52 ;
var
  Key  : Array Of Cardinal;
  Cur, X, I, K, Last : Integer;
  T    : String;
begin
  I := 24;
  SetLength(Key, dLen);
    for K := StarToffset To EndOffset do begin Key[K - StarToffSet] := HexSrc[K]; end;
  Key[14] := BinToInt(IntToStr(Key[14]));
    repeat
      Cur := 0; X := 14;
        repeat
          Cur := Cur * 256 ;
          Cur := (Key[X]) + Cur;
          Key[X] := Cur div 24 ;
          Cur := Cur Mod 24;
          X := X - 1;
        until X < 0;
      I := I - 1;
      Last := Cur;
      T := Digits[Cur] + T ;
    until I < 0;
  T :=  Copy(T,2,25);
  Insert('N', T, Last + 1);
    For X := 1 To 4 do begin Insert('-', T, X*6); end;
  Result := T;
end;

function View_Win8_Key: string;
var Reg: TRegistry;  HexBuf: array of BYTE; binarySize: INTEGER; PN,PID,DN: string;
begin
  Reg := TRegistry.Create(KEY_READ OR KEY_WOW64_64KEY);
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKeyReadOnly('\SOFTWARE\Microsoft\Windows NT\CurrentVersion') then
    begin
      if Reg.GetDataType('DigitalProductId') = rdBinary then
      begin
        PN         := (Reg.ReadString('ProductName'));
        PID        := (Reg.ReadString('ProductID'));
        binarySize := Reg.GetDataSize('DigitalProductId');
        SetLength(HexBuf, binarySize);
        if binarySize > 0 then
        begin Reg.ReadBinaryData('DigitalProductId', HexBuf[0], binarySize); end;
      end;
    end;
  finally FreeAndNil(Reg); end;
  Result := ''; Result := DecodeProductKey8(HexBuf);
end;

//[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion]
function GetWinProductID: String;
var Reg: TRegistry;
begin
  Reg := TRegistry.Create(KEY_READ OR KEY_WOW64_64KEY);
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows NT\CurrentVersion');
    Result := Reg.ReadString('ProductID');
  finally Reg.Free; end;
end;

begin
      WriteLn('ProductID: '+GetWinProductID);
      WriteLn('Key: '+View_Win8_Key);
      Writeln; Writeln('Press Enter to exit'); Readln;
end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:

{$APPTYPE CONSOLE}

uses
{$if CompilerVersion < 21}
  Windows,
  SysUtils,
  ActiveX,
  ComObj,
  Variants,
  Registry,
  Classes;
{$endif}
{$if CompilerVersion > 20}
  Winapi.Windows,
  System.SysUtils,
  Winapi.ActiveX,
  System.Win.ComObj,
  System.Variants,
  System.Win.Registry,
  System.Classes;
{$endif}                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:

Set WshShell = CreateObject("WScript.Shell")
Key = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
DigitalID = WshShell.RegRead(key & "DigitalProductId")

ProductName = "Product Name: " & WshShell.RegRead(Key & "ProductName") & vbNewLine
ProductID = "Product ID: " & WshShell.RegRead(Key & "ProductID") & vbNewLine
ProductKey = "Installed Key: " & ConvertToKey(DigitalID)
ProductID = ProductName & ProductID & ProductKey

If vbYes = MsgBox(ProductId & vblf & vblf & "Save to a file?", vbYesNo + vbQuestion, "Windows Key Information") then
   Save ProductID
End if

Function ConvertToKey(Key)
    Const KeyOffset = 52
    isWin8 = (Key(66) \ 6) And 1
    Key(66) = (Key(66) And &HF7) Or ((isWin8 And 2) * 4)
    i = 24
    Chars = "BCDFGHJKMPQRTVWXY2346789"
    Do
        Cur = 0
        X = 14
        Do
            Cur = Cur * 256
            Cur = Key(X + KeyOffset) + Cur
            Key(X + KeyOffset) = (Cur \ 24)
            Cur = Cur Mod 24
            X = X -1
        Loop While X >= 0
        i = i -1
        KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
        Last = Cur
    Loop While i >= 0
    If (isWin8 = 1) Then
        keypart1 = Mid(KeyOutput, 2, Last)
        insert = "N"
        KeyOutput = Replace(KeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
        If Last = 0 Then KeyOutput = insert & KeyOutput
    End If
    a = Mid(KeyOutput, 1, 5)
    b = Mid(KeyOutput, 6, 5)
    c = Mid(KeyOutput, 11, 5)
    d = Mid(KeyOutput, 16, 5)
    e = Mid(KeyOutput, 21, 5)
    ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e
End Function

Function Save(Data)
    Const ForWRITING = 2
    Const asASCII = 0
    Dim fso, f, fName, ts
    fName = "Windows Key.txt"
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CreateTextFile fName
    Set f = fso.GetFile(fName)
    Set f = f.OpenAsTextStream(ForWRITING, asASCII)
    f.Writeline Data
    f.Close
End Function                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:

Set WshShell = CreateObject("WScript.Shell")
MsgBox ConvertToKey(WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))

Function ConvertToKey(Key)
Const KeyOffset = 52
i = 28
Chars = "BCDFGHJKMPQRTVWXY2346789"
Do
Cur = 0
x = 14
Do
Cur = Cur * 256
Cur = Key(x + KeyOffset) + Cur
Key(x + KeyOffset) = (Cur \ 24) And 255
Cur = Cur Mod 24
x = x -1
Loop While x >= 0
i = i -1
KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
If (((29 - i) Mod 6) = 0) And (i <> -1) Then
i = i -1
KeyOutput = "-" & KeyOutput
End If
Loop While i >= 0
ConvertToKey = KeyOutput
End Function                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:

Set WshShell = CreateObject("WScript.Shell")
MsgBox ConvertToKey(WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))

Function ConvertToKey(Key)
    Const KeyOffset = 52
    isWin8 = (Key(66) \ 6) And 1
    Key(66) = (Key(66) And &HF7) Or ((isWin8 And 2) * 4)
    i = 24
    Chars = "BCDFGHJKMPQRTVWXY2346789"
    Do
        Cur = 0
        X = 14
        Do
            Cur = Cur * 256
            Cur = Key(X + KeyOffset) + Cur
            Key(X + KeyOffset) = (Cur \ 24)
            Cur = Cur Mod 24
            X = X -1
        Loop While X >= 0
        i = i -1
        KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
        Last = Cur
    Loop While i >= 0
    If (isWin8 = 1) Then
        keypart1 = Mid(KeyOutput, 2, Last)
        insert = "N"
        KeyOutput = Replace(KeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
        If Last = 0 Then KeyOutput = insert & KeyOutput
    End If
    a = Mid(KeyOutput, 1, 5)
    b = Mid(KeyOutput, 6, 5)
    c = Mid(KeyOutput, 11, 5)
    d = Mid(KeyOutput, 16, 5)
    e = Mid(KeyOutput, 21, 5)
    ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e
End Function