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:

uses
  ..., Registry;

function GetWinProductKey: 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:

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