|
 Forum
Grundkurs
»Introduktion
»Snabbguide
»Komponenter
»Händelser
»Strängar
»Räkna med Delphi »Egna
typer
»Selektion
»Iteration
»Menyer
»Funktioner
»Arraystrukturer
Tips & Tricks
»Nya tips
»Blandat
»Databaser
»Filer
»Forms
»Grafik
»Internet
»Komponenter
»Matematik
»Multimedia
»Objekt/ActiveX
»Skrivare
»Strängar
»System
»Mest lästa tips
Artiklar
»Delphi och ADO
»Bygga en DLL
»Skapa en enkel rapport
»Hantera registret
»Enheter, units
»Klassen TCanvas
»Använd LookUp Controls
 Nya
tips
 Lägg
till tips
 Delphilänkar
 Gästbok
|
|
|
|
|
|
Returnera Windows produktnyckel
|
Kategori: System
Inlagt: 2005-04-24
Läst: 3200
Inlagt av: Staffan Berg
|
|
Beskrivning |
|
Detta exempel gör det möjligt att returnera den produktnyckel som finns i Windows 2000, XP och Office XP. Se vidare kommentarer i koden.
|
|
Kod |
unit MSProdKey;
// Unit MSProdKey v2.2 *
*
*
// 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; *
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.
|
|
|