VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsSysInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' -------------------------------------------------------------------------------
'
'   AVStoDVD - by MrC
'   File: clsSysInfo.cls
'   Purpose: Class that reads System Info
'   Requirement: modFileVersion.bas
'
' -------------------------------------------------------------------------------


Option Explicit
Option Compare Binary
Option Base 0



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

' Token Specific Access Rights
Private Const TOKEN_ASSIGN_PRIMARY = &H1
Private Const TOKEN_DUPLICATE = &H2
Private Const TOKEN_IMPERSONATE = &H4
Private Const TOKEN_QUERY = &H8
Private Const TOKEN_QUERY_SOURCE = &H10
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_ADJUST_GROUPS = &H40
Private Const TOKEN_ADJUST_DEFAULT = &H80
Private Const TOKEN_ELEVATION_TYPE As Long = 18
Private Const TOKEN_ELEVATION As Long = 20

' NT well-known SIDs
Private Const SECURITY_DIALUP_RID = &H1
Private Const SECURITY_NETWORK_RID = &H2
Private Const SECURITY_BATCH_RID = &H3
Private Const SECURITY_INTERACTIVE_RID = &H4
Private Const SECURITY_SERVICE_RID = &H6
Private Const SECURITY_ANONYMOUS_LOGON_RID = &H7
Private Const SECURITY_LOGON_IDS_RID = &H5
Private Const SECURITY_LOCAL_SYSTEM_RID = &H12
Private Const SECURITY_NT_NON_UNIQUE = &H15
Private Const SECURITY_BUILTIN_DOMAIN_RID = &H20
Private Const SECURITY_NT_AUTHORITY = &H5

' Well-known domain relative sub-authority values (RIDs)
Private Const DOMAIN_ALIAS_RID_ADMINS = &H220
Private Const DOMAIN_ALIAS_RID_USERS = &H221
Private Const DOMAIN_ALIAS_RID_GUESTS = &H222
Private Const DOMAIN_ALIAS_RID_POWER_USERS = &H223
Private Const DOMAIN_ALIAS_RID_ACCOUNT_OPS = &H224
Private Const DOMAIN_ALIAS_RID_SYSTEM_OPS = &H225
Private Const DOMAIN_ALIAS_RID_PRINT_OPS = &H226
Private Const DOMAIN_ALIAS_RID_BACKUP_OPS = &H227
Private Const DOMAIN_ALIAS_RID_REPLICATOR = &H228

' Fixed at this size for comfort. Could be bigger or made dynamic.
Private Const ANYSIZE_ARRAY As Long = 100

' Const for API SHGetFolderPath
Private Const CSIDL_FLAG_CREATE = &H8000&               'combine with CSIDL_ value to force
Private Const CSIDL_FLAG_MASK = &HFF00                  'mask for all possible flag values
Private Const SHGFP_TYPE_CURRENT = &H0                  'current value for user, verify it exists
Private Const SHGFP_TYPE_DEFAULT = &H1
Private Const CSIDL_INVALIDARG = &H80070057             'Invalid CSIDL Value

' Const for Windows NT 5 version
Private Const VER_PLATFORM_WIN32_NT = 2


' System Info Type (API GetSystemInfo)
Private Type SYSTEMINFO
   dwOemID As Long
   dwPageSize As Long
   lpMinimumApplicationAddress As Long
   lpMaximumApplicationAddress As Long
   dwActiveProcessorMask As Long
   dwNumberOfProcessors As Long
   dwProcessorType As Long
   dwAllocationGranularity As Long
   wProcessorLevel As Integer
   wProcessorRevision As Integer
End Type

' OS version type (API GetVersionEx)
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

' Memory Status Types (API GlobalMemoryStatus and GlobalMemoryStatusEx)
Private Type INT64
    LoPart As Long
    HiPart As Long
End Type

' SID Type (API AllocateAndInitializeSid)
Private Type SID_IDENTIFIER_AUTHORITY
    value(0 To 5) As Byte
End Type

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 MEMORYSTATUSEX
    Length As Long
    MemoryLoad As Long
    ulTotalPhys As INT64
    ulAvailPhys As INT64
    ulTotalPageFile As INT64
    ulAvailPageFile As INT64
    ulTotalVirtual As INT64
    ulAvailVirtual As INT64
    UlAvailExtendedVirtual As INT64
End Type

