VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsSystem"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'Class System Information

'GetVersionEx
' - Get Service Pack Information

Option Explicit

'--------------------------------------------------------------------------
'                           API DECLARATIONS
'--------------------------------------------------------------------------

Private Declare Function GetBinaryType _
        Lib "kernel32" _
        Alias "GetBinaryTypeA" ( _
            ByVal lpApplicationName As String, _
            lpBinaryType As Long) _
            As Long

Private Declare Function GetCommModemStatus _
        Lib "kernel32" ( _
            ByVal hFile As Long, _
            lpModemStat As Long) _
            As Long
             
Private Declare Function GetCommProperties _
        Lib "kernel32" ( _
            ByVal hFile As Long, _
            lpCommProp As COMMPROP) _
            As Long
             
Private Declare Function GetCommState _
        Lib "kernel32" ( _
            ByVal nCid As Long, _
            lpDCB As DCB) _
            As Long
             
Private Declare Function GetCommTimeouts _
        Lib "kernel32" ( _
            ByVal hFile As Long, _
            lpCommTimeouts As COMMTIMEOUTS) _
            As Long
                
Private Declare Function GetComputerName _
        Lib "kernel32" _
        Alias "GetComputerNameA" ( _
            ByVal lpBuffer As String, _
            nSize As Long) _
            As Long
            
Private Declare Function GetComputerNameW _
        Lib "kernel32" ( _
            lpBuffer As Any, _
            nSize As Long) _
            As Long
            
Private Declare Function GetDiskFreeSpace _
        Lib "kernel32" _
        Alias "GetDiskFreeSpaceA" ( _
            ByVal lpRootPathName As String, _
            lpSectorsPerCluster As Long, _
            lpBytesPerSector As Long, _
            lpNumberOfFreeClusters As Long, _
            lpTotalNumberOfClusters As Long) _
            As Long
            
Private Declare Function GetDriveType _
        Lib "kernel32" _
        Alias "GetDriveTypeA" ( _
            ByVal nDrive As String) _
            As Long
            
Private Declare Function GetEnvironmentVariable _
        Lib "kernel32" _
        Alias "GetEnvironmentVariableA" ( _
            ByVal lpName As String, _
            ByVal lpBuffer As String, _
            ByVal nSize As Long) _
            As Long
            
Private Declare Function GetPrinterDriverDirectory _
        Lib "winspool.drv" _
        Alias "GetPrinterDriverDirectoryA" ( _
            ByVal pName As String, _
            ByVal pEnvironment As String, _
            ByVal Level As Long, _
            pDriverDirectory As Byte, _
            ByVal cdBuf As Long, _
            pcbNeeded As Long) _
            As Long
            
Private Declare Function GetPrintProcessorDirectory _
        Lib "winspool.drv" _
        Alias "GetPrintProcessorDirectoryA" ( _
            ByVal pName As String, _
            ByVal pEnvironment As String, _
            ByVal Level As Long, _
            ByVal pPrintProcessorInfo As String, _
            ByVal cdBuf As Long, _
            pcbNeeded As Long) _
            As Long
            
