как расшифровать ключ DigitalProductId

[jon007]

Здравствуйте. Есть скрипт написанный на vbs, у меня не получается его перевести на delphi, помогите пожалуйста.

'---xp-viewkey.vbs---
' by PaulD
Set WshShell = WScript.CreateObject("WScript.Shell")
strDigitalProductId="HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"
strOffXPRU="HKLM\SOFTWARE\Microsoft\Office\10.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\24) 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

нужна функция Function GetKey(rpk). Спасибо.

Сообщение отредактировано: jon007 - 21.10.09, 08:39

[leo]

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;

Сообщение отредактировано: leo - 21.10.09, 11:33

[jon007]

Спасибо Master буду пробовать.

Добавлено 21.10.09, 11:54
Делаю так

Buf: pBytearray;
reg.ReadBinaryData('DigitalProductId', buf[0], reg.GetDataSize('DigitalProductId'));
Form1.ListView1.Items[13].SubItems.Strings[0]:= GetKey(buf);

вроде всё работает, а после выполнения всего кода вываливается ошибка, что программа обратилась не потому адресу, не пойму что не так.

[CodeMonkey]

Оцпию Range Check Errors включите и сделайте Build.

[jon007]

Исправил Buf: pBytearray; на Buf: Array of byte в обоих местах и ошибка пропала. Ещё раз спасибо за помощь.

Добавлено 21.10.09, 12:00
Забыл отметить что вопрос решён.

[Aqel]

На Delphi XE 8 не работает.