Private Type MungeLong
    LongA As Long
    LongB As Long
End Type

Private Type MungeCurr
    CurrA As Currency
End Type

Private Type SID_AND_ATTRIBUTES
    SID As Long
    Attributes As Long
End Type

Private Type TOKEN_GROUPS
    GroupCount As Long
    Groups(ANYSIZE_ARRAY) As SID_AND_ATTRIBUTES
End Type


' Enum type for API SHGetFolderPath
Public Enum CSIDL_SPECIALPATHCODE
    CSIDL_USER_STARTMENUPROGRAMS = 2            '{user}\Start Menu\Programs
    CSIDL_USER_DOCUMENTS = 5                    '{user}\My Documents
    CSIDL_USER_FAVORITES = 6                    '{user}\My Favorites
    CSIDL_USER_STARTMENUPROGRAMSSTARTUP = 7     '{user}\Start Menu\Programs\Startup
    CSIDL_USER_RECENTS = 8                      '{user}\My Recents
    CSIDL_USER_SENDTO = 9                       '{user}\SendTo
    CSIDL_USER_STARTMENU = 11                   '{user}\Start Menu
    CSIDL_USER_MUSIC = 13                       '{user}\My Music
    CSIDL_USER_VIDEOS = 14                      '{user}\My Videos
    CSIDL_USER_DESKTOP = 16                     '{user}\Desktop
    CSIDL_USER_NETWORK = 19                     '{user}\My Network
    CSIDL_FONTS = 20                            'System fonts
    CSIDL_USER_MODELS = 21                      '{user}\My Models
    CSIDL_COMMON_STARTMENU = 22                 '{all user}\Start Menu
    CSIDL_COMMON_STARTMENUPROGRAMS = 23         '{all user}\Start Menu\Programs
    CSIDL_COMMON_STARTMENUPROGRAMSSTARTUP = 24  '{all user}\Start Menu\Programs\Startup
    CSIDL_COMMON_DESKTOP = 25                   '{all user}\Desktop
    CSIDL_USER_APPDATA = 26                     '{user}\Application Data
    CSIDL_USER_PRINTERS = 27                    '{user}\Printers
    CSIDL_USER_LOCAL_APPDATA = 28               '{user}\Local Settings\Application Data
    CSIDL_COMMON_FAVORITES = 31                 '{all user}\Favorites
    CSIDL_USER_LOCAL_INTERNETCACHE = 32         '{user}\Local Settings\Internet Temporary Files
    CSIDL_USER_COOKIES = 33                     '{user}\My Cookies
    CSIDL_USER_LOCAL_HISTORY = 34               '{user}\Local Settings\History
    CSIDL_COMMON_APPDATA = 35                   '{all user}\Application Data
    CSIDL_WINDOWS = 36                          'Windows folder
    CSIDL_SYSTEM = 37                           'System folder
    CSIDL_PROGRAMFILES = 38                     'Program Files folder
    CSIDL_USER_PICTURES = 39                    '{user}\My Pictures
    CSIDL_USER = 40                             '{user} folder
    CSIDL_PROGRAMFILES_COMMON = 43              'Program Files\Common
    CSIDL_COMMON_MODELS = 45                    '{all user}\My Models
    CSIDL_COMMON_DOCUMENTS = 46                 '{all user}\My Documents
    CSIDL_COMMON_STARTMENUPROGRAMSADMTOOLS = 47 '{all user}\Start Menu\Programs\Administrative Tools
    CSIDL_COMMON_MUSIC = 53                     '{all user}\My Music
    CSIDL_COMMON_PICTURES = 54                  '{all user}\My Pictures
    CSIDL_COMMON_VIDEOS = 55                    '{all user}\My Videos
    CSIDL_RESOURCES = 56                        'Windows Resources folder
End Enum


' Class Module variable
Private mSysInfo As SYSTEMINFO
Private mStatus As MEMORYSTATUS
Private mStatusEx As MEMORYSTATUSEX
Private mStatusOldAPI As Boolean
Private mWinVerPlatformID As Integer
Private mWinVerMajor As Integer
Private mWinVerMinor As Integer
Private mWinVerBuild As Integer
Private mWinVerProdType As Integer
Private mWinVerServPackMajor As Integer
   
