SystemInfo (2)

Private Type OSVERSIONINFOEX
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
  wServicePackMajor As Integer
  wServicePackMinor As Integer
  wSuiteMask As Integer
  wProductType As Byte
  wReserved As Byte
End Type

Private Declare Function GetVersionEx Lib "kernel32" _
        Alias "GetVersionExA"( lpVersionInformation As OSVERSIONINFOEX ) As Long

Private Declare Function GetWindowsDirectory Lib "kernel32" _
        Alias "GetWindowsDirectoryA" ( ByVal lpBuffer As String, _
        ByVal nSize As Long ) As Long

Private Declare Function GetTempPath Lib "kernel32" _
        Alias "GetTempPathA" ( ByVal nBufferLength As Long, _
        ByVal lpBuffer As String ) As Long

Private Declare Function GetTempFileName Lib "kernel32" _
        Alias "GetTempFileNameA"( ByVal lpszPath As String, _
        ByVal lpPrefixString As String, ByVal wUnique As Long, _
        ByVal lpTempFileName As String ) As Long

Dim sSystemInfo As String
Dim OSVI As OSVERSIONINFOEX

Function fGetTempFile() As String
  Dim sTempDir As String
  sTempDir = fDirCheck(fGetTempDir())
  Dim sPrefix As String
  sPrefix = ""
  Dim lUnique As Long
  lUnique = 0
  Dim lRet As Long
  Dim sBuf As String * 512
  lRet = GetTempFileName(sTempDir, sPrefix, lUnique, sBuf)
  If InStr(1, sBuf, Chr(0)) > 0 Then
     fGetTempFile = _
     Left(sBuf, InStr(1, sBuf, Chr(0)) - 1)
  Else
     fGetTempFile = ""
  End If
End Function

Function fGetWinDir() As String
  Dim lRet As Long
  Dim lSize As Long
  Dim sBuf As String * MAX_PATH
  lSize = MAX_PATH
  lRet = GetWindowsDirectory(ByVal sBuf, ByVal lSize)
  If InStr(1, sBuf, Chr(0)) > 0 Then
     fGetWinDir = Left(sBuf, InStr(1, sBuf, Chr(0)) - 1)
  Else
     fGetWinDir = ""
  End If
End Function

