Function GetKey(rpk:pByteArray):string; //вместо pByteArray можно юзать дин.массив TByteDynArray из types.pas

Const

 rpkOffset = 52;

 szPossibleChars:string = 'BCDFGHJKMPQRTVWXY2346789';

var

  i,j,n,dwAccumulator:integer;

begin

  Result:='';

  n:=Length(szPossibleChars); //=24

  dwAccumulator:=0;

  i:=28;

  while i >= 0 do

  begin

    for j:=14 downto 0 do

    begin

      dwAccumulator:=dwAccumulator*256+rpk[j+rpkOffset];

      rpk[j+rpkOffset]:=(dwAccumulator div n) and 255;

      dwAccumulator:=dwAccumulator mod n;

    end;

    Result:=szPossibleChars[dwAccumulator+1]+Result;

    dec(i);  

    if (i >= 0) and ((29-i) Mod 6) = 0) then

    begin

      Result:='-'+Result;

      dec(i);

    end;

  end;  

end;

'---xp-viewkey.vbs---

' by PaulD

Set WshShell = WScript.CreateObject("WScript.Shell")

strDigitalProductId="HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"

strOffXPRU="HKLM\SOFTWARE\Microsoft\Office.0\Registration\{91110419-6000-11D3-8CFE-0050048383C9}\DigitalProductId"

 

strXPKey=GetKey(WshShell.RegRead(strDigitalProductId))

'strOffXPRUKey=GetKey(WshShell.RegRead(strOffXPRU))

 

'CopytoClipboard

set ie=CreateObject("internetExplorer.application")

ie.navigate "about:blank"

do until ie.readystate=4: wscript.sleep 1: loop

ie.document.parentwindow.clipboardData.setData "Text", strXPKey

 

 

MsgBox "WinXP:"&strXPKey&chr(13)&_

"key in clipboard"

' "OffXP:"&strOffXPRUKey

 

Function GetKey(rpk)

 

Const rpkOffset=52:i=28

szPossibleChars="BCDFGHJKMPQRTVWXY2346789"

 

Do 'Rep1

dwAccumulator=0 : j=14

Do

dwAccumulator=dwAccumulator*256

dwAccumulator=rpk(j+rpkOffset)+dwAccumulator

rpk(j+rpkOffset)=(dwAccumulator) and 255

dwAccumulator=dwAccumulator Mod 24

j=j-1

Loop While j>=0

i=i-1 : szProductKey=mid(szPossibleChars,dwAccumulator+1,1)&szProductKey

if (((29-i) Mod 6)=0) and (i<>-1) then

i=i-1 : szProductKey="-"&szProductKey

End If

Loop While i>=0 'Goto Rep1

 

GetKey=szProductKey

End Function