' API calls
Private Declare Sub GetSystemInfo Lib "KERNEL32" (lpSystemInfo As SYSTEMINFO)
Private Declare Sub GlobalMemoryStatus Lib "kernel32.dll" (ByRef lpBuffer As MEMORYSTATUS)
Private Declare Function GlobalMemoryStatusEx Lib "kernel32.dll" (ByRef lpBuffer As MEMORYSTATUSEX) As Long
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByRef Destination As Any, ByVal Length As Long)
Private Declare Function SHGetFolderPath Lib "shfolder.dll" Alias "SHGetFolderPathA" (ByVal hwndOwner As Long, ByVal nFolder As Long, ByVal hToken As Long, ByVal dwFlags As Long, ByVal pszPath As String) As Long
Private Declare Function GetVersionEx Lib "KERNEL32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFOEX) As Long
Private Declare Function GetSystemDirectory Lib "KERNEL32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetWindowsDirectory Lib "KERNEL32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetProcAddress Lib "KERNEL32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetModuleHandle Lib "KERNEL32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetCurrentProcess Lib "KERNEL32" () As Long
Private Declare Function IsWow64Process Lib "KERNEL32" (ByVal hProc As Long, ByRef bWow64Process As Boolean) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, ByRef TokenHandle As Long) As Long
Private Declare Function OpenThreadToken Lib "Advapi32" (ByVal ThreadHandle As Long, ByVal DesiredAccess As Long, ByVal OpenAsSelf As Long, TokenHandle As Long) As Long
Private Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal TokenInformationClass As Long, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength As Long) As Long
Private Declare Function IsUserAnAdmin Lib "Shell32.dll" Alias "#680" () As Integer
Private Declare Function GetCurrentThread Lib "KERNEL32" () As Long
Private Declare Function AllocateAndInitializeSid Lib "Advapi32" (pIdentifierAuthority As SID_IDENTIFIER_AUTHORITY, ByVal nSubAuthorityCount As Byte, ByVal nSubAuthority0 As Long, ByVal nSubAuthority1 As Long, ByVal nSubAuthority2 As Long, ByVal nSubAuthority3 As Long, ByVal nSubAuthority4 As Long, ByVal nSubAuthority5 As Long, ByVal nSubAuthority6 As Long, ByVal nSubAuthority7 As Long, lpPSid As Long) As Long
Private Declare Function RtlMoveMemory Lib "KERNEL32" (Dest As Any, Source As Any, ByVal lSize As Long) As Long
Private Declare Function IsValidSid Lib "Advapi32" (ByVal pSid As Long) As Long
Private Declare Function EqualSid Lib "Advapi32" (pSid1 As Any, pSid2 As Any) As Long
Private Declare Sub FreeSid Lib "Advapi32" (pSid As Any)
Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long


Private Sub Class_Initialize()

    Dim mOS As OSVERSIONINFOEX
    Dim sK32Ver As String
    Dim aK32Ver
    Dim bFlag As Boolean

    ' Get CPU information
    GetSystemInfo mSysInfo
    
    ' Get OS information
    mOS.dwOSVersionInfoSize = Len(mOS)
    GetVersionEx mOS
    With mOS
        mWinVerPlatformID = .dwPlatformId
        mWinVerMajor = .dwMajorVersion
        mWinVerMinor = .dwMinorVersion
        mWinVerBuild = .dwBuildNumber
        mWinVerProdType = .wProductType
        mWinVerServPackMajor = .wServicePackMajor
    End With
    sK32Ver = modFileVersion.GetFileVersion("kernel32.dll")
    aK32Ver = Split(sK32Ver, ".")
    If aK32Ver(0) <> "" And aK32Ver(1) <> "" And aK32Ver(2) <> "" Then
        Select Case aK32Ver(0)
        Case "6"
            If Val(aK32Ver(1)) > 2 Then
                bFlag = True
            End If
        Case "10"
            bFlag = True
        End Select
        If bFlag = True Then
            mWinVerMajor = Val(aK32Ver(0))
            mWinVerMinor = Val(aK32Ver(1))
            mWinVerBuild = Val(aK32Ver(2))
        End If
    End If
    
    ' Get mStatus information
    On Error GoTo notSupported
    ZeroMemory mStatusEx, Len(mStatusEx)
    mStatusEx.Length = Len(mStatusEx)
    If GlobalMemoryStatusEx(mStatusEx) = 0 Then
        GoTo notSupported
    End If

    Exit Sub