Function fDirCheck(sDirName As String) As String
  fDirCheck = IIf(Right(sDirName, 1) = "\", _
  sDirName, sDirName & "\")
End Function

Function fGetTempDir() As String
  Dim lRet As Long
  Dim lSize As Long
  Dim sBuf As String * MAX_PATH
  lSize = MAX_PATH
  lRet = GetTempPath(ByVal lSize, sBuf)
  If InStr(1, sBuf, Chr(0)) > 0 Then
     fGetTempDir = Left(sBuf, InStr(2, sBuf, Chr(0)) - 1)
  Else
     fGetTempDir = ""
  End If
End Function

Function fGetSystemInfo() As Boolean
  Dim lRet As Long
  Dim iNullPos As Integer
  Dim colProdSuites As Collection
  Dim vCurrProdSuite As Variant
  OSVI.dwOSVersionInfoSize = Len(OSVI)
  OSVI.szCSDVersion = Space(128)
  lRet = GetVersionEx(OSVI)
  If lRet = 0 Then
     MsgBox ("Error" & vbCrLf & _
     Err.LastDllError & " - " & Err.Description)
     fGetSystemInfo = False
     Exit Function
  End If
 'For major version number, minor version number,
 'and build number, convert the value returned into a string.
  sSystemInfo = "Major Version: " & _
  Str(OSVI.dwMajorVersion) & vbCrLf
  sSystemInfo = sSystemInfo + "Minor Version: " & _
  Str(OSVI.dwMinorVersion) & vbCrLf
  sSystemInfo = sSystemInfo + "Build Number: " & _
  Str(OSVI.dwBuildNumber) & vbCrLf
 'To determine the specific platform, use the constants you declared 
 'to evaluate dwPlatformId. Depending on the platform, 
 'check dwBuildNumber to determine the specific platform.
  sSystemInfo = sSystemInfo + "Platform: "
  Select Case OSVI.dwPlatformId
     Case VER_PLATFORM_WIN32s
        sSystemInfo = sSystemInfo & _
        "Win32s On Windows 3.1" & vbCrLf
     Case VER_PLATFORM_WIN32_WINDOWS
        sSystemInfo = sSystemInfo & _
        IIf(OSVI.dwBuildNumber = 0, _
        "Windows 98", "Windows 95") & vbCrLf
     Case VER_PLATFORM_WIN32_NT
        sSystemInfo = sSystemInfo & _
        IIf(OSVI.dwMajorVersion < 5, _
        "Windows NT", "Windows 2000") & vbCrLf
  End Select
 'To determine service pack information, use the constants you 
 'declared to evaluate dwPlatformId. Depending on the platform, 
 'check szCSD  Version to determine the specific service pack information.

Select Case OSVI.dwPlatformId
    Case VER_PLATFORM_WIN32s
       sSystemInfo = sSystemInfo & _
       "No additional info on " & _
       "Win32s On Windows 3.1." & vbCrLf
    Case VER_PLATFORM_WIN32_WINDOWS
       sSystemInfo = sSystemInfo & _
       "Additional OS Info: " & _
       OSVI.szCSDVersion & vbCrLf
    Case VER_PLATFORM_WIN32_NT
       If Asc(Left$(OSVI.szCSDVersion, 1)) = 0 Then
          'leftmost char = null, this is an empty string
           sSystemInfo = sSystemInfo & "Service Pack Install " _
           & "Info: No Service Pack " & "Installed" & vbCrLf
       Else
           'find the null char in the string
        iNullPos = InStr(OSVI.szCSDVersion, Chr(0))
        sSystemInfo = sSystemInfo & "Service Pack Install " & "Info: " & _
        Left$(OSVI.szCSDVersion, iNullPos - 1) & vbCrLf
       End If
    End Select
   'For major service pack, major and minor version numbers, 
   'convert the values returned into a string.
    sSystemInfo = sSystemInfo & "Service Pack Version: "
    sSystemInfo = sSystemInfo & _
    CStr(OSVI.wServicePackMajor) & "." & _
    CStr(OSVI.wServicePackMinor) & vbCrLf
   'To determine which product suite components are installed 
   'evaluate wSuiteMask and compare the value against the constants 
   'declared for the various product suites. Add information to the
   'colProdSuite collection based on which product suit es are installed.
   'This this value is a set of bit flags. Test against
   'each bit mask, add found items to a VBcollection

Set colProdSuites = New Collection

If (OSVI.wSuiteMask And VER_SUITE_BACKOFFICE) = VER_SUITE_BACKOFFICE Then
       colProdSuites.Add "Microsoft BackOffice components are installed."
    End If

If (OSVI.wSuiteMask And VER_SUITE_DATACENTER) = VER_SUITE_DATACENTER Then
       colProdSuites.Add "Windows 2000 Datacenter Server is installed."
    End If

If (OSVI.wSuiteMask And VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE Then
       colProdSuites.Add "Windows 2000 Advanced Server is installed."
    End If

If (OSVI.wSuiteMask And VER_SUITE_SMALLBUSINESS) = VER_SUITE_SMALLBUSINESS Then
       colProdSuites.Add "Microsoft Small Business Server is installed."
    End If

If (OSVI.wSuiteMask And VER_SUITE_SMALLBUSINESS_RESTRICTED) = _
        VER_SUITE_SMALLBUSINESS_RESTRICTED Then
       colProdSuites.Add "Microsoft Small Business Server is installed " & _
                         "with the restrictive client license in force."
    End If

If (OSVI.wSuiteMask And VER_SUITE_TERMINAL) = VER_SUITE_TERMINAL Then
       colProdSuites.Add "Terminal Services is installed."
    End If
   'list all product suites available that were added to the collection object
    sSystemInfo = sSystemInfo & "Product Suites: " & vbCrLf

For Each vCurrProdSuite In colProdSuites
        sSystemInfo = sSystemInfo & vbCrLf & vbTab & vCurrProdSuite
    Next

'To determine the product type, use the constants you 
   'declared to evaluate wProductType.
    sSystemInfo = sSystemInfo & "Product Type: "

Select Case OSVI.wProductType
    Case VER_NT_WORKSTATION
       sSystemInfo = sSystemInfo & "Windows 2000 Professional"
    Case VER_NT_DOMAIN_CONTROLLER
       sSystemInfo = sSystemInfo & "Windows 2000 domain controller"
    Case VER_NT_SERVER
       sSystemInfo = sSystemInfo & "Windows 2000 Server"
    End Select
    fGetSystemInfo = True
End Function

Sub Main()
  If fGetSystemInfo() Then
     Dim sTmpFile As String
     sTmpFile = fGetTempFile
     Open sTmpFile For Output As #1
     Print #1, sSystemInfo
     Close #1
     Dim sCmd As String
     sCmd = fDirCheck(fGetWinDir()) & "Notepad.exe " & sTmpFile
     Dim vRet As Variant
     vRet = Shell(sCmd, vbNormalFocus)
 End If
End Sub
 Assumes:
Just copy the entire source to a .bas file and launch. 
No forms needed. step through to pull out what you want.

Side Effects:
Compiled under VB5/6 and ran on WinNT4 (server) and 
Windows2000 Professional. Don't know about the 9.x kernel, 
but it should be fine.

'used for dwPlatformId

Const VER_PLATFORM_WIN32s = 0
Const VER_PLATFORM_WIN32_WINDOWS = 1
Const VER_PLATFORM_WIN32_NT = 2
'used for wSuiteMask

Const VER_SUITE_BACKOFFICE = 4
Const VER_SUITE_DATACENTER = 128
Const VER_SUITE_ENTERPRISE = 2
Const VER_SUITE_SMALLBUSINESS = 1
Const VER_SUITE_SMALLBUSINESS_RESTRICTED = 32
Const VER_SUITE_TERMINAL = 16
'used for wProductType

Const VER_NT_WORKSTATION = 1
Const VER_NT_DOMAIN_CONTROLLER = 2
Const VER_NT_SERVER = 3
Const MAX_PATH = 260

Private Type OSVERSIONINFOEX
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
wServicePackMajor As Integer
wServicePackMinor As Integer
wSuiteMask As Integer
wProductType As Byte
wReserved As Byte
End Type

Private Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA"( lpVersionInformation As OSVERSIONINFOEX ) As Long

Private Declare Function GetWindowsDirectory Lib "kernel32" _
Alias "GetWindowsDirectoryA" ( ByVal lpBuffer As String, _
ByVal nSize As Long ) As Long

Private Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" ( ByVal nBufferLength As Long, _
ByVal lpBuffer As String ) As Long

Private Declare Function GetTempFileName Lib "kernel32" _
Alias "GetTempFileNameA"( ByVal lpszPath As String, _
ByVal lpPrefixString As String, ByVal wUnique As Long, _
ByVal lpTempFileName As String ) As Long

Dim sSystemInfo As String
Dim OSVI As OSVERSIONINFOEX

Function fGetTempFile() As String
Dim sTempDir As String
sTempDir = fDirCheck(fGetTempDir())
Dim sPrefix As String
sPrefix = ""
Dim lUnique As Long
lUnique = 0
Dim lRet As Long
Dim sBuf As String * 512
lRet = GetTempFileName(sTempDir, sPrefix, lUnique, sBuf)
If InStr(1, sBuf, Chr(0)) > 0 Then
fGetTempFile = _
Left(sBuf, InStr(1, sBuf, Chr(0)) - 1)
Else
fGetTempFile = ""
End If
End Function

Function fGetWinDir() As String
Dim lRet As Long
Dim lSize As Long
Dim sBuf As String * MAX_PATH
lSize = MAX_PATH
lRet = GetWindowsDirectory(ByVal sBuf, ByVal lSize)
If InStr(1, sBuf, Chr(0)) > 0 Then
fGetWinDir = Left(sBuf, InStr(1, sBuf, Chr(0)) - 1)
Else
fGetWinDir = ""
End If
End Function

Function fDirCheck(sDirName As String) As String
fDirCheck = IIf(Right(sDirName, 1) = "\", _
sDirName, sDirName & "\")
End Function

Function fGetTempDir() As String
Dim lRet As Long
Dim lSize As Long
Dim sBuf As String * MAX_PATH
lSize = MAX_PATH
lRet = GetTempPath(ByVal lSize, sBuf)
If InStr(1, sBuf, Chr(0)) > 0 Then
fGetTempDir = Left(sBuf, InStr(2, sBuf, Chr(0)) - 1)
Else
fGetTempDir = ""
End If
End Function

Function fGetSystemInfo() As Boolean
Dim lRet As Long
Dim iNullPos As Integer
Dim colProdSuites As Collection
Dim vCurrProdSuite As Variant
OSVI.dwOSVersionInfoSize = Len(OSVI)
OSVI.szCSDVersion = Space(128)
lRet = GetVersionEx(OSVI)
If lRet = 0 Then
MsgBox ("Error" & vbCrLf & _
Err.LastDllError & " - " & Err.Description)
fGetSystemInfo = False
Exit Function
End If
'For major version number, minor version number,

'and build number, convert the value returned into a string.

sSystemInfo = "Major Version: " & _
Str(OSVI.dwMajorVersion) & vbCrLf
sSystemInfo = sSystemInfo + "Minor Version: " & _
Str(OSVI.dwMinorVersion) & vbCrLf
sSystemInfo = sSystemInfo + "Build Number: " & _
Str(OSVI.dwBuildNumber) & vbCrLf
'To determine the specific platform, use the constants you declared

'to evaluate dwPlatformId. Depending on the platform,

'check dwBuildNumber to determine the specific platform.

sSystemInfo = sSystemInfo + "Platform: "
Select Case OSVI.dwPlatformId
Case VER_PLATFORM_WIN32s
sSystemInfo = sSystemInfo & _
"Win32s On Windows 3.1" & vbCrLf
Case VER_PLATFORM_WIN32_WINDOWS
sSystemInfo = sSystemInfo & _
IIf(OSVI.dwBuildNumber = 0, _
"Windows 98", "Windows 95") & vbCrLf
Case VER_PLATFORM_WIN32_NT
sSystemInfo = sSystemInfo & _
IIf(OSVI.dwMajorVersion < 5, _
"Windows NT", "Windows 2000") & vbCrLf
End Select
'To determine service pack information, use the constants you

'declared to evaluate dwPlatformId. Depending on the platform,

'check szCSD Version to determine the specific service pack information.

Select Case OSVI.dwPlatformId
Case VER_PLATFORM_WIN32s
sSystemInfo = sSystemInfo & _
"No additional info on " & _
"Win32s On Windows 3.1." & vbCrLf
Case VER_PLATFORM_WIN32_WINDOWS
sSystemInfo = sSystemInfo & _
"Additional OS Info: " & _
OSVI.szCSDVersion & vbCrLf
Case VER_PLATFORM_WIN32_NT
If Asc(Left$(OSVI.szCSDVersion, 1)) = 0 Then
'leftmost char = null, this is an empty string

sSystemInfo = sSystemInfo & "Service Pack Install " _
& "Info: No Service Pack " & "Installed" & vbCrLf
Else
'find the null char in the string

iNullPos = InStr(OSVI.szCSDVersion, Chr(0))
sSystemInfo = sSystemInfo & "Service Pack Install " & "Info: " & _
Left$(OSVI.szCSDVersion, iNullPos - 1) & vbCrLf
End If
End Select
'For major service pack, major and minor version numbers,

'convert the values returned into a string.

sSystemInfo = sSystemInfo & "Service Pack Version: "
sSystemInfo = sSystemInfo & _
CStr(OSVI.wServicePackMajor) & "." & _
CStr(OSVI.wServicePackMinor) & vbCrLf
'To determine which product suite components are installed

'evaluate wSuiteMask and compare the value against the constants

'declared for the various product suites. Add information to the

'colProdSuite collection based on which product suit es are installed.

'This this value is a set of bit flags. Test against

'each bit mask, add found items to a VBcollection

Set colProdSuites = New Collection

If (OSVI.wSuiteMask And VER_SUITE_BACKOFFICE) = VER_SUITE_BACKOFFICE Then
colProdSuites.Add "Microsoft BackOffice components are installed."
End If

If (OSVI.wSuiteMask And VER_SUITE_DATACENTER) = VER_SUITE_DATACENTER Then
colProdSuites.Add "Windows 2000 Datacenter Server is installed."
End If

If (OSVI.wSuiteMask And VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE Then
colProdSuites.Add "Windows 2000 Advanced Server is installed."
End If

If (OSVI.wSuiteMask And VER_SUITE_SMALLBUSINESS) = VER_SUITE_SMALLBUSINESS Then
colProdSuites.Add "Microsoft Small Business Server is installed."
End If

If (OSVI.wSuiteMask And VER_SUITE_SMALLBUSINESS_RESTRICTED) = _
VER_SUITE_SMALLBUSINESS_RESTRICTED Then
colProdSuites.Add "Microsoft Small Business Server is installed " & _
"with the restrictive client license in force."
End If

If (OSVI.wSuiteMask And VER_SUITE_TERMINAL) = VER_SUITE_TERMINAL Then
colProdSuites.Add "Terminal Services is installed."
End If
'list all product suites available that were added to the collection object

sSystemInfo = sSystemInfo & "Product Suites: " & vbCrLf

For Each vCurrProdSuite In colProdSuites
sSystemInfo = sSystemInfo & vbCrLf & vbTab & vCurrProdSuite
Next

'To determine the product type, use the constants you

'declared to evaluate wProductType.

sSystemInfo = sSystemInfo & "Product Type: "

Select Case OSVI.wProductType
Case VER_NT_WORKSTATION
sSystemInfo = sSystemInfo & "Windows 2000 Professional"
Case VER_NT_DOMAIN_CONTROLLER
sSystemInfo = sSystemInfo & "Windows 2000 domain controller"
Case VER_NT_SERVER
sSystemInfo = sSystemInfo & "Windows 2000 Server"
End Select
fGetSystemInfo = True
End Function

Sub Main()
If fGetSystemInfo() Then
Dim sTmpFile As String
sTmpFile = fGetTempFile
Open sTmpFile For Output As #1
Print #1, sSystemInfo
Close #1
Dim sCmd As String
sCmd = fDirCheck(fGetWinDir()) & "Notepad.exe " & sTmpFile
Dim vRet As Variant
vRet = Shell(sCmd, vbNormalFocus)
End If
End Sub
Assumes:
Just copy the entire source to a .bas file and launch.
No forms needed. step through to pull out what you want.

Side Effects:
Compiled under VB5/6 and ran on WinNT4 (server) and
Windows2000 Professional. Don't know about the 9.x kernel,
but it should be fine.