//www.dronymc.cjb.net
//drony@mynet.com
//icq:266148308
unit PJSysInfo;
interface
uses
// Delphi
SysUtils, Classes;
type
{
TPJOSPlatform:
Enumerated type for OS platforms
}
TPJOSPlatform = (
ospWinNT, // Windows NT platform
ospWin9x, // Windows 9x platform
ospWin32s // Win32s platform
);
{
TPJOSProduct:
Enumerated type indentifying OS product
}
TPJOSProduct = (
osUnknownWinNT, // Unknown Windows NT OS
osWinNT, // Windows NT (up to v4)
osWin2K, // Windows 2000
osWinXP, // Windows XP
osUnknownWin9x, // Unknown Windows 9x OS
osWin95, // Windows 95
osWin98, // Windows 98
osWinMe, // Windows Me
osUnknownWin32s, // Unknown OS running Win32s
osWinSvr2003 // Windows Server 2003
);
{
TPJSysInfo:
Component that provides system information.
}
TPJSysInfo = class(TComponent)
private // properties
function GetSystemFolder: string;
function GetTempFolder: string;
function GetWindowsFolder: string;
function GetComputerName: string;
function GetOSDesc: string;
function GetUserName: string;
function GetOSBuildNumber: Integer;
function GetOSMajorVersion: Integer;
function GetOSMinorVersion: Integer;
function GetOSPlatform: TPJOSPlatform;
function GetOSProduct: TPJOSProduct;
function GetOSProductName: string;
function GetOSProductType: string;
function GetOSServicePack: string;
function GetCommonFilesFolder: string;
function GetProgramFilesFolder: string;
public
constructor Create(AOwner: TComponent); override;
{Class constructor: ensures only one instance of component can be placed
on a form}
property CommonFilesFolder: string read GetCommonFilesFolder;
{Fully qualified name of common files folder}
property ComputerName: string read GetComputerName;
{Name of computer}
property OSBuildNumber: Integer read GetOSBuildNumber;
{Operating system build number}
property OSDesc: string read GetOSDesc;
{Full description of operating system: included product name, suite and
build numbers as applicable}
property OSMajorVersion: Integer read GetOSMajorVersion;
{Major version number of operating system}
property OSMinorVersion: Integer read GetOSMinorVersion;
{Minor version number of operating system}
property OSPlatform: TPJOSPlatform read GetOSPlatform;
{Operating system platform identifier}
property OSProduct: TPJOSProduct read GetOSProduct;
{Operating system product identifier}
property OSProductName: string read GetOSProductName;
{Name of operating system}
property OSProductType: string read GetOSProductType;
{Type of operating system - for NT. Always empty string for Win9x}
property OSServicePack: string read GetOSServicePack;
{Name of any service pack for NT or additional product info for Win9x}
property ProgramFilesFolder: string read GetProgramFilesFolder;
{Fully qualified name of program files folder}
property SystemFolder: string read GetSystemFolder;
{Fully qualified name of Windows system folder}
property TempFolder: string read GetTempFolder;
{Fully qualified name of current temporary folder}
property UserName: string read GetUserName;
{Name of currently logged on user}
property WindowsFolder: string read GetWindowsFolder;
{Fully qualified name of Windows folder}
end;
{
EPJSysInfo:
Exceptions raised by code in this unit
}
EPJSysInfo = class(Exception);
function SIGetCommonFilesFolder: string;
{Returns fully qualified name of Common Files folder}
function SIGetComputerName: string;
{Returns name of computer}
function SIGetOSBuildNumber: Integer;
{Returns build number of operating system}
function SIGetOSDesc: string;
{Returns Full description of operating system: included product name, suite
and build numbers as applicable}
function SIGetOSMajorVersion: Integer;
{Returns major version of OS}
function SIGetOSMinorVersion: Integer;
{Returns minor version of OS}
function SIGetOSPlatform: TPJOSPlatform;
{Returns code identifying OS platform program is running on}
function SIGetOSProduct: TPJOSProduct;
{Returns code identifying OS product program is running on}
function SIGetOSProductName: string;
{Returns product name of operating system}
function SIGetOSProductType: string;
{Returns type of product for Win NT and empty string for other OSs}
function SIGetOSServicePack: string;
{Returns service pack info for NT and additional release info for Win9x}
function SIGetProgramFilesFolder: string;
{Returns fully qualified name of Program Files folder}
function SIGetSystemFolder: string;
{Returns fully qualified name of Windows system folder}
function SIGetTempFolder: string;
{Returns fully qualified name of current temporary folder}
function SIGetUserName: string;
{Returns name of currently logged on user}
function SIGetWindowsFolder: string;
{Returns fully qualified name of Windows folder}
procedure Register;
{Delphi component registration routine}
implementation
uses
// Delphi
Windows;
procedure Register;
{Register the component}
begin
RegisterComponents('Plus', [TPJSysInfo]);
end;
// -----------------------------------------------------------------------------
// Types and constants not available in Delphi 4
// -----------------------------------------------------------------------------
type
{
TOSVersionInfoEx:
Win API OSVERSIONINFOEX type: not defined by Delphi 4
}
TOSVersionInfoEx = packed record
dwOSVersionInfoSize: DWORD;
dwMajorVersion: DWORD;
dwMinorVersion: DWORD;
dwBuildNumber: DWORD;
dwPlatformId: DWORD;
szCSDVersion: array[0..127] of AnsiChar;
wServicePackMajor: WORD;
wServicePackMinor: WORD;
wSuiteMask: WORD;
wProductType: Byte;
wReserved: Byte;
end;
const
// These constants are required for use with TOSVersionInfoex
// NT Product types
VER_NT_WORKSTATION = $0000001;
VER_NT_DOMAIN_CONTROLLER = $0000002;
VER_NT_SERVER = $0000003;
// Mask representing NT product suites
VER_SUITE_SMALLBUSINESS = $00000001;
VER_SUITE_ENTERPRISE = $00000002;
VER_SUITE_BACKOFFICE = $00000004;
VER_SUITE_COMMUNICATIONS = $00000008;
VER_SUITE_TERMINAL = $00000010;
VER_SUITE_SMALLBUSINESS_RESTRICTED = $00000020;
VER_SUITE_EMBEDDEDNT = $00000040;
VER_SUITE_DATACENTER = $00000080;
VER_SUITE_SINGLEUSERTS = $00000100;
VER_SUITE_PERSONAL = $00000200;
VER_SUITE_SERVERAPPLIANCE = $00000400;
VER_SUITE_BLADE = VER_SUITE_SERVERAPPLIANCE;
// -----------------------------------------------------------------------------
// Constants required internally
// -----------------------------------------------------------------------------
const
// Lookup table of product names
cOSProductNames: array[TPJOSProduct] of string = (
'Unknown Windows NT Release',
'Windows NT',
'Windows 2000',
'Windows XP',
'Unknown Windows 9x Release',
'Windows 95',
'Windows 98',
'Windows Me',
'Win32s',
'Windows Server 2003'
);
// -----------------------------------------------------------------------------
// Helper routines
// -----------------------------------------------------------------------------
resourcestring
// Error message
sCantGetOSV = 'Can''t get OS version info';
sUknownPlatform = 'Unknown OS platform';
function MakeDirName(const DirOrPath: string) : string;
{Removes any trailing '\' from given directory or path and returns result}
begin
Result := DirOrPath;
while (Result <> '') and (Result[Length(Result)] = '\') do
Result := Copy(Result, 1, Length(Result) - 1);
end;
function GetOSVerInfo(var OSV: TOSVersionInfoEx): Boolean;
{Fills a TOSVersionInfoEx or TOSVersionInfo structure with information about
operating system - return true if we have read extended structure and false if
not}
var
POSV: POSVersionInfo; // pointer to OS version info structure
begin
// Clear the structure
FillChar(OSV, SizeOf(OSV), 0);
// Get pointer to structure of non-extended type (GetVersionEx requires
// non-extended structure and we need this pointer to get it to accept our
// extended structure
POSV := @OSV;
// We first try to get exended information
OSV.dwOSVersionInfoSize := SizeOf(TOSVersionInfoEx);
Result := GetVersionEx(POSV^);
if not Result then
begin
// We failed to get extended info: try again with old structure
OSV.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if not GetVersionEx(POSV^) then
// We failed again: shouldn't happen so raise exception
raise EPJSysInfo.Create(sCantGetOSV);
end;
end;
function GetOSBuildNumber(const OSV: TOSVersionInfoEx): Integer;
{Returns build number from given OS ver info structure}
begin
Result := OSV.dwBuildNumber and $0000FFFF;
end;
function GetOSPlatform(const OSV: TOSVersionInfoEx): TPJOSPlatform;
{Returns OS platform from given OS ver info structure}
begin
case OSV.dwPlatformId of
VER_PLATFORM_WIN32_NT: Result := ospWinNT;
VER_PLATFORM_WIN32_WINDOWS: Result := ospWin9x;
VER_PLATFORM_WIN32s: Result := ospWin32s;
else raise EPJSysInfo.Create(sUknownPlatform);
end;
end;
function GetOSProduct(const OSV: TOSVersionInfoEx): TPJOSProduct;
{Returns code identifying OS product from given OS ver info structure}
begin
case OSV.dwPlatformId of
VER_PLATFORM_WIN32_NT:
begin
// We have an NT OS
if OSV.dwMajorVersion <= 4 then
Result := osWinNT
else if (OSV.dwMajorVersion = 5) and (OSV.dwMinorVersion = 0) then
Result := osWin2K
else if (OSV.dwMajorVersion = 5) and (OSV.dwMinorVersion = 1) then
Result := osWinXP
else if (OSV.dwMajorVersion = 5) and (OSV.dwMinorVersion = 2) then
Result := osWinSvr2003
else
Result := osUnknownWinNT;
end;
VER_PLATFORM_WIN32_WINDOWS:
begin
// We have a Win 95 line OS
if (OSV.dwMajorVersion = 4) and (OSV.dwMinorVersion = 0) then
Result := osWin95
else if (OSV.dwMajorVersion = 4) and (OSV.dwMinorVersion = 10) then
Result := osWin98
else if (OSV.dwMajorVersion = 4) and (OSV.dwMinorVersion = 90) then
Result := osWinMe
else
Result := osUnknownWin9x
end;
else
// This is a Win32s enabled OS
Result := osUnknownWin32s;
end;
end;
function GetOSProductName(OSV: TOSVersionInfoEx): string;
{Return product name of OS from given OS ver info structure}
begin
Result := cOSProductNames[GetOSProduct(OSV)];
end;
function GetOSProductType(OSV: TOSVersionInfoEx;
IsOSVersionInfoEx: Boolean): string;
{Return type of OS product from given OS ver info structure. IsOSVersionInfoEx
indicates if OSV is an extended structure (true) or is older style structure
(false). We only return a value for NT}
var
RegKey: HKEY; // registry key
ProductType: array[0..80] of Char; // buffer to store product type from reg
BufLen: DWORD; // length of ProductType buffer
begin
Result := '';
case OSV.dwPlatformId of
VER_PLATFORM_WIN32_NT:
begin
// This is an NT OS
// check product type
if IsOSVersionInfoEx then
begin
// we have extended OS info: product type info is in here
if OSV.wProductType = VER_NT_WORKSTATION then
begin
if OSV.dwMajorVersion = 4 then
Result := 'Workstation'
else if OSV.wSuiteMask and VER_SUITE_PERSONAL <> 0 then
Result := 'Home Edition'
else
Result := 'Professional';
end
else if OSV.wProductType = VER_NT_SERVER then
begin
// This is an NT server OS
if (OSV.dwMajorVersion = 5) and (OSV.dwMinorVersion = 2) then
begin
// Windows Serer 2003
if OSV.wSuiteMask and VER_SUITE_DATACENTER <> 0 then
Result := 'Datacenter Edition'
else if OSV.wSuiteMask and VER_SUITE_ENTERPRISE <> 0 then
Result := 'Enterprise Edition'
else if OSV.wSuiteMask = VER_SUITE_BLADE then
Result := 'Web Edition'
else
Result := 'Standard Edition';
end
else if (OSV.dwMajorVersion = 5) and (OSV.dwMinorVersion = 0) then
begin
// Windows 2000 Server
if OSV.wSuiteMask and VER_SUITE_DATACENTER <> 0 then
Result := 'Datacenter Server'
else if OSV.wSuiteMask and VER_SUITE_ENTERPRISE <> 0 then
Result := 'Advanced Server'
else
Result := 'Server'
end
else
begin
// Windows NT 4.0
if OSV.wSuiteMask and VER_SUITE_ENTERPRISE <> 0 then
Result := 'Server, Enterprise Edition'
else
Result := 'Server'
end;
end;
end
else
begin
// we have not got extended OS info: read product type from registry
RegOpenKeyEx( HKEY_LOCAL_MACHINE,
'SYSTEM\CurrentControlSet\Control\ProductOptions',
0, KEY_QUERY_VALUE, RegKey );
RegQueryValueEx(RegKey, 'ProductType', nil, nil,
@ProductType, @BufLen);
RegCloseKey(RegKey);
if AnsiCompareText('WINNT', ProductType) = 0 then
Result := 'Professional';
if AnsiCompareText('LANMANNT', ProductType) = 0 then
Result := 'Server';
if AnsiCompareText('SERVERNT', ProductType) = 0 then
Result := 'Advanced Server';
end;
end;
end;
end;
function GetOSServicePack(OSV: TOSVersionInfoEx): string;
{Returns name of any service pack associated with OS (if NT) or additional
product info (if Win9x)}
var
RegKey: HKEY; // registry key
begin
Result := '';
case OSV.dwPlatformId of
VER_PLATFORM_WIN32_NT:
// An NT OS
if (OSV.dwMajorVersion = 4)
and (AnsiCompareText(OSV.szCSDVersion, 'Service Pack 6') = 0) then
begin
// Special test for SP6 versus SP6a.
if RegOpenKeyEx(
HKEY_LOCAL_MACHINE,
'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Hotfix\Q246009',
0, KEY_QUERY_VALUE, RegKey
) = ERROR_SUCCESS then
// Windows NT4 SP6a
Result := 'Service Pack 6a'
else
// Window NT4 earlier than SP6a
Result := OSV.szCSDVersion;
RegCloseKey(RegKey);
end
else
Result := OSV.szCSDVersion;
VER_PLATFORM_WIN32_WINDOWS:
// A Win9x OS
if OSV.dwMajorVersion = 4 then
begin
if (OSV.dwMinorVersion = 0)
and ((OSV.szCSDVersion[1] = 'C') or (OSV.szCSDVersion[1] = 'B')) then
Result := 'OSR2'
else if (OSV.dwMinorVersion = 10) and (OSV.szCSDVersion[1] = 'A') then
Result := 'SE';
end;
end;
end;
function GetCurrentVersionRegStr(ValName: string): string;
{Gets string info from Windows current version key in registry}
const
cCurrentVersionRegKey = 'Software\Microsoft\Windows\CurrentVersion';
var
RegKey: HKEY; // regsitry key
DataType: DWORD; // type of data read from registry (must be REG_SZ)
BufSize: DWORD; // size of buffer required for registry value
begin
// Assume we fail to get string from registry
Result := '';
// Attempt to open registry key
if RegOpenKeyEx(
HKEY_LOCAL_MACHINE, cCurrentVersionRegKey, 0, KEY_QUERY_VALUE, RegKey
) = ERROR_SUCCESS then
begin
// Get size of buffer required to hold data
RegQueryValueEx(
RegKey, PChar(ValName), nil, @DataType, nil, @BufSize
);
// Check we have string data
if DataType = REG_SZ then
begin
// Read string from registry into Delphu string of required size
SetLength(Result, BufSize);
if RegQueryValueEx(
RegKey, PChar(ValName), nil, @DataType, PByte(PChar(Result)), @BufSize
) = ERROR_SUCCESS then
SetLength(Result, StrLen(PChar(Result)));
end;
// Close the registry key
RegCloseKey(RegKey);
end;
end;
// -----------------------------------------------------------------------------
// Public routines
// -----------------------------------------------------------------------------
function SIGetCommonFilesFolder: string;
{Returns fully qualified name of Common Files folder}
begin
Result := GetCurrentVersionRegStr('CommonFilesDir');
end;
function SIGetComputerName: string;
{Returns name of computer}
var
PComputerName: array[0..MAX_PATH] of Char;// buffer for name returned from API
Size: DWORD; // size of name buffer
begin
Size := MAX_PATH;
if Windows.GetComputerName(PComputerName, Size) then
Result := PComputerName
else
Result := '';
end;
function SIGetOSBuildNumber: Integer;
{Returns build number of operating system}
var
OSV: TOSVersionInfoEx; // structure to hold OS info
begin
GetOSVerInfo(OSV);
Result := GetOSBuildNumber(OSV);
end;
function SIGetOSDesc: string;
{Returns Full description of operating system: included product name, suite
and build numbers as applicable}
var
OSV: TOSVersionInfoEx; // structure to hold OS info
IsOSVersionInfoEx: Boolean; // flag true if we read extended OS info
// ---------------------------------------------------------------------------
procedure AppendToResult(const Str: string);
begin
if Str <> '' then
Result := Result + ' ' + Str;
end;
// ---------------------------------------------------------------------------
begin
// Read version info and record if extended or old version read
IsOSVersionInfoEx := GetOSVerInfo(OSV);
Result := GetOSProductName(OSV);
case OSV.dwPlatformId of
VER_PLATFORM_WIN32_NT:
begin
// We have an NT OS
// check for product type
AppendToResult(GetOSProductType(OSV, IsOSVersionInfoEx));
// display version, service pack (if any), and build number.
if OSV.dwMajorVersion <= 4 then
AppendToResult(Format('version %d.%d %s (Build %d)',
[OSV.dwMajorVersion, OSV.dwMinorVersion, GetOSServicePack(OSV),
GetOSBuildNumber(OSV)]))
else
AppendToResult(Format('%s (Build %d)',
[GetOSServicePack(OSV), GetOSBuildNumber(OSV)]));
end;
VER_PLATFORM_WIN32_WINDOWS:
begin
// We have a Win 95 line OS
AppendToResult(GetOSServicePack(OSV));
end;
end;
end;
function SIGetOSMajorVersion: Integer;
{Returns major version of OS}
var
OSV: TOSVersionInfoEx; // structure to hold OS info
begin
GetOSVerInfo(OSV);
Result := OSV.dwMajorVersion;
end;
function SIGetOSMinorVersion: Integer;
{Returns minor version of OS}
var
OSV: TOSVersionInfoEx; // structure to hold OS info
begin
GetOSVerInfo(OSV);
Result := OSV.dwMinorVersion;
end;
function SIGetOSPlatform: TPJOSPlatform;
{Returns code identifying OS platform program is running on}
var
OSV: TOSVersionInfoEx; // structure to hold OS info
begin
GetOSVerInfo(OSV);
Result := GetOSPlatform(OSV);
end;
function SIGetOSProduct: TPJOSProduct;
{Returns code identifying OS product program is running on}
var
OSV: TOSVersionInfoEx; // structure to hold OS info
begin
GetOSVerInfo(OSV);
Result := GetOSProduct(OSV);
end;
function SIGetOSProductName: string;
{Returns product name of operating system}
var
OSV: TOSVersionInfoEx; // structure to hold OS info
begin
GetOSVerInfo(OSV);
Result := GetOSProductName(OSV);
end;
function SIGetOSProductType: string;
{Returns type of product for Win NT and empty string for other OSs}
var
OSV: TOSVersionInfoEx; // structure to hold OS info
IsOSVersionInfoEx: Boolean; // flag true if we read extended OS info
begin
IsOSVersionInfoEx := GetOSVerInfo(OSV);
Result := GetOSProductType(OSV, IsOSVersionInfoEx);
end;
function SIGetOSServicePack: string;
{Returns service pack info for NT and additional release info for Win9x}
var
OSV: TOSVersionInfoEx; // structure to hold OS info
begin
GetOSVerInfo(OSV);
Result := GetOSServicePack(OSV);
end;
function SIGetProgramFilesFolder: string;
{Returns fully qualified name of Program Files folder}
begin
Result := GetCurrentVersionRegStr('ProgramFilesDir');
end;
function SIGetSystemFolder: string;
{Returns fully qualified name of Windows system folder}
var
PFolder: array[0..MAX_PATH] of Char; // buffer to hold name returned from API
begin
if Windows.GetSystemDirectory(PFolder, MAX_PATH) <> 0 then
Result := MakeDirName(PFolder)
else
Result := '';
end;
function SIGetTempFolder: string;
{Returns fully qualified name of current temporary folder}
var
PathBuf: array[0..MAX_PATH] of Char; // buffer to hold name returned from API
begin
if Windows.GetTempPath(MAX_PATH, PathBuf) <> 0 then
Result := MakeDirName(PathBuf)
else
Result := '';
end;
function SIGetUserName: string;
{Returns name of currently logged on user}
var
PUserName: array[0..MAX_PATH] of Char; // buffer for name returned from API
Size: DWORD; // size of name buffer
begin
Size := MAX_PATH;
if Windows.GetUserName(PUserName, Size) then
Result := PUserName
else
Result := '';
end;
function SIGetWindowsFolder: string;
{Returns fully qualified name of Windows folder}
var
PFolder: array[0..MAX_PATH] of Char; // buffer to hold name returned from API
begin
if Windows.GetWindowsDirectory(PFolder, MAX_PATH) <> 0 then
Result := MakeDirName(PFolder)
else
Result := '';
end;
// -----------------------------------------------------------------------------
// Component implementation
// -----------------------------------------------------------------------------
{ TPJSysInfo }
resourcestring
// Error message
sDupInstErr = 'Only one %0:s component is permitted on a form: '
+ '%1:s is already present on %2:s';
constructor TPJSysInfo.Create(AOwner: TComponent);
{Class constructor: ensures only one instance of component can be placed on a
form}
var
Idx: Integer; // loops thru components on Owner form
begin
// Ensure that component is unique
for Idx := 0 to Pred(AOwner.ComponentCount) do
if AOwner.Components[Idx] is ClassType then
raise Exception.CreateFmt(
sDupInstErr,
[ClassName, AOwner.Components[Idx].Name, AOwner.Name]
);
// All OK: go ahead and create component
inherited Create(AOwner);
end;
function TPJSysInfo.GetCommonFilesFolder: string;
{Read access method for CommonFilesFolder property}
begin
Result := SIGetCommonFilesFolder;
end;
function TPJSysInfo.GetComputerName: string;
{Read access method for ComputerName property}
begin
Result := SIGetComputerName;
end;
function TPJSysInfo.GetOSBuildNumber: Integer;
{Read access method for OSBuildNumber property}
begin
Result := SIGetOSBuildNumber;
end;
function TPJSysInfo.GetOSDesc: string;
{Read access method for OSDesc property}
begin
Result := SIGetOSDesc;
end;
function TPJSysInfo.GetOSMajorVersion: Integer;
{Read access method for OSMajorVersion property}
begin
Result := SIGetOSMajorVersion;
end;
function TPJSysInfo.GetOSMinorVersion: Integer;
{Read access method for OSMinorVersion property}
begin
Result := SIGetOSMinorVersion;
end;
function TPJSysInfo.GetOSPlatform: TPJOSPlatform;
{Read access method for OSPlatform property}
begin
Result := SIGetOSPlatform;
end;
function TPJSysInfo.GetOSProduct: TPJOSProduct;
{Read access method for OSProduct property}
begin
Result := SIGetOSProduct;
end;
function TPJSysInfo.GetOSProductName: string;
{Read access method for OSProductName property}
begin
Result := SIGetOSProductName;
end;
function TPJSysInfo.GetOSProductType: string;
{Read access method for OSProductType property}
begin
Result := SIGetOSProductType;
end;
function TPJSysInfo.GetOSServicePack: string;
{Read access method for OSServicePack property}
begin
Result := SIGetOSServicePack;
end;
function TPJSysInfo.GetProgramFilesFolder: string;
{Read access method for ProgramFilesFolder property}
begin
Result := SIGetProgramFilesFolder;
end;
function TPJSysInfo.GetSystemFolder: string;
{Read access method for SystemFolder property}
begin
Result := SIGetSystemFolder;
end;
function TPJSysInfo.GetTempFolder: string;
{Read access method for TempFolder property}
begin
Result := SIGetTempFolder;
end;
function TPJSysInfo.GetUserName: string;
{Read access method for UserName property}
begin
Result := SIGetUserName;
end;
function TPJSysInfo.GetWindowsFolder: string;
{Read access method for WindowsFolder property}
begin
Result := SIGetWindowsFolder;
end;
end.