notSupported:
mStatusOldAPI = True  'darn, we need to use the old API.
ZeroMemory mStatus, Len(mStatus)
GlobalMemoryStatus mStatus

End Sub


' Get CPU Name (Needs module modReg.bas and modStr.bas)
Public Property Get ProcessorName() As String
    
    ProcessorName = modStr.RemoveCharBegEnd(modReg.EmiLeggiChiaveStringa("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0", "ProcessorNameString", ""), " ")
      
End Property
    

' Get CPU ID (Needs module modReg.bas and modStr.bas)
Public Property Get ProcessorID() As String
    
    ProcessorID = modStr.RemoveCharBegEnd(modReg.EmiLeggiChiaveStringa("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0", "Identifier", ""), " ")
    If ProcessorID = "" Then
        ProcessorID = "Type " & mSysInfo.dwProcessorType & ", Family " & mSysInfo.wProcessorLevel & ", Revision " & mSysInfo.wProcessorRevision & ", Model " & HiByte(mSysInfo.wProcessorRevision) & ", Stepping " & LoByte(mSysInfo.wProcessorRevision)
    End If
      
End Property


' Get CPU Speed (Needs module modReg.bas)
Public Property Get ProcessorSpeed() As Long
    
    ProcessorSpeed = modReg.EmiLeggiChiaveNumero("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0", "~MHz", 0)
      
End Property


' Get number of CPU (processors)
Public Property Get ProcessorNumber() As Long
    
    ProcessorNumber = mSysInfo.dwNumberOfProcessors
      
End Property


' Determine if the current OS is at least NT version 5 (Windows 2000 and higher)
Public Property Get OSIsNT5() As Boolean

    On Error Resume Next
    
    OSIsNT5 = False
    If mWinVerPlatformID = VER_PLATFORM_WIN32_NT And mWinVerMajor >= 5 Then OSIsNT5 = True
    
End Property


' Return current Windows PlatformID as string
Public Property Get WinVerPlatformID() As Integer

    WinVerPlatformID = mWinVerPlatformID
    
End Property


' Return current Windows major code as string
Public Property Get WinVerMajor() As Integer

    WinVerMajor = mWinVerMajor
    
End Property


' Return current Windows minor code as string
Public Property Get WinVerMinor() As Integer

    WinVerMinor = mWinVerMinor
    
End Property


' Return current Windows version as string
Public Property Get WinVerStr(Optional bVerbose As Boolean) As String

    'Source: https://en.wikipedia.org/wiki/Comparison_of_Microsoft_Windows_versions

    '               Win95   Win95   Win98   Win98   WinMe   WinNT4  Win2000 WinXP   Win2003
    '                       OSR2            SE                                      Server
    'PlatformID     1       1       1       1       1       2       2       2       2
    'Major Version  4       4       4       4       4       4       5       5       5
    'Minor Version  0       0       10      10      90      0       0       1       2
    'Build          950x    1111    1998    2222    3000    1381    2195    2600    3790
    
    
    '               Win     Win2008 Win7    Win2008 WinHome Win8    Win2012 Win8.1  Win2012 Win10
    '               Vista   Server          Server  Server          Server          Server
    '                                       R2      2011                            R2
    'PlatformID     2       2       2       2       2       2       2       2       2       2
    'Major Version  6       6       6       6       6       6       6       6       6       10
    'Minor Version  0       0       1       1       1       2       2       3       3       0
    'Build #1       6000    6001    7600    7600    8400    9200    9200    9600    9600    10240
    'Build #2       6002    6002    7601    7601
    'Product Type   1       2,3     1       2,3     ?       1       2,3     1       2,3     ?
    
    
    If mWinVerPlatformID = 1 Then
        If mWinVerMajor = 4 Then
            Select Case mWinVerMinor
            Case 0
                If InStr(1, mWinVerBuild, 950) <> 0 Then
                    WinVerStr = "Windows 95"
                ElseIf mWinVerBuild = 1111 Then
                    WinVerStr = "Windows 95 OSR2"
                End If
            Case 10
                Select Case mWinVerBuild
                Case 1998
                    WinVerStr = "Windows 98"
                Case 2222
                    WinVerStr = "Windows 98 SE"
                End Select
            Case 90
                WinVerStr = "Windows Me"
            End Select
        End If
    ElseIf mWinVerPlatformID = 2 Then
        Select Case mWinVerMajor
        Case 4
            WinVerStr = "Windows NT4"
        Case 5
            Select Case mWinVerMinor
            Case 0
                WinVerStr = "Windows 2000"
            Case 1
                WinVerStr = "Windows XP"
            Case 2
                WinVerStr = "Windows 2003 Server"
            End Select
        Case 6
            Select Case mWinVerMinor
            Case 0
                Select Case mWinVerProdType
                Case 1
                    WinVerStr = "Windows Vista"
                Case 2, 3
                    WinVerStr = "Windows 2008 Server"
                End Select
            Case 1
                Select Case mWinVerBuild
                Case 7600, 7601
                    Select Case mWinVerProdType
                    Case 1
                        WinVerStr = "Windows 7"
                    Case 2, 3
                        WinVerStr = "Windows 2008 Server R2"
                    End Select
                Case 8400
                    WinVerStr = "Windows Home Server 2011"
                End Select
            Case 2
                Select Case mWinVerProdType
                Case 1
                    WinVerStr = "Windows 8"
                Case 2, 3
                    WinVerStr = "Windows 2012 Server"
                End Select
            Case 3
                Select Case mWinVerProdType
                Case 1
                    WinVerStr = "Windows 8.1"
                Case 2, 3
                    WinVerStr = "Windows 2012 Server R2"
                End Select
            End Select
        Case 10
            Select Case mWinVerMinor
            Case 0
                WinVerStr = "Windows 10"
            End Select
        End Select
    End If
    If WinVerStr = "" Then
        WinVerStr = "Windows Unknown"
    End If
    If mWinVerServPackMajor <> 0 Then
        WinVerStr = WinVerStr & " - Service Pack " & mWinVerServPackMajor
    End If
    If bVerbose = True Then
        WinVerStr = WinVerStr & " (" & mWinVerMajor & "." & mWinVerMinor & "." & mWinVerBuild & ")" & IIf(IsHost64Bit = False, " 32 bit", " 64 bit")
    End If
    
