Decode MS Office Product Key

[danten]

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;

[Dejan Vu]

What does not work? What do you expect? Shouldn't you know by now how to ask questions?

[danten]

Error: Access violation at address 005A5D3E in module 'key.exe'. Read of address 00000034.
Key Exists in:
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\14.0\ Registration\{90140000-003D-0000-0000-0000000FF1CE}

[Dejan Vu]

Here are some tips:
Turn on Rangechecking as you access arrays.
Use the debugger and step through your code.

You also create memory leaks.

Using the debugger and stepping through your code is an essential technique and way better (and faster) than pasting your code here waiting for someone to do the job for you.

[ASM]

There are two heavy basic mistakes in your code, besides several strong syntactic flaws, which cause failure to resolve the correct ProductKey.

Most importantly:
Since MS Office 10 the algorithm required to calculate the proper ProductKey from DigitalProductID has changed:
Now, calculation within function DecodeProductKey() has to be started beginning at offset $328 (instead beginning at offset $34 that is valid for former Office versions).

Furthermore:
Within your code of function ExtractDigitalPID(), after collecting the Subkeynames by Reg.GetKeyNames(temp), you are using SubKeyName := temp.Strings[0], i.e. you are using implicitly the SubKeyName at fixed Index position 0 of collected Stringlist.
This doesn't consider, however, that the right SubkeyName which will provide the DigitalProductID value required to perform calculation
might not be located at Index position 0 but rather more often than not it will be located somewhere between Index 0 and Index no. temp.count-1.
Thus, you have to search your collection of SubKeynames through all indices until finding the right one presenting the value name 'DigitalProductID'.

Comment added to make it more clearly:
MS Office 10 refers to Office 2010 = version 14.0

I'm sorry for any misinterpretation likely to have occured.