develooper Front page | perl.perl5.porters | Postings from July 2003

[PATCH] Extend Win32::GetOSVersion() to return additional information

From:
Jan Dubois
Date:
July 29, 2003 19:14
Subject:
[PATCH] Extend Win32::GetOSVersion() to return additional information
Message ID:
i06eivs0h9khken8rloevj68iqu6n45hnq@4ax.com
The attached patch adds the additional information available from the
OSVERSIONINFOEX structure to the list of values returned by
Win32::GetOSVersion().  This information is available for Windows
NT 4 SP6 and later.

I believe this patch is "low risk", but I'll understand if Jarkko doesn't
want to apply it to 5.8.1.  :)

The actual patch below is against the latest ActivePerl 5.6.1 source, but
it does integrate cleanly (with offset of about 400 lines) into 5.8 too.

Cheers,
-Jan



Change 72365 by jand@jand-tofino on 2003/07/29 17:43:42

Extend Win32::GetOSVersion() to return additional
information about the system (when available).
http://bugs.activestate.com/show_bug.cgi?id=26302

Affected files ...

... src/Core/lib/Win32.pod#7 edit
... src/Core/win32/win32.c#79 edit

Differences ...

==== src/Core/lib/Win32.pod#7 (text) ====
Index: src/Core/lib/Win32.pod
--- src/Core/lib/Win32.pod.~1~	Tue Jul 29 17:45:00 2003
+++ src/Core/lib/Win32.pod	Tue Jul 29 17:45:00 2003
@@ -205,12 +205,12 @@
 
 =item Win32::GetOSVersion()
 
-[CORE] Returns the array (STRING, MAJOR, MINOR, BUILD, ID), where the
+[CORE] Returns the list (STRING, MAJOR, MINOR, BUILD, ID), where the
 elements are, respectively: An arbitrary descriptive string, the major
 version number of the operating system, the minor version number, the
 build number, and a digit indicating the actual operating system.
-For the ID, the values are 0 for Win32s, 1 for Windows 9X and 2 for
-Windows NT/2000/XP.  In scalar context it returns just the ID.
+For the ID, the values are 0 for Win32s, 1 for Windows 9X/Me and 2 for
+Windows NT/2000/XP/2003.  In scalar context it returns just the ID.
 
 Currently known values for ID MAJOR and MINOR are as follows:
 
@@ -223,10 +223,41 @@
     Windows NT 4           2      4       0
     Windows 2000           2      5       0
     Windows XP             2      5       1
-    Windows .NET Server    2      5       1
+    Windows Server 2003    2      5       2
+
+On Windows NT 4 SP6 and later this function returns the following
+additional values: SPMAJOR, SPMINOR, SUITEMASK, PRODUCTTYPE.
+
+SPMAJOR and SPMINOR are are the version numbers of the latest
+installed service pack.
+
+SUITEMASK is a bitfield identifying the product suites available on
+the system.  Known bits are:
+
+    VER_SUITE_SMALLBUSINESS             0x00000001
+    VER_SUITE_ENTERPRISE                0x00000002
+    VER_SUITE_BACKOFFICE                0x00000004
+    VER_SUITE_COMMUNICATIONS            0x00000008
+    VER_SUITE_TERMINAL                  0x00000010
+    VER_SUITE_SMALLBUSINESS_RESTRICTED  0x00000020
+    VER_SUITE_EMBEDDEDNT                0x00000040
+    VER_SUITE_DATACENTER                0x00000080
+    VER_SUITE_SINGLEUSERTS              0x00000100
+    VER_SUITE_PERSONAL                  0x00000200
+    VER_SUITE_BLADE                     0x00000400
+    VER_SUITE_EMBEDDED_RESTRICTED       0x00000800
+    VER_SUITE_SECURITY_APPLIANCE        0x00001000
+
+The VER_SUITE_xxx names are listed here to crossreference the Microsoft
+documentation.  The Win32 module does not provide symbolic names for these
+constants.
+
+PRODUCTTYPE provides additional information about the system.  It should
+be one of the following integer values:
 
-Unfortunately as of June 2002 there is no way to distinguish between
-.NET servers and XP servers without using additional modules.
+    1 - Workstation (NT 4, 2000 Pro, XP Home, XP Pro)
+    2 - Domaincontroller
+    3 - Server
 
 =item Win32::GetOSName()
 
@@ -239,7 +270,7 @@
 
 Currently the possible values for the OS name are
 
-  Win32s Win95 Win98 WinMe Win2000 WinXP/.Net WinNT3.51 WinNT4
+ Win32s Win95 Win98 WinMe WinNT3.51 WinNT4 Win2000 WinXP/.Net Win2003
 
 This routine is just a simple interface into GetOSVersion().  More
 specific or demanding situations should use that instead.  Another