End Property


' Return Total Phisical Memory
Public Property Get PhisicalMemoryTotal() As Double

    If mStatusOldAPI Then
        PhisicalMemoryTotal = mStatus.dwTotalPhys
    Else
        PhisicalMemoryTotal = LI2DBL(mStatusEx.ulTotalPhys.LoPart, mStatusEx.ulTotalPhys.HiPart)
    End If
    
End Property


' Return Available Phisical Memory
Public Property Get PhisicalMemoryAvailable() As Double

    If mStatusOldAPI Then
        PhisicalMemoryAvailable = mStatus.dwAvailPhys
    Else
        PhisicalMemoryAvailable = LI2DBL(mStatusEx.ulAvailPhys.LoPart, mStatusEx.ulAvailPhys.HiPart)
    End If
    
End Property


' Return Total Virtual Memory
Public Property Get VirtualMemoryTotal() As Double
    
    If mStatusOldAPI Then
        VirtualMemoryTotal = mStatus.dwTotalVirtual
    Else
        VirtualMemoryTotal = LI2DBL(mStatusEx.ulTotalVirtual.LoPart, mStatusEx.ulTotalVirtual.HiPart)
    End If
    
End Property


' Return Available Virtual Memory
Public Property Get VirtualMemoryAvailable() As Double
    
    If mStatusOldAPI Then
        VirtualMemoryAvailable = mStatus.dwAvailVirtual
    Else
        VirtualMemoryAvailable = LI2DBL(mStatusEx.ulAvailVirtual.LoPart, mStatusEx.ulAvailVirtual.HiPart)
    End If
    
End Property


' Return Memory Load
Public Property Get MemoryLoad() As Long
    
    If mStatusOldAPI Then
        MemoryLoad = mStatus.dwMemoryLoad
    Else
        MemoryLoad = mStatusEx.MemoryLoad
    End If

End Property


' Return Windows folder path
Public Property Get PathWindows() As String
   
   Dim WinDir As String
   Dim ResultCode As Long

   WinDir = Space$(260)
   ResultCode = GetWindowsDirectory(WinDir, 259)
   WinDir = Left$(WinDir, ResultCode)
   PathWindows = Trim$(WinDir)

End Property


