Get Windows VISTA Product Key

function GetDigitalProductId: TBytes;
const
  cRegPath = 'Software\Microsoft\Windows NT\CurrentVersion';
  cRegKey = 'DigitalProductId';
var
  bufSize: Integer;
  reg: TRegistry;
begin
  result := nil;
  reg := TRegistry.Create(KEY_READ OR KEY_WOW64_64KEY);
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    if reg.OpenKeyReadOnly(cRegPath) then begin
      try
        if reg.ValueExists(cRegKey) then begin
          bufSize := reg.GetDataSize(cRegKey);
          if bufSize > 0 then begin
            SetLength(result, bufSize);
            reg.ReadBinaryData(cRegKey, result[0], bufSize);
          end;
        end;
      finally
        reg.CloseKey;
      end;
    end;
  finally
    reg.Free;
  end;
end;

function GetWindowsCDKey: string;
const
  cChars = 'BCDFGHJKMPQRTVWXY2346789';
var
  tmp: TBytes;
  buffer: TBytes;
  Current: Integer;
  I: Integer;
  N: Integer;
  K: Integer;
begin
  result := '';
  SetLength(tmp, 15);
  buffer := GetDigitalProductId;
  if Length(buffer) > 66 then begin
    for I := 52 to 66 do
      tmp[I - 52] := buffer[I];
    result := '';
    for N := 0 to 24 do begin
      Current := 0;
      for K := Length(tmp) - 1 downto 0 do begin
        Current := (Current * 256) xor tmp[K];
        tmp[k] := (Current div 24) and $FF;
        Current := Current mod 24;
      end;
      Inc(Current);
      result := cChars[Current] + result;
    end;
    for I := (Length(result) - 1) div 5 downto 1 do
      Insert('-', result, 5*I + 1);
  end;
end;

Beispiel :

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