Private Declare Function GetSystemDirectory _
        Lib "kernel32" _
        Alias "GetSystemDirectoryA" ( _
            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 GetTimeZoneInformation _
        Lib "kernel32" ( _
            lpTimeZoneInformation As TIME_ZONE_INFORMATION) _
            As Long
            
Private Declare Function GetUserName _
        Lib "advapi32.dll" _
        Alias "GetUserNameA" ( _
            ByVal lpBuffer As String, _
            nSize As Long) _
            As Long
            
Private Declare Function GetVersionEx _
        Lib "kernel32" _
        Alias "GetVersionExA" ( _
            lpVersionInformation As OSVERSIONINFO) _
            As Long
            
Private Declare Function GetVolumeInformation _
        Lib "kernel32" Alias "GetVolumeInformationA" ( _
            ByVal lpRootPathName As String, _
            ByVal lpVolumeNameBuffer As String, _
            ByVal nVolumeNameSize As Long, _
            lpVolumeSerialNumber As Long, _
            lpMaximumComponentLength As Long, _
            lpFileSystemFlags As Long, _
            ByVal lpFileSystemNameBuffer As String, _
            ByVal nFileSystemNameSize As Long) _
            As Long
            
Private Declare Function GetWindowsDirectory _
        Lib "kernel32" _
        Alias "GetWindowsDirectoryA" ( _
            ByVal lpBuffer As String, _
            ByVal nSize As Long) _
            As Long
        
Private Declare Sub GlobalMemoryStatus _
        Lib "kernel32" ( _
            lpBuffer As MEMORYSTATUS)
            
Private Declare Sub GetSystemInfo _
        Lib "kernel32" ( _
            lpSystemInfo As SYSTEM_INFO)
            
Private Declare Sub GetSystemTime Lib "kernel32" ( _
        lpSystemTime As SYSTEMTIME)
        
Private Declare Sub GetLocalTime Lib "kernel32" ( _
        lpSystemTime As SYSTEMTIME)

Private Declare Function GetEnvironmentStrings _
        Lib "kernel32" _
        Alias "GetEnvironmentStringsA" ( _
            ) _
            As String
        
Private Declare Function GetCommandLine _
        Lib "kernel32" _
        Alias "GetCommandLineA" ( _
            ) _
            As String
        
Private Declare Function GetCurrentTime _
        Lib "kernel32" Alias "GetTickCount" ( _
            ) _
            As Long
        
Private Declare Function ExitWindowsEx _
        Lib "user32" ( _
            ByVal uFlags As Long, _
            ByVal dwReserved As Long) _
            As Long
            
Private Declare Function InitiateSystemShutdown _
        Lib "advapi32.dll" _
        Alias "InitiateSystemShutdownA" ( _
            ByVal lpMachineName As String, _
            ByVal lpMessage As String, _
            ByVal dwTimeout As Long, _
            ByVal bForceAppsClosed As Long, _
            ByVal bRebootAfterShutdown As Long) _
            As Long
            
Private Declare Function LookupPrivilegeValue _
        Lib "advapi32.dll" _
        Alias "LookupPrivilegeValueA" ( _
            ByVal lpSystemName As String, _
            ByVal lpName As String, _
            lpLuid As LARGE_INTEGER) _
            As Long
            
Private Declare Function OpenProcessToken _
        Lib "advapi32.dll" ( _
            ByVal ProcessHandle As Long, _
            ByVal DesiredAccess As Long, _
            TokenHandle As Long) _
            As Long
            
Private Declare Function AdjustTokenPrivileges _
        Lib "advapi32.dll" ( _
            ByVal TokenHandle As Long, _
            ByVal DisableAllPrivileges As Long, _
            NewState As TOKEN_PRIVILEGES, _
            ByVal BufferLength As Long, _
            PreviousState As TOKEN_PRIVILEGES, _
            ReturnLength As Long) _
            As Long
            
Private Declare Sub CopyMemory _
        Lib "kernel32" _
        Alias "RtlMoveMemory" ( _
            Destination As Any, _
            Source As Any, _
            ByVal Length As Long)

'--------------------------------------------------------------------------
'                           USER DEFINED TYPES
'--------------------------------------------------------------------------

Private Type MEMORYSTATUS
        dwLength                            As Long
        dwMemoryLoad                        As Long
        dwTotalPhys                         As Long
        dwAvailPhys                         As Long
        dwTotalPageFile                     As Long
        dwAvailPageFile                     As Long
        dwTotalVirtual                      As Long
        dwAvailVirtual                      As Long
End Type

Private Type SYSTEMTIME
        wYear                               As Integer
        wMonth                              As Integer
        wDayOfWeek                          As Integer
        wDay                                As Integer
        wHour                               As Integer
        wMinute                             As Integer
        wSecond                             As Integer
        wMilliseconds                       As Integer
End Type

Private Type TIME_ZONE_INFORMATION
        Bias                                As Long
        StandardName(32)                    As Integer
        StandardDate                        As SYSTEMTIME
        StandardBias                        As Long
        DaylightName(32)                    As Integer
        DaylightDate                        As SYSTEMTIME
        DaylightBias                        As Long
End Type

Private Type SYSTEM_INFO
        dwOemID                             As Long
        dwPageSize                          As Long
        lpMinimumApplicationAddress         As Long
        lpMaximumApplicationAddress         As Long
        dwActiveProcessorMask               As Long
        dwNumberOrfProcessors               As Long
        dwProcessorType                     As Long
        dwAllocationGranularity             As Long
        dwReserved                          As Long
End Type

Private Type OSVERSIONINFO
        dwOSVersionInfoSize                 As Long
        dwMajorVersion                      As Long
        dwMinorVersion                      As Long
        dwBuildNumber                       As Long
        dwPlatformId                        As Long
        szCSDVersion                        As String * 128     'Maintenance string for PSS usage
End Type

Private Type DCB
        DCBlength                           As Long
        BaudRate                            As Long
        fBitFields                          As Long             'See Comments in Win32API.Txt
        wReserved                           As Integer
        XonLim                              As Integer
        XoffLim                             As Integer
        ByteSize                            As Byte
        Parity                              As Byte
        StopBits                            As Byte
        XonChar                             As Byte
        XoffChar                            As Byte
        ErrorChar                           As Byte
        EofChar                             As Byte
        EvtChar                             As Byte
        wReserved1                          As Integer          'Reserved; Do Not Use
End Type

Private Type COMMPROP
        wPacketLength                       As Integer
        wPacketVersion                      As Integer
        dwServiceMask                       As Long
        dwReserved1                         As Long
        dwMaxTxQueue                        As Long
        dwMaxRxQueue                        As Long
        dwMaxBaud                           As Long
        dwProvSubType                       As Long
        dwProvCapabilities                  As Long
        dwSettableParams                    As Long
        dwSettableBaud                      As Long
        wSettableData                       As Integer
        wSettableStopParity                 As Integer
        dwCurrentTxQueue                    As Long
        dwCurrentRxQueue                    As Long
        dwProvSpec1                         As Long
        dwProvSpec2                         As Long
        wcProvChar(1)                       As Integer
End Type

Private Type COMMTIMEOUTS
        ReadIntervalTimeout                 As Long
        ReadTotalTimeoutMultiplier          As Long
        ReadTotalTimeoutConstant            As Long
        WriteTotalTimeoutMultiplier         As Long
        WriteTotalTimeoutConstant           As Long
End Type

Private Type TOKEN_PRIVILEGES
    PrivilegeCount                          As Long
    Privileges                              As Long
End Type

Private Type LARGE_INTEGER
    LowPart                                 As Long
    HighPart                                As Long
End Type

Private Type LUID
    LowPart                                 As Long
    HighPart                                As Long
End Type

Private Type LUID_AND_ATTRIBUTES
        pLuid                               As Long
        Attributes                          As Long
End Type
'--------------------------------------------------------------------------
'                           CONSTANTS
'--------------------------------------------------------------------------

Private Const VER_PLATFORM_WIN32_NT         As Long = 2
Private Const VER_PLATFORM_WIN32_WINDOWS    As Long = 1
Private Const VER_PLATFORM_WIN32s           As Long = 0

Private Const TokenDefaultDacl              As Long = 6
Private Const TokenGroups                   As Long = 2
Private Const TokenImpersonationLevel       As Long = 9
Private Const TokenOwner                    As Long = 4
Private Const TokenPrimaryGroup             As Long = 5
Private Const TokenPrivileges = 3
Private Const TokenSource                   As Long = 7
Private Const TokenStatistics               As Long = 10
Private Const TokenType                     As Long = 8
Private Const TokenUser                     As Long = 1

Private Const EWX_FORCE                     As Long = 4
Private Const EWX_LOGOFF                    As Long = 0
Private Const EWX_REBOOT                    As Long = 2
Private Const EWX_SHUTDOWN                  As Long = 1

Private Const DRIVE_REMOVABLE               As Long = 2
Private Const DRIVE_FIXED                   As Long = 3
Private Const DRIVE_REMOTE                  As Long = 4
Private Const DRIVE_CDROM                   As Long = 5
Private Const DRIVE_RAMDISK                 As Long = 6


'--------------------------------------------------------------------------
'                           VARIABLES
'--------------------------------------------------------------------------


'--------------------------------------------------------------------------
'                         CLASS METHODS
'--------------------------------------------------------------------------

Public Function GetOSVersionName() As String
    
    Dim udtVersionInfo          As OSVERSIONINFO        'OSVERSIONINFO Variable Rep
    Dim lngBuildNumber          As Long                 'Holds the OS Build Number
    Dim lngPlatform             As Long                 'Holds the OS Platform
    Dim lngCSDVersion           As Long                 'Holds the Corrective Service Disk (CSD) version
    Dim strVersionNumber        As String               'Holds the OS version number
    Dim strVersionName          As String               'Holds the OS Name
    Dim strOSVersion            As String
    Dim strOSFullPlatform       As String
    
    'Set the size of the sructure
    udtVersionInfo.dwOSVersionInfoSize = Len(udtVersionInfo)
    
    'If GetVersionEx has a value greater than 0 then the
    'function has returned true
    If GetVersionEx(udtVersionInfo) = 1 Then
        'Copy the PlatformID into a buffer
        lngPlatform = udtVersionInfo.dwPlatformId
        'Choose the platform
        Select Case udtVersionInfo.dwPlatformId
            'In the case of a 32-bit OS
            Case VER_PLATFORM_WIN32s
                strVersionName = "32-bit Windows"
            'In the case of Windows NT
            Case VER_PLATFORM_WIN32_NT
                strVersionName = "Windows NT"
                'Determine which OS is being used by choosing from the Major
                'part of the version number
                Select Case udtVersionInfo.dwMajorVersion
                    Case 4
                        'If the Major part is 4 then the OS is Windows NT
                        'Version 4
                        strVersionName = "Windows NT"
                    Case 5
                        'If the major part is 5 then we have to check to see if the OS is
                        'Windows XP or Windows 2000. This time we are selcting from the minor
                        'part of the version number
                        Select Case udtVersionInfo.dwMinorVersion
                            Case 0
                                'Windows 2000 v5.0
                                strVersionName = "Windows 2000"
                            Case 1
                                'Windows XP v5.1
                                strVersionName = "Windows XP"
                        End Select
                End Select
            'In the case of a 32-bit Window OS
            Case VER_PLATFORM_WIN32_WINDOWS
                'Select the minor versions of the the 9x and ME windows OS
                ' as the Major parts begin with 4.
                Select Case udtVersionInfo.dwMinorVersion
                    Case 0
                        'Windows 95 v4.0
                        strVersionName = "Windows 95"
                    Case 10
                        'Windows 98 v4.10
                        strVersionName = "Windows 98"
                    Case Else
                        'If it is not the above 2 then the OS in use is
                        'Windows ME v4.90
                        strVersionName = "Windows ME"
                End Select
            End Select
        End If
        'Copy the version name to the procedure
        strOSVersion = udtVersionInfo.dwMajorVersion & udtVersionInfo.dwMinorVersion
        strOSFullPlatform = strVersionName & strOSVersion
        GetOSVersionName = strOSFullPlatform
End Function

Public Function IsWinXP() As Boolean

'This procedure is used to determine if the OS used on the host machine is windows
'XP, if GetVersionEx returns a value of 1 then GetVersionEx returns true otherwise
'the value is 0, which is false.

    Dim udtVersionInfo      As OSVERSIONINFO        'Holds the properties for the OSVERSIONINFO structure
    
    udtVersionInfo.dwOSVersionInfoSize = Len(udtVersionInfo)
    'Check to see if GetVersionEx has a value
    If GetVersionEx(udtVersionInfo) = 1 Then
        'Windows XP is a 32-bit OS based on NT technology, here we are indicating the
        'the platform and the version number for Windows XP (version 5.1)
        IsWinXP = udtVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT And _
                    udtVersionInfo.dwMajorVersion = 5 And udtVersionInfo.dwMinorVersion = 1
    
    End If

End Function

Public Function IsWinME() As Boolean

'This procedure is used to determine if the OS used on the host machine is windows
'ME, if GetVersionEx returns a value of 1 then GetVersionEx returns true otherwise
'the value is 0, which is false.

    Dim udtVersionInfo      As OSVERSIONINFO        'Holds the properties for the OSVERSIONINFO structure
    
    udtVersionInfo.dwOSVersionInfoSize = Len(udtVersionInfo)
    'Check to see if GetVersionEx has a value
    If GetVersionEx(udtVersionInfo) = 1 Then
        'Windows ME is a 16/32-bit hybrid OS, here we are indicating the
        'the platform and the version number for Windows ME (version 4.90)
        IsWinME = udtVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT And _
                    udtVersionInfo.dwMajorVersion = 4 And udtVersionInfo.dwMinorVersion = 90
    
    End If

End Function

Public Function IsWin2K() As Boolean

'This procedure is used to determine if the OS used on the host machine is windows
'2000, if GetVersionEx returns a value of 1 then GetVersionEx returns true otherwise
'the value is 0, which is false.

    Dim udtVersionInfo      As OSVERSIONINFO        'Holds the properties for the OSVERSIONINFO structure
    
    udtVersionInfo.dwOSVersionInfoSize = Len(udtVersionInfo)
    'Check to see if GetVersionEx has a value
    If GetVersionEx(udtVersionInfo) = 1 Then
        'Windows 2000 is a 32-bit OS based on NT technology, here we are indicating the
        'the platform and the version number for Windows ME (version 5.0)
        IsWin2K = udtVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT And _
                    udtVersionInfo.dwMajorVersion = 5 And udtVersionInfo.dwMinorVersion = 0
    
    End If

End Function

Public Function IsWinNT() As Boolean

'This procedure is used to determine if the OS used on the host machine is windows
'NT, if GetVersionEx returns a value of 1 then GetVersionEx returns true otherwise
'the value is 0, which is false.

    Dim udtVersionInfo      As OSVERSIONINFO        'Holds the properties for the OSVERSIONINFO structure
    
    udtVersionInfo.dwOSVersionInfoSize = Len(udtVersionInfo)
    'Check to see if GetVersionEx has a value
    If GetVersionEx(udtVersionInfo) = 1 Then
        'Windows NT was the first 32-bit windows OS, here we are indicating the
        'the platform and the version number for Windows NT (version 4)
        IsWinNT = udtVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT And _
                    udtVersionInfo.dwMajorVersion = 4
    
    End If

End Function

Public Function IsWin98() As Boolean

'This procedure is used to determine if the OS used on the host machine is windows
'98, if GetVersionEx returns a value of 1 then GetVersionEx returns true otherwise
'the value is 0, which is false.

    Dim udtVersionInfo      As OSVERSIONINFO        'Holds the properties for the OSVERSIONINFO structure
    
    udtVersionInfo.dwOSVersionInfoSize = Len(udtVersionInfo)
    'Check to see if GetVersionEx has a value
    If GetVersionEx(udtVersionInfo) = 1 Then
        'Windows 98 is a 16/32-bit hybrid OS. Here we are indicating the platform
        'and the version number form Windows 98(version 4.10)
        IsWin98 = udtVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT And _
                    udtVersionInfo.dwMajorVersion = 4 And udtVersionInfo.dwMinorVersion = 10
    
    End If

End Function

Public Function IsWin95() As Boolean

'This procedure is used to determine if the OS used on the host machine is windows
'95, if GetVersionEx returns a value of 1 then GetVersionEx returns true otherwise
'the value is 0, which is false.

    Dim udtVersionInfo      As OSVERSIONINFO        'Holds the properties for the OSVERSIONINFO structure
    
    udtVersionInfo.dwOSVersionInfoSize = Len(udtVersionInfo)
    'Check to see if GetVersionEx has a value
    If GetVersionEx(udtVersionInfo) = 1 Then
        'Windows 95 is a 16/32-bit. Here we are indicating the platform
        'and the version number form Windows 95(version 4.0)
        IsWin95 = udtVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT And _
                    udtVersionInfo.dwMajorVersion = 4 And udtVersionInfo.dwMinorVersion = 0
    
    End If

End Function

Public Function GetCompName(ByRef strComputerName As String) As Long
    
    Dim strBuffer           As String
    Dim lngBufferSize       As Long
    
    lngBufferSize = 255
    strBuffer = Space(lngBufferSize)
    
    GetCompName = GetComputerName(strBuffer, lngBufferSize)
    
    If GetCompName <> 0 Then
        strComputerName = Left(strBuffer, lngBufferSize)
    Else
        strComputerName = ""
    End If
    
End Function

Public Function GetCurrentUser(ByRef strUsername As String) As Long
    
    Dim strBuffer           As String
    Dim lngBufferSize       As Long
    
    lngBufferSize = 255
    strBuffer = Space(lngBufferSize)
    
    GetCurrentUser = GetUserName(strBuffer, lngBufferSize)
    
    If GetCurrentUser <> 0 Then
        strUsername = Left(strBuffer, lngBufferSize)
    Else
        strUsername = ""
    End If
    
End Function

Public Function GetSysDir(ByRef strSystemDirectory As String) As Long

    Dim strBuffer           As String
    Dim lngBufferSize       As Long
    
    lngBufferSize = 255
    strBuffer = Space(lngBufferSize)
    
    GetSysDir = GetSystemDirectory(strBuffer, lngBufferSize)
    
    If GetSysDir <> 0 Then
        strSystemDirectory = Left(strBuffer, lngBufferSize)
    Else
        strSystemDirectory = ""
    End If

End Function

Public Function GetWinDir(ByRef strWindowsDirectory As String) As Long

    Dim strBuffer           As String
    Dim lngBufferSize       As Long
    
    lngBufferSize = 255
    strBuffer = Space(lngBufferSize)
    
    GetWinDir = GetWindowsDirectory(strBuffer, lngBufferSize)
    
    If GetWinDir <> 0 Then
        strWindowsDirectory = Left(strBuffer, lngBufferSize)
    Else
        strWindowsDirectory = ""
    End If

End Function

Public Function GetTmpPath(ByRef strTemporaryDirectory As String) As Long

    Dim strBuffer           As String
    Dim lngBufferSize       As Long
    
    lngBufferSize = 255
    strBuffer = Space(lngBufferSize)
    
    GetTmpPath = GetTempPath(lngBufferSize, strBuffer)
    
    If GetTmpPath <> 0 Then
        strTemporaryDirectory = Left(strBuffer, lngBufferSize)
    Else
        strTemporaryDirectory = ""
    End If

End Function

Public Function GetSpecifiedDriveType(ByVal strDriveLetter As String, _
                                      ByRef strDriveBuffer As String)

    Select Case GetDriveType(strDriveLetter)
        Case DRIVE_REMOVABLE
            strDriveBuffer = "Removable"
        Case DRIVE_FIXED
            strDriveBuffer = "Fixed"
        Case DRIVE_REMOTE
            strDriveBuffer = "Remote"
        Case DRIVE_CDROM
            strDriveBuffer = "CD-ROM"
        Case DRIVE_RAMDISK
            strDriveBuffer = "Virtual"
        Case Else
            strDriveBuffer = "Unrecognized"
    End Select

End Function