' Return Windows SYSTEM folder path
Public Property Get PathSystem() As String
   
    Dim SysDir As String
    Dim ResultCode As Long

    On Error GoTo Err_Handling

    SysDir = Space$(260)
    ResultCode = GetSystemDirectory(SysDir, 259)
    SysDir = Left$(SysDir, ResultCode)
    PathSystem = Trim$(SysDir)
    
    Exit Property
    
Err_Handling:
PathSystem = ""

End Property


' Return Windows PROGRAMS folder path
Public Property Get PathPrograms() As String
   
    Dim ProgDir As String

    On Error GoTo Err_Handling

    ProgDir = SpecialPath(CSIDL_PROGRAMFILES)
    PathPrograms = Trim$(ProgDir)
    
    Exit Property
    
Err_Handling:
PathPrograms = ""

End Property


' Return Windows LOCALAPPDATA folder path for current user
Public Property Get PathLocalAppData() As String
   
    Dim ProgDir As String

    On Error GoTo Err_Handling

    ProgDir = SpecialPath(CSIDL_USER_LOCAL_APPDATA)
    PathLocalAppData = Trim$(ProgDir)
    
    Exit Property
    
Err_Handling:
PathLocalAppData = ""

End Property


' Return Windows DOCUMENTS folder path for current user
Public Property Get PathDocuments() As String
   
    Dim ProgDir As String

    On Error GoTo Err_Handling

    ProgDir = SpecialPath(CSIDL_USER_DOCUMENTS)
    PathDocuments = Trim$(ProgDir)
    
    Exit Property
    
Err_Handling:
PathDocuments = ""

End Property


' Return Windows VIDEOS folder path for current user
Public Property Get PathVideos() As String
   
    Dim ProgDir As String

    On Error GoTo Err_Handling

    ProgDir = SpecialPath(CSIDL_USER_VIDEOS)
    PathVideos = Trim$(ProgDir)
    
    Exit Property
    
Err_Handling:
PathVideos = ""

End Property


' Return Windows Special folder path. Return SystemDrive if SHGetFolderPath is unavailable
Public Property Get SpecialPath(SpecialPathCode As CSIDL_SPECIALPATHCODE) As String

    Dim lngReturn As Long
    Dim strPath As String

    On Error GoTo Err_Handling
    
    strPath = String(260, 0)
    lngReturn = SHGetFolderPath(0, SpecialPathCode, 0, SHGFP_TYPE_CURRENT, strPath)
    Select Case lngReturn
        Case 0  'OK
            SpecialPath = Left$(strPath, InStr(1, strPath, Chr(0)) - 1)
        Case 1  'Folder Does Not Exist
        Case CSIDL_INVALIDARG  'Folder Not Valid on this OS
    End Select
    If SpecialPath = "" Then SpecialPath = Environ("SystemDrive")

    Exit Property

Err_Handling:
SpecialPath = Environ("SystemDrive")

End Property


' Check if the current system is 64 bit
Public Property Get IsHost64Bit() As Boolean
    
    Dim Handle As Long
    Dim is64Bit As Boolean

    ' Assume initially that this is not a WOW64 process
    is64Bit = False

    ' Then try to prove that wrong by attempting to load the
    ' IsWow64Process function dynamically
    Handle = GetProcAddress(GetModuleHandle("kernel32"), "IsWow64Process")

    ' The function exists, so call it
    If Handle <> 0 Then
        IsWow64Process GetCurrentProcess(), is64Bit
    End If

    ' Return the value
    IsHost64Bit = is64Bit

End Property


' Check if current user has run the program with elevated privileges
Public Property Get ElevatedPrivileges() As Long

' -1 : Could not retrieve information
'  1 : CurrentUser is not using elevated privileges, or UAC is turned off
'  2 : CurrentUser is using elevated privileges
'  3 : CurrentUser is not using elevated privileges [not sure, found only one reference on the web]

    Dim sBuffer          As String
    Dim lRetLen          As Long
    Dim hToken           As Long
    Dim tkElevation      As Long
    
    sBuffer = String(255, 0)
    If OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hToken) = 0 Then
        'Err.Raise Err.LastDllError, , "Could not retrieve current Process Handle!"
        ElevatedPrivileges = -1
    Else
        If GetTokenInformation(hToken, TOKEN_ELEVATION_TYPE, tkElevation, 4, lRetLen) = 0 Then
            'Err.Raise Err.LastDllError, , "Could not retrieve Token Information!"
            ElevatedPrivileges = -1
        Else
            ElevatedPrivileges = tkElevation
        End If
        'If GetTokenInformation(hToken, TOKEN_ELEVATION, tkElevation, 4, lRetLen) = 0 Then
        '    'Err.Raise Err.LastDllError, , "Could not retrieve Token Information!"
        '    ElevatedPrivileges = -1
        'Else
        '    Select Case tkElevation
        '    Case 0
        '        ElevatedPrivileges = 0    ' not using elevated privileges
        '    Case Else
        '        ElevatedPrivileges = 1    ' using elevated privileges
        '    End Select
        'End If
        CloseHandle hToken
    End If

