Microsoft Product Key Viewer (Delphi 5-7)
UNIT MSProdKey;
{
**************************************************************************************
* Unit MSProdKey v2.2 *
* *
* Description: Decode and View the Product Key, Product ID and Product Name used to *
* install: Windows 2000, XP, Server 2003, Office XP, 2003. *
* *Updated* Now works for users with Non-Administrative Rights. *
* Code cleanup and changes, Commented. *
* *
* Usage: Add MSProdKey to your Application's uses clause. *
* *
* Example 1: *
* *
* procedure TForm1.Button1Click(Sender: TObject); *
* begin *
* if not IS_WinVerMin2K then // If the Windows version isn't at least Windows 2000 *
* Edit1.Text := 'Windows 2000 or Higher Required!' // Display this message *
* else // If the Windows version is at least Windows 2000 *
* Edit1.Text := View_Win_Key; // View the Windows Product Key *
* Label1.Caption := PN; // View the Windows Product Name *
* Label2.Caption := PID; // View the Windows Product ID *
* end; *
* *
* Example 2: *
* procedure TForm1.Button2Click(Sender: TObject); *
* begin *
* if not IS_OXP_Installed then // If Office XP isn't installed *
* Edit1.Text := 'Office XP Required!' // Display this message *
* else // If Office XP is installed *
* Edit1.Text := View_OXP_Key; // View the Office XP Product Key *
* Label1.Caption := DN; // View the Office XP Product Name *
* Label2.Caption := PID; // View the Office XP Product ID *
* end; *
* *
* Example 3: *
* procedure TForm1.Button3Click(Sender: TObject); *
* begin *
* if not IS_O2K3_Installed then // If Office 2003 isn't installed *
* Edit1.Text := 'Office 2003 Required!' // Display this message *
* else // If Office 2003 is installed *
* Edit1.Text := View_O2K3_Key; // View the Office 2003 Product Key *
* Label1.Caption := DN; // View the Office 2003 Product Name *
* Label2.Caption := PID; // View the Office 2003 Product ID *
* end; *
* *
* Copyright © 2004 Chuck D *
**************************************************************************************
}
INTERFACE
USES Registry, Windows, SysUtils, Classes;
FUNCTION IS_WinVerMin2K: BOOLEAN; // Check OS for Win 2000 or higher
FUNCTION View_Win_Key: STRING; // View the Windows Product Key
FUNCTION IS_OXP_Installed: BOOLEAN; // Check if Office XP is installed
FUNCTION View_OXP_Key: STRING; // View the Office XP Product Key
FUNCTION IS_O2K3_Installed: BOOLEAN; // Check if Office 2003 is installed
FUNCTION View_O2K3_Key: STRING; // View the Office 2003 Product Key
FUNCTION DecodeProductKey(CONST HexSrc: ARRAY OF BYTE): STRING; // Decodes the Product Key(s) from the Registry
VAR
Reg: TRegistry;
binarySize: INTEGER;
HexBuf: ARRAY OF BYTE;
temp: TStringlist;
KeyName, KeyName2, SubKeyName, PN, PID, DN: STRING;
IMPLEMENTATION
FUNCTION IS_WinVerMin2K: BOOLEAN;
VAR
OS: TOSVersionInfo;
BEGIN
ZeroMemory(@OS, SizeOf(OS));
OS.dwOSVersionInfoSize := SizeOf(OS);
GetVersionEx(OS);
Result := (OS.dwMajorVersion >= 5) AND
(OS.dwPlatformId = VER_PLATFORM_WIN32_NT);
PN := ''; // Holds the Windows Product Name
PID := ''; // Holds the Windows Product ID
END;
FUNCTION View_Win_Key: STRING;
BEGIN
Reg := TRegistry.Create;
TRY
Reg.RootKey := HKEY_LOCAL_MACHINE;
IF Reg.OpenKeyReadOnly('\SOFTWARE\Microsoft\Windows NT\CurrentVersion') THEN
BEGIN
IF Reg.GetDataType('DigitalProductId') = rdBinary THEN
BEGIN
PN := (Reg.ReadString('ProductName'));
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;
FUNCTION IS_OXP_Installed: BOOLEAN;
VAR
Reg: TRegistry;
BEGIN
Reg := TRegistry.Create;
TRY
Reg.RootKey := HKEY_LOCAL_MACHINE;
Result := Reg.KeyExists('SOFTWARE\MICROSOFT\Office\10.0\Registration');
FINALLY
Reg.CloseKey;
Reg.Free;
END;
DN := ''; // Holds the Office XP Product Display Name
PID := ''; // Holds the Office XP Product ID
END;
FUNCTION View_OXP_Key: STRING;
BEGIN
TRY
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
KeyName := 'SOFTWARE\MICROSOFT\Office\10.0\Registration\';
Reg.OpenKeyReadOnly(KeyName);
temp := TStringList.Create;
Reg.GetKeyNames(temp); // Enumerate and hold the Office XP Product(s) Key Name(s)
Reg.CloseKey;
SubKeyName := temp.Strings[0]; // Hold the first Office XP Product Key Name
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;
FUNCTION IS_O2K3_Installed: BOOLEAN;
VAR
Reg: TRegistry;
BEGIN
Reg := TRegistry.Create;
TRY
Reg.RootKey := HKEY_LOCAL_MACHINE;
Result := Reg.KeyExists('SOFTWARE\MICROSOFT\Office\11.0\Registration');
FINALLY
Reg.CloseKey;
Reg.Free;
END;
DN := ''; // Holds the Office 2003 Product Display Name
PID := ''; // Holds the Office 2003 Product ID
END;
FUNCTION View_O2K3_Key: STRING;
BEGIN
TRY
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
KeyName := 'SOFTWARE\MICROSOFT\Office\11.0\Registration\';
Reg.OpenKeyReadOnly(KeyName);
temp := TStringList.Create;
Reg.GetKeyNames(temp); // Enumerate and hold the Office 2003 Product(s) Key Name(s)
Reg.CloseKey;
SubKeyName := temp.Strings[0]; // Hold the first Office 2003 Product Key Name
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;
FUNCTION DecodeProductKey(CONST HexSrc: ARRAY OF BYTE): STRING;
CONST
StartOffset: INTEGER = $34; { //Offset 34 = Array[52] }
EndOffset: INTEGER = $34 + 15; { //Offset 34 + 15(Bytes) = Array[64] }
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; { //Length of Decoded Product Key }
sLen: INTEGER = 15; { //Length of Encoded Product Key in Bytes (An total of 30 in chars) }
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;
END.
|