Логин:     Забыли пароль?
 
Пароль:   Регистрация

Форум / Программирование - Перевод кода с VBS на Delphi  

Перевод кода с VBS на Delphi

AlekVolsk
AlekVolsk
Посетитель
Сообщения: 1
[Сообщение #1] 8 апреля 2013, 10:40
Доброго времени суток.
Есть код, ковыряющий из реестра ключ продукта Windows и MS Office. Delphi XE3 x86/x64.
Кому надо, делюсь (на входе - значение, выковырянное из реестра):

function DecodeMSKey(const HexSrc: array of byte): string;
const
  StartOffset: integer = $34;
  EndOffset: integer = $43;
  Digits: array[0..23] of char = 'BCDFGHJKMPQRTVWXY2346789';
  DecodedLen: integer = 29;
  EncodedLen: integer = 15;
var
  HexDigitalPID: array of cardinal;
  Des: array[0..30] of char;
  I, N: integer;
  Value, HN: cardinal;
begin
  Result := '';
  SetLength(HexDigitalPID, DecodedLen);
  for I := StartOffset to EndOffset do
    HexDigitalPID[I - StartOffSet] := HexSrc[I];
  for I := DecodedLen - 1 downto 0 do
    if (((I + 1) mod 6) = 0) then
      Des[I] := '-'
    else begin
      HN := 0;
      for N := EncodedLen - 1 downto 0 do begin
        Value := (HN shl 8) or HexDigitalPID[N];
        HexDigitalPID[N] := Value div 24;
        HN := Value mod 24;
      end;
      Des[I] := Digits[HN];
    end;
  Des[DecodedLen] := Chr(0);
  Result := StrPas(Des);
end;

Этот код прекрасно справлялся с W2K по W7/W2K8, в т.ч. с x64.
Однако, в W8/W2K12/MSO2013 методику шифрования несколько изменили, или этот код более под новыми системами не работает.
Нашел vbs-скрипт, корректно ковыряющий ключ windows x86/x64 (с офисом не прокатило), который я попробовал перевести на delphi, но delphi-код с x86-системами он справляется на ура, а на x64 выдает полную белиберду, с офисом не справляется вообще ни с каким.

Соб-но, вопрос: что я при переводе кода с vbs на delphi перепутал/сделал не так?

vbs-исходник:

Function ConvertToKey(regKey)
    Const KeyOffset = 52
    isWin8 = (regKey(66) \ 6) And 1
    regKey(66) = (regKey(66) And &HF7) Or ((isWin8 And 2) * 4)
    j = 24
    Chars = "BCDFGHJKMPQRTVWXY2346789"
    Do
        Cur = 0
        y = 14
        Do
            Cur = Cur * 256
            Cur = regKey(y + KeyOffset) + Cur
            regKey(y + KeyOffset) = (Cur \ 24)
            Cur = Cur Mod 24
            y = y - 1
        Loop While y >= 0
        j = j -1
        winKeyOutput = Mid(Chars, Cur + 1, 1) & winKeyOutput
        Last = Cur
    Loop While j >= 0
    If (isWin8 = 1) Then
        keypart1 = Mid(winKeyOutput, 2, Last)
        insert = "N"
        winKeyOutput = Replace(winKeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
        If Last = 0 Then winKeyOutput = insert & winKeyOutput
    End If
    a = Mid(winKeyOutput, 1, 5)
    b = Mid(winKeyOutput, 6, 5)
    c = Mid(winKeyOutput, 11, 5)
    d = Mid(winKeyOutput, 16, 5)
    e = Mid(winKeyOutput, 21, 5)
    ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e
End Function

переведенный код:

function DecodeMSKeyNew(const HexSrc: array of byte): string;
const
  StartOffset: integer = 52;
  EndOffset:  integer = 67;
  Digits: array[0..23] of char = 'BCDFGHJKMPQRTVWXY2346789';
var
  HexDigitalPID: array of cardinal;
  N, isw8, cur, y, j, i, k: integer;
begin
  Result := '';
  isw8 := (HexSrc[66] div 6) and 1;
  SetLength(HexDigitalPID, EndOffset);
  for i := 0 to 66 do
    HexDigitalPID[i] := HexSrc[i];
  if isw8 = 1 then
    HexDigitalPID[66] := (HexSrc[66] And $F7) Or ((isW8 And 2) * 4);
  j := 24;
  while j >= 0 do begin
    cur := 0;
    y := 14;
    while y >= 0 do begin
      i := StartOffset + y;
      k := HexDigitalPID[i];
      cur := cur * 256;
      cur := cur + k;
      HexDigitalPID[i] := cur div 24;
      cur := cur mod 24;
      y := y - 1;
    end;
    Result :=  copy(Digits, cur + 1, 1) + Result;
    N := cur;
    j := j - 1;
  end;
  if isw8 = 1 then begin
    Result := copy(Result, 2, length(Result));
    insert('N', Result, 3);
    if N = 0 then
      Result := 'N' + Result;
  end;
  insert('-', Result, 21);
  insert('-', Result, 16);
  insert('-', Result, 11);
  insert('-', Result, 6);
end;


Буду рад любому совету/помощи/подсказкам, 2 недели уже мучаюсь.


Всего сообщений: 1 (сейчас показаны: с 1 по 1)

Перейти в раздел:


 © 2004 - 2017, Delphi.int.ru
Версия форума: 1.10 (19.01.2010)
RSS Delphi.int.ru Expert Код
Выполнено за 0.19 сек.
Обратная связь  
Рейтинг@Mail.ru Majordomo.ru - надёжный хостинг