End Property


' Check if current user is an Administrator
' 100% reliable only up to WinXP
Public Property Get IsAdminXP() As Boolean

    IsAdminXP = IsUserAnAdmin()

End Property


' Returns True if the thread is running in the
' user context of the local Administrator account
' Example:
'   MsgBox "Current user is the Administrator: " & IsAdmin
Public Property Get IsAdmin() As Boolean
    
    Dim hProcessToken       As Long
    Dim BufferSize          As Long
    Dim psidAdmin           As Long
    Dim lResult             As Long
    Dim X                   As Integer
    Dim tpTokens            As TOKEN_GROUPS
    Dim tpSidAuth           As SID_IDENTIFIER_AUTHORITY
    Dim llRetVal            As Long
    Dim InfoBuffer()        As Long
    Dim sids()              As SID_AND_ATTRIBUTES
    
    IsAdmin = False
    tpSidAuth.value(5) = SECURITY_NT_AUTHORITY

     ' Obtain current process token
    If Not OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, True, _
        hProcessToken) Then
        Call OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, hProcessToken)
    End If
    If hProcessToken Then

         ' Deternine the buffer size required
        llRetVal = GetTokenInformation(hProcessToken, ByVal TokenGroups, 0, 0, _
            BufferSize) ' Determine required buffer size
        If BufferSize Then

            ReDim InfoBuffer((BufferSize \ 4) - 1) As Long
            ReDim sids(0 To tpTokens.GroupCount) As SID_AND_ATTRIBUTES
             ' Retrieve your token information
            lResult = GetTokenInformation(hProcessToken, ByVal TokenGroups, _
                InfoBuffer(0), BufferSize, BufferSize)

            If lResult <> 1 Then Exit Property

             ' Move it from memory into the token structure
            Call RtlMoveMemory(tpTokens, InfoBuffer(0), LenB(tpTokens))

             ' Retreive the admins sid pointer
            lResult = AllocateAndInitializeSid(tpSidAuth, 2, _
                SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, _
                0, 0, 0, psidAdmin)
            If lResult <> 1 Then Exit Property
            If IsValidSid(psidAdmin) Then
                For X = 0 To tpTokens.GroupCount

                     ' Run through your token sid pointers
                    If IsValidSid(tpTokens.Groups(X).SID) Then

                         ' Test for a match between the admin sid equalling
                         ' your Sid 's
                        If EqualSid(ByVal tpTokens.Groups(X).SID, _
                            ByVal psidAdmin) Then
                            IsAdmin = True
                            Exit For
                        End If
                    End If
                Next
            End If
            If psidAdmin Then Call FreeSid(psidAdmin)
        End If
        Call CloseHandle(hProcessToken)
    End If

End Property


Private Function HiByte(ByVal wParam As Integer) As Byte
   
  'note: VB4-32 users should declare this function As Integer
   HiByte = (wParam And &HFF00&) \ (&H100)

End Function


Private Function LoByte(ByVal wParam As Integer) As Byte

  'note: VB4-32 users should declare this function As Integer
   LoByte = wParam And &HFF&

End Function


Private Sub DBL2LI(ByVal Dbl As Double, ByRef LoPart As Long, ByRef HiPart As Long)
    
    Dim mungec As MungeCurr
    Dim mungeli As MungeLong
    
    mungec.CurrA = (Dbl / 10000#)
    LSet mungeli = mungec
    LoPart = mungeli.LongA
    HiPart = mungeli.LongB

End Sub


Private Function LI2DBL(LoPart As Long, HiPart As Long) As Double
    
    Dim mungel As MungeLong
    Dim mungec As MungeCurr
    
    mungel.LongA = LoPart
    mungel.LongB = HiPart
    LSet mungec = mungel
    LI2DBL = mungec.CurrA * 10000#

End Function

