Registriert seit: 19. Feb 2012
Ort: Czech Republic, Prag
126 Beiträge
Delphi 10.1 Berlin Architect
|
Decode MS Office Product Key
21. Jan 2015, 11: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 11:37 Uhr)
|
|
Zitat
|