@@ -247,6 +278,11 @@
 report only the OS family name and not the specific OS.  In scalar
 context it returns just the ID.
 
+The name "WinXP/.Net" is used for historical reasons only, to maintain
+backwards compatibility of the Win32 module.  Windows .NET Server has
+been renamed as Windows 2003 Server before final release and uses a
+different major/minor version number than Windows XP.
+
 =item Win32::GetShortPathName(PATHNAME)
 
 [CORE] Returns a representation of PATHNAME composed only of

==== src/Core/win32/win32.c#79 (text) ====
Index: src/Core/win32/win32.c
--- src/Core/win32/win32.c.~1~	Tue Jul 29 17:45:00 2003
+++ src/Core/win32/win32.c	Tue Jul 29 17:45:00 2003
@@ -4096,26 +4096,68 @@
 XS(w32_GetOSVersion)
 {
     dXSARGS;
-    OSVERSIONINFOA osver;
+    /* Use explicit struct definition because wSuiteMask and
+     * wProductType are not defined in the VC++ 6.0 headers.
+     * WORD type has been replaced by unsigned short because
+     * WORD is already used by Perl itself.
+     */
+    struct {
+        DWORD dwOSVersionInfoSize;
+        DWORD dwMajorVersion;
+        DWORD dwMinorVersion;
+        DWORD dwBuildNumber;
+        DWORD dwPlatformId;
+        CHAR  szCSDVersion[128];
+        unsigned short wServicePackMajor;
+        unsigned short wServicePackMinor;
+        unsigned short wSuiteMask;
+        BYTE  wProductType;
+        BYTE  wReserved;
+    }   osver;
+    BOOL bEx = TRUE;
 
     if (USING_WIDE()) {
-	OSVERSIONINFOW osverw;
+        struct {
+            DWORD dwOSVersionInfoSize;
+            DWORD dwMajorVersion;
+            DWORD dwMinorVersion;
+            DWORD dwBuildNumber;
+            DWORD dwPlatformId;
+            WCHAR szCSDVersion[128];
+            unsigned short wServicePackMajor;
+            unsigned short wServicePackMinor;
+            unsigned short wSuiteMask;
+            BYTE  wProductType;
+            BYTE  wReserved;
+        } osverw;
 	char szCSDVersion[sizeof(osverw.szCSDVersion)];
-	osverw.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
-	if (!GetVersionExW(&osverw)) {
-	    XSRETURN_EMPTY;
+	osverw.dwOSVersionInfoSize = sizeof(osverw);
+	if (!GetVersionExW((OSVERSIONINFOW*)&osverw)) {
+            bEx = FALSE;
+            osverw.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
+            if (!GetVersionExW((OSVERSIONINFOW*)&osverw)) {
+                XSRETURN_EMPTY;
+            }
 	}
 	W2AHELPER(osverw.szCSDVersion, szCSDVersion, sizeof(szCSDVersion));
 	XPUSHs(newSVpvn(szCSDVersion, strlen(szCSDVersion)));
-	osver.dwMajorVersion = osverw.dwMajorVersion;
-	osver.dwMinorVersion = osverw.dwMinorVersion;
-	osver.dwBuildNumber = osverw.dwBuildNumber;
-	osver.dwPlatformId = osverw.dwPlatformId;
+        osver.dwMajorVersion    = osverw.dwMajorVersion;
+        osver.dwMinorVersion    = osverw.dwMinorVersion;
+        osver.dwBuildNumber     = osverw.dwBuildNumber;
+        osver.dwPlatformId      = osverw.dwPlatformId;
+        osver.wServicePackMajor = osverw.wServicePackMajor;
+        osver.wServicePackMinor = osverw.wServicePackMinor;
+        osver.wSuiteMask        = osverw.wSuiteMask;
+        osver.wProductType      = osverw.wProductType;
     }
     else {
-	osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
-	if (!GetVersionExA(&osver)) {
-	    XSRETURN_EMPTY;
+	osver.dwOSVersionInfoSize = sizeof(osver);
+	if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
+            bEx = FALSE;
+            osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
+            if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
+                XSRETURN_EMPTY;
+            }
 	}
 	XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
     }
@@ -4123,6 +4165,12 @@
     XPUSHs(newSViv(osver.dwMinorVersion));
     XPUSHs(newSViv(osver.dwBuildNumber));
     XPUSHs(newSViv(osver.dwPlatformId));
+    if (bEx) {
+        XPUSHs(newSViv(osver.wServicePackMajor));
+        XPUSHs(newSViv(osver.wServicePackMinor));
+        XPUSHs(newSViv(osver.wSuiteMask));
+        XPUSHs(newSViv(osver.wProductType));
+    }
     PUTBACK;
 }
 
End of Patch.




nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About