На главную
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! ПРАВИЛА РАЗДЕЛА · FAQ раздела Delphi · Книги по Delphi
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как прочитать список файлов, поддиректорий в директории?
5. Как запустить программу/файл?
... (продолжение следует) ...

Вопросы, подробно описанные во встроенной справочной системе Delphi, не несут полезной тематической нагрузки, поэтому будут удаляться.
Запрещается создавать темы с просьбой выполнить какую-то работу за автора темы. Форум является средством общения и общего поиска решения. Вашу работу за Вас никто выполнять не будет.


Внимание
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...
Модераторы: jack128, D[u]fa, Shaggy, Rouse_
  
> как расшифровать ключ DigitalProductId
    Здравствуйте. Есть скрипт написанный на vbs, у меня не получается его перевести на delphi, помогите пожалуйста.
    ExpandedWrap disabled
      '---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 -
    Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru
      ExpandedWrap disabled
        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 -
        Спасибо Master буду пробовать.

        Добавлено
        Делаю так
        ExpandedWrap disabled
          Buf: pBytearray;
          reg.ReadBinaryData('DigitalProductId', buf[0], reg.GetDataSize('DigitalProductId'));
          Form1.ListView1.Items[13].SubItems.Strings[0]:= GetKey(buf);
        вроде всё работает, а после выполнения всего кода вываливается ошибка, что программа обратилась не потому адресу, не пойму что не так.
        Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru
          Оцпию Range Check Errors включите и сделайте Build.
          Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.
            Исправил Buf: pBytearray; на Buf: Array of byte в обоих местах и ошибка пропала. Ещё раз спасибо за помощь.

            Добавлено
            Забыл отметить что вопрос решён.
            Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru
              На Delphi XE 8 не работает.
              Подпись выключена.
              0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
              0 пользователей:


              Рейтинг@Mail.ru
              [ Script Execution time: 0,0974 ]   [ 18 queries used ]   [ Generated: 13.07.20, 02:02 GMT ]