Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.144.84.155] |
|
Сообщ.
#1
,
|
|
|
Здравствуйте. Есть скрипт написанный на 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 |
Сообщ.
#2
,
|
|
|
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; |
Сообщ.
#3
,
|
|
|
Спасибо Master буду пробовать.
Добавлено Делаю так Buf: pBytearray; reg.ReadBinaryData('DigitalProductId', buf[0], reg.GetDataSize('DigitalProductId')); Form1.ListView1.Items[13].SubItems.Strings[0]:= GetKey(buf); |
Сообщ.
#4
,
|
|
|
Оцпию Range Check Errors включите и сделайте Build.
|
Сообщ.
#5
,
|
|
|
Исправил Buf: pBytearray; на Buf: Array of byte в обоих местах и ошибка пропала. Ещё раз спасибо за помощь.
Добавлено Забыл отметить что вопрос решён. |
Сообщ.
#6
,
|
|
|
На Delphi XE 8 не работает.
|