AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Programmieren allgemein Delphi Decode MS Office Product Key
Thema durchsuchen
Ansicht
Themen-Optionen

Decode MS Office Product Key

Ein Thema von danten · begonnen am 21. Jan 2015 · letzter Beitrag vom 22. Jan 2015
 
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
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 04:41 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz