Attribute VB_Name = "mod_Engineering"
Option Explicit

Public 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

Public Type OSVERSIONINFO '
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long           '1 = Windows 95/98
                                  '2 = Windows NT
   szCSDVersion As String * 128
End Type

Public Type SYSTEM_INFO
    dwOemID As Long
    dwPageSize As Long
    lpMinimumApplicationAddress As Long
    lpMaximumApplicationAddress As Long
    dwActiveProcessorMask As Long
    dwNumberOfProcessors As Long
    dwProcessorType As Long
    dwAllocationGranularity As Long
    dwReserved As Long
End Type

Private Type VS_FIXEDFILEINFO
    dwSignature As Long
    dwStrucVersionl As Integer ' e.g. = &h0000 = 0
    dwStrucVersionh As Integer ' e.g. = &h0042 = .42
    dwFileVersionMSl As Integer ' e.g. = &h0003 = 3
    dwFileVersionMSh As Integer ' e.g. = &h0075 = .75
    dwFileVersionLSl As Integer ' e.g. = &h0000 = 0
    dwFileVersionLSh As Integer ' e.g. = &h0031 = .31
    dwProductVersionMSl As Integer ' e.g. = &h0003 = 3
    dwProductVersionMSh As Integer ' e.g. = &h0010 = .1
    dwProductVersionLSl As Integer ' e.g. = &h0000 = 0
    dwProductVersionLSh As Integer ' e.g. = &h0031 = .31
    dwFileFlagsMask As Long ' = &h3F For version "0.42"
    dwFileFlags As Long ' e.g. VFF_DEBUG Or VFF_PRERELEASE
    dwFileOS As Long ' e.g. VOS_DOS_WINDOWS16
    dwFileType As Long ' e.g. VFT_DRIVER
    dwFileSubtype As Long ' e.g. VFT2_DRV_KEYBOARD
    dwFileDateMS As Long ' e.g. 0
    dwFileDateLS As Long ' e.g. 0
End Type

Public Const ERROR_BADKEY = 2
Public Const ERROR_NONE = 0
Public Const HKEY_CURRENT_USER = &H80000001
Public Const KEY_ALL_ACCESS = &H3F
Public Const PROCESSOR_INTEL_386 = 386
Public Const PROCESSOR_INTEL_486 = 486
Public Const PROCESSOR_INTEL_PENTIUM = 586
Public Const PROCESSOR_MIPS_R4000 = 4000
Public Const PROCESSOR_ALPHA_21064 = 21064
Public Const REG_DWORD As Long = 4
Public Const REG_SZ As Long = 1
Public Const VER_PLATFORM_WIN32_NT = 2
Public Const VER_PLATFORM_WIN32_WINDOWS = 1

Private Const MaxPath = 260

Public Declare Function apiCompName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function apiDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Public Declare Function apiDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, lpFreeBytesAvailableToCallers As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long
Public Declare Function apiDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Declare Function apiSerialNumber 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
Public Declare Function apiUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
Public Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Integer
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Public Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Public Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Public Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Public Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long

Public Declare Sub apiSystemInfo Lib "kernel32" Alias "GetSystemInfo" (lpSystemInfo As SYSTEM_INFO)
Public Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Public Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal Length As Long)

Public intRemovable As Long
Public intNotRemovable As Long
Public intCD As Long
Public intRAM As Long
Public intNetwork As Long
Public OSBuild As Long
Public text0 As String
Public text1 As String
Public text2 As String
Public text3 As String
Public text4 As String

Public Function IsWindowsNT() As Boolean
    Dim OSInfo As OSVERSIONINFO

    With OSInfo
        .dwOSVersionInfoSize = Len(OSInfo)
        .szCSDVersion = Space$(128)
        GetVersionEx OSInfo
        IsWindowsNT = (.dwPlatformId = VER_PLATFORM_WIN32_NT)
    End With
End Function

Public Function Level(mytxtbox As TextBox) As String
    Dim OSInfo As OSVERSIONINFO
    Dim strTemp As String
    Dim lngWidth As Long
    Dim lngFont As Long
    Dim memsts As MEMORYSTATUS
    Dim memory As Long
    Dim lngloop As Long
    Dim textU As String
    Dim textV As String
    Dim textW As String
    Dim textX As String
    Dim textY As String
    Dim textZ As String
    Dim textA As String
    Dim TotalSpace As Double
    Dim FreeSpace As Double
    
    
    lngWidth = 20
    
    frmMain.FontName = mytxtbox.FontName
    frmMain.FontSize = mytxtbox.FontSize
    lngFont = frmMain.TextWidth(" ")
    
    lngWidth = Int(((mytxtbox.Width / lngFont) - 4) / 2)
    
    strTemp = "Unknown"
    With OSInfo
        .dwOSVersionInfoSize = Len(OSInfo)
        GetVersionEx OSInfo
        If (.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS) And (.dwMajorVersion = 4 And .dwMinorVersion = 0) Then
            strTemp = "Windows 95"
        End If
        If (.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS) And ((.dwMajorVersion > 4) Or (.dwMajorVersion = 4 And .dwMinorVersion = 10)) Then
            strTemp = "Windows 98"
        End If
        If (.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS) And (.dwMajorVersion = 4 And .dwMinorVersion = 90) Then
            strTemp = "Windows ME"
        End If
        If (.dwPlatformId = VER_PLATFORM_WIN32_NT) And (.dwMajorVersion <= 4) Then
            strTemp = "Windows NT"
        End If
        If (.dwPlatformId = VER_PLATFORM_WIN32_NT) And (.dwMajorVersion > 4 And .dwMinorVersion < 1) Then
            strTemp = "Windows 2000"
        End If
        If (.dwPlatformId = VER_PLATFORM_WIN32_NT) And (.dwMajorVersion > 4 And .dwMinorVersion >= 1) Then
            strTemp = "Windows XP"
        End If
    End With
    INI_GetKey "INFO", "01", strProgramdir & strThemedir & strThemeName & ".skn"
    mytxtbox.Text = Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, lngWidth)

    INI_GetKey "INFO", "02", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = CStr(OSInfo.dwMajorVersion) & "." & CStr(OSInfo.dwMinorVersion)
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, lngWidth)

    INI_GetKey "INFO", "03", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = CStr(OSInfo.dwBuildNumber)
    OSBuild = OSInfo.dwBuildNumber
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, lngWidth)

    INI_GetKey "INFO", "04", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = Level_UserName
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, lngWidth)

    INI_GetKey "INFO", "05", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = Level_WindowsDirectory
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, lngWidth)

    INI_GetKey "INFO", "06", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = Level_SystemDirectory
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, lngWidth)

    INI_GetKey "INFO", "07", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = Level_TempPath
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, lngWidth)

    INI_GetKey "INFO", "08", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = Level_ComputerName
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, lngWidth)

    INI_GetKey "INFO", "09", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = Level_CPUCount
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, lngWidth)

    INI_GetKey "INFO", "10", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = "#" & Level_CPUActive
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, lngWidth)

    INI_GetKey "INFO", "11", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = Level_CPUType
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, lngWidth)


    GlobalMemoryStatus memsts
    memory = memsts.dwTotalPhys
    INI_GetKey "INFO", "12", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = Format$(memory \ 1024, "###,###,###") & "K"
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, 12, False)
             
    memory& = memsts.dwAvailPhys
    INI_GetKey "INFO", "13", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = Format$(memory \ 1024, "###,###,###") & "K"
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, 12, False)
             
    memory& = memsts.dwTotalVirtual
    INI_GetKey "INFO", "14", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = Format$(memory \ 1024, "###,###,###") & "K"
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, 12, False)
    
    memory& = memsts.dwAvailVirtual
    INI_GetKey "INFO", "15", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = Format$(memory \ 1024, "###,###,###") & "K"
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, 12, False)

    mytxtbox.Text = mytxtbox.Text & vbCrLf
    frmMain.File1.Pattern = "*.exe"
    frmMain.File1.Path = strProgramdir
    For lngloop = 0 To frmMain.File1.ListCount - 1
        strTemp = Level_CheckFileVersion(strProgramdir & "\" & frmMain.File1.List(lngloop))
        If Right(strTemp, 6) = ".0.0.0" Then
            strTemp = "Version " & Left(strTemp, InStr(strTemp, ".") - 1) & ".0.0.0 " & Format(FileDateTime(strProgramdir & "\" & frmMain.File1.List(lngloop)), "yyyymmdd")
        End If
        mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(frmMain.File1.List(lngloop), lngWidth) & " " & Pad(strTemp, lngWidth)
    Next

    mytxtbox.Text = mytxtbox.Text & vbCrLf

    intRemovable = 0
    intNotRemovable = 0
    intCD = 0
    intRAM = 0
    intNetwork = 0
    For lngloop = 0 To frmMain.Drive1.ListCount - 1
        Level_DriveCount (Left(frmMain.Drive1.List(lngloop), 2) & "\")
    Next

    INI_GetKey "INFO", "16", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = CStr(intRemovable)
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, lngWidth)

    INI_GetKey "INFO", "17", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = CStr(intNotRemovable)
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, lngWidth)

    INI_GetKey "INFO", "18", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = CStr(intCD)
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, lngWidth)

    INI_GetKey "INFO", "19", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = CStr(intRAM)
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, lngWidth)

    INI_GetKey "INFO", "20", strProgramdir & strThemedir & strThemeName & ".skn"
    strTemp = CStr(intNetwork)
    mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(CStr(iniValue), lngWidth) & " " & Pad(strTemp, lngWidth)


    INI_GetKey "INFO", "21", strProgramdir & strThemedir & strThemeName & ".skn"
    textU = iniValue
    INI_GetKey "INFO", "22", strProgramdir & strThemedir & strThemeName & ".skn"
    textV = iniValue
    INI_GetKey "INFO", "23", strProgramdir & strThemedir & strThemeName & ".skn"
    textW = iniValue
    INI_GetKey "INFO", "24", strProgramdir & strThemedir & strThemeName & ".skn"
    textX = iniValue
    INI_GetKey "INFO", "25", strProgramdir & strThemedir & strThemeName & ".skn"
    textY = iniValue
    INI_GetKey "INFO", "26", strProgramdir & strThemedir & strThemeName & ".skn"
    textZ = iniValue

    INI_GetKey "INFO", "27", strProgramdir & strThemedir & strThemeName & ".skn"
    text0 = iniValue
    INI_GetKey "INFO", "28", strProgramdir & strThemedir & strThemeName & ".skn"
    text1 = iniValue
    INI_GetKey "INFO", "29", strProgramdir & strThemedir & strThemeName & ".skn"
    text2 = iniValue
    INI_GetKey "INFO", "30", strProgramdir & strThemedir & strThemeName & ".skn"
    text3 = iniValue
    INI_GetKey "INFO", "31", strProgramdir & strThemedir & strThemeName & ".skn"
    text4 = iniValue

    INI_GetKey "INFO", "32", strProgramdir & strThemedir & strThemeName & ".skn"
    textA = iniValue
    
    For lngloop = 0 To frmMain.Drive1.ListCount - 1
    
        mytxtbox.Text = mytxtbox.Text & vbCrLf
        mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(textU & " " & Left(frmMain.Drive1.List(lngloop), 2), lngWidth)
        mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(textV, lngWidth) & " " & Level_DriveType(Left(frmMain.Drive1.List(lngloop), 2) & "\")
        Level_DriveInfo Left(frmMain.Drive1.List(lngloop), 2) & "\", TotalSpace, FreeSpace
        strTemp = level_PutPoints(TotalSpace)
        mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(textW, lngWidth) & " " & Pad(strTemp + " Bytes", lngWidth)
        mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(textX, lngWidth) & " " & Pad(Pad(level_PutPoints(FreeSpace), Len(strTemp), False) + " Bytes", lngWidth)
        If TotalSpace = 0 And FreeSpace = 0 Then
            mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(textY, lngWidth) & " " & Pad(textA, lngWidth)
            mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(textZ, lngWidth) & " " & Pad("0000-0000", lngWidth)
        Else
            mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(textY, lngWidth) & " " & Pad(Level_VolumeLabel(Left(frmMain.Drive1.List(lngloop), 2) & "\"), lngWidth)
            mytxtbox.Text = mytxtbox.Text & vbCrLf & Pad(textZ, lngWidth) & " " & Pad(Level_SerialNumber(Left(frmMain.Drive1.List(lngloop), 2) & "\"), lngWidth)
        End If
    Next
    
    'mytxtbox.Text = mytxtbox.Text & vbCrLf & vbCrLf & txtMixer & vbCrLf


End Function

Public Function Level_CheckFileVersion(FilenameAndPath As Variant) As Variant
    On Error GoTo HandelCheckFileVersionError
    Dim lDummy As Long, lsize As Long, rc As Long
    Dim lVerbufferLen As Long, lVerPointer As Long
    Dim sBuffer() As Byte
    Dim udtVerBuffer As VS_FIXEDFILEINFO
    Dim ProdVer As String
    lsize = GetFileVersionInfoSize(FilenameAndPath, lDummy)
    If lsize < 1 Then Exit Function
    ReDim sBuffer(lsize)
    rc = GetFileVersionInfo(FilenameAndPath, 0&, lsize, sBuffer(0))
    rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
    MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer)
    '**** Determine Product Version number *
    '     ***
    'ProdVer = Format$(udtVerBuffer.dwProductVersionMSh) & "." & Format$(udtVerBuffer.dwProductVersionMSl)
    ProdVer = Format$(udtVerBuffer.dwProductVersionMSh) & "." & Format$(udtVerBuffer.dwProductVersionMSl) & "." & Format$(udtVerBuffer.dwProductVersionLSh) & "." & Format$(udtVerBuffer.dwProductVersionLSl)
    
    Level_CheckFileVersion = ProdVer
    Exit Function
HandelCheckFileVersionError:
    Level_CheckFileVersion = "N/A"
    Exit Function
End Function

Private Function Level_ComputerName() As String
    Dim Bufstr As String
    Bufstr = Space$(50)
    
    If apiCompName(Bufstr, 50) > 0 Then
        Level_ComputerName = Bufstr
        Level_ComputerName = RTrim(Level_ComputerName)
        Level_ComputerName = Level_StripTerminator(Level_ComputerName)
    Else
        Level_ComputerName = ""
    End If
End Function

Public Function Level_CPUActive() As String
    Dim SI As SYSTEM_INFO

    apiSystemInfo SI
    Level_CPUActive = CStr(SI.dwActiveProcessorMask)
End Function

Public Function Level_CPUCount() As String
    Dim SI As SYSTEM_INFO

    apiSystemInfo SI
    Level_CPUCount = CStr(SI.dwNumberOfProcessors)
End Function

Public Function Level_CPUType() As String
    Dim SI As SYSTEM_INFO

    apiSystemInfo SI
    Select Case SI.dwProcessorType
        Case PROCESSOR_INTEL_386
            Level_CPUType = "Intel 386"
        Case PROCESSOR_INTEL_486
            Level_CPUType = "Intel 486"
        Case PROCESSOR_INTEL_PENTIUM
            Level_CPUType = "Intel Pentium"
        Case PROCESSOR_MIPS_R4000
            Level_CPUType = "MIPS R4000"
        Case PROCESSOR_ALPHA_21064
            Level_CPUType = "DEC Alpha 21064"
        Case Else
            Level_CPUType = "(unknown)"
    End Select

End Function

Private Sub Level_DriveCount(ByVal strRoot As String)
    Dim lngType As Long
    Const DRIVE_CDROM = 5       ' Some API constants required to
    Const DRIVE_FIXED = 3       ' get the difference between the
    Const DRIVE_RAMDISK = 6     ' drive types.
    Const DRIVE_REMOTE = 4
    Const DRIVE_REMOVABLE = 2
    
    lngType = apiDriveType(strRoot)
    Select Case lngType
        Case DRIVE_REMOVABLE
            intRemovable = intRemovable + 1
        Case DRIVE_FIXED
            intNotRemovable = intNotRemovable + 1
        Case DRIVE_REMOTE
            intNetwork = intNetwork + 1
        Case DRIVE_CDROM
            intCD = intCD + 1
        Case DRIVE_RAMDISK
            intRAM = intRAM + 1
    End Select
End Sub

Public Sub Level_DriveInfo(ByVal strRoot As String, ByRef lngTotalSpace As Double, ByRef lngFreeSpace As Double)
    Dim TotalClusters As Long
    Dim FreeClusters As Long
    Dim SectorsPerCluster As Long
    Dim BytesPerSector As Long
    Dim pietspace As Double
    Dim FreeBytes As Currency
    Dim TotalBytes As Currency
    Dim TotalFreeBytes As Currency
    
    If OSBuild >= 1111 Then
        If apiDiskFreeSpaceEx(strRoot, FreeBytes, TotalBytes, TotalFreeBytes) Then
            lngTotalSpace = TotalBytes * 10000
            lngFreeSpace = TotalFreeBytes * 10000
        Else
        '   Otherwise return zero.
            lngTotalSpace = 0
            lngFreeSpace = 0
        End If
    Else
        If apiDiskFreeSpace(strRoot, SectorsPerCluster, BytesPerSector, FreeClusters, TotalClusters) Then
        '   If the call succeeds return the asked amount of diskspace.
            lngTotalSpace = 1
            lngTotalSpace = 1 * SectorsPerCluster
            lngTotalSpace = lngTotalSpace * BytesPerSector
            lngTotalSpace = lngTotalSpace * TotalClusters
            lngFreeSpace = 1
            lngFreeSpace = lngFreeSpace * SectorsPerCluster
            lngFreeSpace = lngFreeSpace * BytesPerSector
            lngFreeSpace = lngFreeSpace * FreeClusters
        Else
        '   Otherwise return zero.
            lngTotalSpace = 0
            lngFreeSpace = 0
        End If
    End If
End Sub

Private Function Level_DriveType(ByVal strRoot As String) As String
    Dim lngType As Long
    Const DRIVE_CDROM = 5       ' Some API constants required to
    Const DRIVE_FIXED = 3       ' get the difference between the
    Const DRIVE_RAMDISK = 6     ' drive types.
    Const DRIVE_REMOTE = 4
    Const DRIVE_REMOVABLE = 2

    lngType = apiDriveType(strRoot)
    ' The API returns a value in lngType. Use the Constants to
    ' make the strings.

    Select Case lngType
        Case DRIVE_REMOVABLE
            Level_DriveType = text0
        Case DRIVE_FIXED
            Level_DriveType = text1
        Case DRIVE_REMOTE
            Level_DriveType = text4
        Case DRIVE_CDROM
            Level_DriveType = text2
        Case DRIVE_RAMDISK
            Level_DriveType = text3
        Case Else
            Level_DriveType = ""   ' If the API returns an error, we return a empty string
    End Select
End Function

Private Function level_PutPoints(ByVal lngNumber As Double) As String
    Dim NumOfPlaces As Integer
    Dim Counter As Integer
    Dim CurValue As String
    Dim Remainder As Double

    If Len(lngNumber) > 3 Then
        NumOfPlaces = Len(CStr(lngNumber)) \ 3
        If NumOfPlaces = Len(CStr(lngNumber)) / 3 Then
            NumOfPlaces = NumOfPlaces - 1
        End If
        For Counter = 0 To NumOfPlaces - 1
            level_PutPoints = "." + CStr(Mid$(lngNumber, Len(CStr(lngNumber)) - ((Counter * 3) + 2), 3)) + CurValue
            CurValue = level_PutPoints
        Next
        Remainder = Len(CStr(lngNumber)) - (((Counter - 1) * 3) + 2) - 1
        level_PutPoints = CStr(Left$(lngNumber, Remainder)) + CurValue
    Else
        level_PutPoints = lngNumber
    End If
End Function

Private Function Level_SerialNumber(ByVal strRoot As String) As String
    Dim VolLabel As String
    Dim VolSize As Long
    Dim SerNum As Long
    Dim MaxLen As Long
    Dim flags As Long
    Dim name As String
    Dim NameSize As Long
    Dim Check As String
    
    If apiSerialNumber(strRoot, VolLabel, VolSize, SerNum, MaxLen, flags, name, NameSize) Then
        Check = Format(Hex(SerNum), "00000000")
        Level_SerialNumber = Left$(Check, 4) + "-" + Right$(Check, 4)
    Else
        Level_SerialNumber = "0000-0000"
    End If
End Function

Public Function Level_StripTerminator(ByVal strString As String) As String
    Dim intZeroPos As Integer

    intZeroPos = InStr(strString, Chr$(0))
    If intZeroPos > 0 Then
        Level_StripTerminator = Left$(strString, intZeroPos - 1)
    Else
        Level_StripTerminator = strString
    End If
End Function

Public Function Level_SystemDirectory() As String
    ' Retrieve the system directory.
    Dim strBuffer As String
    Dim lngLen As Long
    
    strBuffer = Space(MaxPath)
    lngLen = MaxPath
    
    lngLen = GetSystemDirectory(strBuffer, lngLen)
    ' If the path is longer than dhcMaxPath, then
    ' lngLen contains the correct length. Resize the
    ' buffer and try again.
    If lngLen > MaxPath Then
        strBuffer = Space(lngLen)
        lngLen = GetSystemDirectory(strBuffer, lngLen)
    End If
    Level_SystemDirectory = Left$(strBuffer, lngLen)
End Function

Public Function Level_TempPath() As String
    Dim strBuffer As String
    Dim lngLen As Long
    
    strBuffer = Space(MaxPath)
    lngLen = MaxPath
    lngLen = GetTempPath(lngLen, strBuffer)
    ' If the path is longer than dhcMaxPath, then
    ' lngLen contains the correct length. Resize the
    ' buffer and try again.
    If lngLen > MaxPath Then
        strBuffer = Space(lngLen)
        lngLen = GetTempPath(lngLen, strBuffer)
    End If
    Level_TempPath = Left$(strBuffer, lngLen)
End Function

Private Function Level_UserName() As String
    Dim Bufstr As String
    Bufstr = Space$(50)

    If apiUserName(Bufstr, 50) > 0 Then
        Level_UserName = Bufstr
        Level_UserName = RTrim(Level_UserName)
        Level_UserName = Level_StripTerminator(Level_UserName)
    Else
        Level_UserName = ""
    End If
End Function

Private Function Level_VolumeLabel(ByVal strRoot As String) As String
    On Error GoTo Further

    Level_VolumeLabel = Dir(strRoot, vbVolume)
    Level_VolumeLabel = Level_StripTerminator(Level_VolumeLabel)
    If Level_VolumeLabel = "" Then Level_VolumeLabel = "NoName"
    Exit Function

Further:
    Level_VolumeLabel = ""
End Function

Private Function Level_WindowsDirectory() As String
    ' Retrieve the Windows directory.
    Dim strBuffer As String
    Dim lngLen As Long
    
    strBuffer = Space(MaxPath)
    lngLen = MaxPath
    lngLen = GetWindowsDirectory(strBuffer, lngLen)
    ' If the path is longer than dhcMaxPath, then
    ' lngLen contains the correct length. Resize the
    ' buffer and try again.
    If lngLen > MaxPath Then
        strBuffer = Space(lngLen)
        lngLen = GetWindowsDirectory(strBuffer, lngLen)
    End If
    Level_WindowsDirectory = Left$(strBuffer, lngLen)
End Function


Public Function Pad(strValue As String, lngWidth As Long, Optional OnRight As Boolean = True) As String
    If OnRight Then
        Pad = Left$(strValue & Space(lngWidth), lngWidth)
    Else
        Pad = Right$(Space(lngWidth) & strValue, lngWidth)
    End If
End Function

Private Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
       Dim cch As Long
       Dim lrc As Long
       Dim lType As Long
       Dim lValue As Long
       Dim sValue As String

       On Error GoTo QueryValueExError

       ' Determine the size and type of data to be read
       lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
       If lrc <> ERROR_NONE Then Error 5

       Select Case lType
           ' For strings
           Case REG_SZ:
               sValue = String(cch, 0)
   lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
   sValue, cch)
               If lrc = ERROR_NONE Then
                   vValue = Left$(sValue, cch - 1)
               Else
                   vValue = Empty
               End If
           ' For DWORDS
           Case REG_DWORD, 3:
   lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
   lValue, cch)
               If lrc = ERROR_NONE Then vValue = lValue
           Case Else
               'all other data types not supported
               lrc = -1
       End Select

QueryValueExExit:
       QueryValueEx = lrc
       Exit Function
QueryValueExError:
       Resume QueryValueExExit
End Function

Public Function RegistryGet(sKeyName As String, sValueName As String, lPredefinedKey As Long) As String
    Dim lRetVal As Long         'result of the API functions
    Dim hKey As Long         'handle of opened key
    Dim vValue As Variant      'setting of queried value
    
    lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
    lRetVal = QueryValueEx(hKey, sValueName, vValue)
    RegCloseKey (hKey)
    If lRetVal = ERROR_BADKEY Then
        RegistryGet = ""
    Else
        RegistryGet = vValue
    End If
End Function

Public Sub RunCpl(cplfile As String)
    On Error Resume Next
    Shell "rundll32.exe shell32.dll,Control_RunDLL " & cplfile, vbNormalFocus
    On Error GoTo 0
End Sub
