Einzelnen Beitrag anzeigen

danten

Registriert seit: 19. Feb 2012
Ort: Czech Republic, Prag
126 Beiträge
 
Delphi 10.1 Berlin Architect
 
#1

Decode MS Office Product Key

  Alt 21. Jan 2015, 10:26
Hello everyone, why me this code does not work?
Windows 7 32bit and Windows 7 64bit

Delphi-Quellcode:
function DecodeProductKey(const HexSrc: array of Byte): string;
const
  StartOffset: Integer = $34;
  EndOffset: Integer = $34 + 15;
  Digits: array[0..23] of CHAR = ('B', 'C', 'D', 'F', 'G', 'H', 'J',
    'K', 'M', 'P', 'Q', 'R', 'T', 'V', 'W', 'X', 'Y', '2', '3', '4', '6', '7', '8', '9');
  dLen: Integer = 29;
  sLen: Integer = 15;
var
  HexDigitalPID: array of CARDINAL;
  Des: array of CHAR;
  I, N: INTEGER;
  HN, Value: CARDINAL;
begin
  SetLength(HexDigitalPID, dLen);
  for I := StartOffset to EndOffset do
  begin
    HexDigitalPID[I - StartOffSet] := HexSrc[I];
  end;

  SetLength(Des, dLen + 1);

  for I := dLen - 1 downto 0 do
  begin
    if (((I + 1) mod 6) = 0) then
    begin
      Des[I] := '-';
    end
    else
    begin
      HN := 0;
      for N := sLen - 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;
  end;
  Des[dLen] := Chr(0);

  for I := 0 to Length(Des) do
  begin
    Result := Result + Des[I];
  end;
end;


function IS_OFFICE2010_Installed: Boolean;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Result := Reg.KeyExists('SOFTWARE\MICROSOFT\Office\14.0\Registration');
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
  DN := '';
  PID := '';
end;

function View_Office2010_Key: string;
begin
  try
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    KeyName := 'SOFTWARE\MICROSOFT\Office\14.0\Registration\';
    Reg.OpenKeyReadOnly(KeyName);
    temp := TStringList.Create;
    Reg.GetKeyNames(temp);
    Reg.CloseKey;
    SubKeyName := temp.Strings[0];
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    KeyName2 := 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\';
    Reg.OpenKeyReadOnly(KeyName2 + SubKeyName);
    DN := (Reg.ReadString('DisplayName'));
    Reg.CloseKey;
  except
    on E: EStringListError do
      Exit
  end;
  try
    if Reg.OpenKeyReadOnly(KeyName + SubKeyName) then
    begin
      if Reg.GetDataType('DigitalProductId') = rdBinary then
      begin
        PID := (Reg.ReadString('ProductID'));
        binarySize := Reg.GetDataSize('DigitalProductId');
        SetLength(HexBuf, binarySize);
        if binarySize > 0 then
        begin
          Reg.ReadBinaryData('DigitalProductId', HexBuf[0], binarySize);
        end;
      end;
    end;
  finally
    FreeAndNil(Reg);
  end;

  Result := '';
  Result := DecodeProductKey(HexBuf);
end;

procedure Tfrm_main.Buuton1Click(Sender: TObject);
begin
  ShowMessage(View_Office2010_Key);
end;
Daniel

Geändert von danten (21. Jan 2015 um 10:37 Uhr)
  Mit Zitat antworten Zitat