Visual Basic Programmer'…arterly (Limited Edition)/Visual_Basic_Programmers_Journal_VB-CD_Quarterly_Limited_Edition_1995.iso/code/ch21code/info.cls

Text File | 1995-08-14 | 8.8 KB | 267 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Information"
Attribute VB_Creatable = True
Attribute VB_Exposed = True
' Information class -- INFO.CLS
'   Provides access to WinAPI information functions.
'
'   Properties
'       None
'
'   Methods
'       MeetsCritera
'       GetTasks
'       IsRunning
'       MakeVisible
'       FindWindow
'       WindowsVersion
'
Option Explicit
' Declare Windows API functions for finding running applicaitons.
#If Win16 Then
Private Declare Function GetNextWindow Lib "User" _
    (ByVal hwnd As Integer, ByVal wFlag As Integer) As Integer
Private Declare Function GetActiveWindow Lib "User" () As Integer
Private Declare Function GetWindowText Lib "User" _
    (ByVal hwnd As Integer, ByVal lpString As String, ByVal aint As Integer) As Integer
Private Declare Function APIFindWindow Lib "User" _
    Alias "FindWindow" _
    (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Integer

Private Declare Function GlobalCompact Lib "Kernel" (ByVal dwMinFree As Long) As Long
Private Declare Function GetWinFlags Lib "Kernel" () As Long
Private Declare Function GetVersion Lib "Kernel" () As Long

' DeclareWindows API functions for showing invisible instances of applications.
Private Declare Function ShowWindow Lib "User" (ByVal hwnd As Integer, ByVal nCmdShow As Integer) As Integer
#Else
Private Declare Function GetNextWindow Lib "user32" _
    Alias "GetNextQueueWindow" _
    (ByVal hwnd As Long, ByVal wFlag As Integer) _
    As Long
Private Declare Function GetActiveWindow Lib "user32" _
    () As Long
Private Declare Function GetWindowText Lib "user32" _
    Alias "GetWindowTextA" (ByVal hwnd As Long, _
    ByVal lpString As String, ByVal cch As Long) _
    As Long
Private Declare Function APIFindWindow Lib "user32" _
    Alias "FindWindowA" (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
Private Declare Sub GetSystemInfo Lib "Kernel32" _
    (lpSystemInfo As SYSTEM_INFO)
Private Declare Sub GlobalMemoryStatus Lib "Kernel32" _
    (lpBuffer As MEMORYSTATUS)

Private Declare Function GetVersion Lib "Kernel32" _
    () As Long
Private Declare Function ShowWindow Lib "user32" _
    (ByVal hwnd As Long, ByVal nCmdShow As Long) _
    As Long

' Type declaration for system information.
Private 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

' Type declaration for system information.
Private Type MEMORYSTATUS
    dwLength As Long        ' sizeof(MEMORYSTATUS)
    dwMemoryLoad As Long    ' percent of memory in use
    dwTotalPhys As Long     ' bytes of physical memory
    dwAvailPhys As Long     ' free physical memory bytes
    dwTotalPageFile As Long ' bytes of paging file
    dwAvailPageFile As Long ' free bytes of paging file
    dwTotalVirtual As Long  ' user bytes of address space
    dwAvailVirtual As Long  ' free user bytes
End Type
#End If

Const WF_CPU286 = &H2
Const WF_CPU386 = &H4
Const WF_CPU486 = &H8

Const GW_HWNDNEXT = 2

Const SW_SHOW = 5




' Checks if a system meets processor and memory hardware requirement.
' iProcessor is a three-digit number: 286, 386, or 486
' iMemory is the number of megabytes of physical memory required.
Public Function MeetsCriteria(iProcessor As Integer, iMemory As Integer) As Boolean
    Dim iAvailableMemory  As Integer, lWinFlags As Long
    Dim bProcessor As Boolean
    #If Win16 Then
        lWinFlags = GetWinFlags()
    #Else
        Dim SysInfo As SYSTEM_INFO
        GetSystemInfo SysInfo
        lWinFlags = SysInfo.dwProcessorType
    #End If
    Select Case iProcessor
        Case 286
            ' Windows 3.1 won't run on earlier machines, so True.
            bProcessor = True
        Case 386
            ' If meets critieria, set to True.
            #If Win16 Then
                If lWinFlags >= WF_CPU386 Then bProcessor = True
            #Else
                If lWinFlags >= 386 Then bProcessor = True
            #End If
        Case 486
            #If Win16 Then
                If lWinFlags And WF_CPU486 Then bProcessor = True
            #Else
                If lWinFlags >= 486 Then bProcessor = True
            #End If
        Case 586
            #If Win16 Then
                ' There is no test for 586 under Win16,
                ' so test for 486 -- probably
                ' better than returning an error.
                If lWinFlags And WF_CPU486 Then bProcessor = True
            #Else
                If lWinFlags >= 586 Then bProcessor = True
            #End If
    End Select
    ' Win16 and Win32 have different ways of getting
    ' available physical memory.
    #If Win16 Then
        ' Get available physical memory.
        iAvailableMemory = GlobalCompact(0) _
            / (1024000)
    #Else
        Dim MemStatus As MEMORYSTATUS
        GlobalMemoryStatus MemStatus
        iAvailableMemory = MemStatus.dwTotalPhys / (1024000)
    #End If
    ' Combine results of two tests: True And True = True.
    MeetsCriteria = bProcessor And iAvailableMemory >= iMemory
End Function

Public Function GetTasks() As Variant
    ReDim strTaskList(200) As String
    Dim hwnd As Integer, hWndNext As Integer
    Dim iLen As Integer, iTaskCount As Integer
    Dim strTitle As String * 80
    hwnd = GetActiveWindow()
    Do Until hwnd = 0
        hWndNext = GetNextWindow(hwnd, GW_HWNDNEXT)
        iLen = GetWindowText(hWndNext, strTitle, Len(strTitle))
        If iLen Then
            strTaskList(iTaskCount) = Left$(strTitle, iLen)
            iTaskCount = iTaskCount + 1
        End If
        hwnd = hWndNext
    Loop
    ' Trim off unused elements.
    ReDim Preserve strTaskList(iTaskCount)
    GetTasks = strTaskList
End Function

Public Function FindWindow(ByRef strTitle As String) As Integer
    FindWindow = APIFindWindow("", strTitle)
End Function

Public Function IsRunning(strAppName) As Boolean
    #If Win16 Then
    Dim hwnd As Integer, hWndStop As Long, hWndNext As Integer, iLen As Integer
    #Else
    Dim hwnd As Long, hWndStop As Long, hWndNext As Long, iLen As Long
    #End If
    Dim strTitle As String * 80
    ' Get a handle to the active window (first in task list).
    hwnd = GetActiveWindow()
    hWndStop = hwnd
    ' Loop until you reach the end of the list.
    Do
        ' Get the next window handle.
        hWndNext = GetNextWindow(hwnd, GW_HWNDNEXT)
        ' Get the text from the window's caption.
        iLen = GetWindowText(hWndNext, strTitle, Len(strTitle))
        If iLen Then
            ' If found, return True.
            If InStr(strTitle, strAppName) Then
                IsRunning = True
                Exit Function
            End If
        End If
        hwnd = hWndNext
    Loop Until hwnd = hWndStop
    ' Not found, so return False.
    IsRunning = False
End Function

' Makes all applications visible.
Public Sub MakeVisible()
    #If Win16 Then
    Dim hwnd As Integer, hWndFirst As Integer, iTemp As Integer, iLen As Integer
    #Else
    Dim hwnd As Long, hWndFirst As Long, iTemp As Long, iLen As Long
    #End If
    Dim strTitle As String * 80
    ' Get a handle to the active window (first in task list).
    hwnd = GetActiveWindow()
    hWndFirst = hwnd
    ' Loop until you reach the end of the list.
    Do
        iLen = GetWindowText(hwnd, strTitle, Len(strTitle))
        If iLen Then
            iTemp = ShowWindow(hwnd, SW_SHOW)
        End If
        ' Get the next window handle.
        hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)
    Loop Until hwnd = hWndFirst
End Sub


Public Function WindowsVersion() As String
    Dim lWinInfo As Long
    ' Retrieve Windows version information.
    lWinInfo = GetVersion()
    ' Parse the Windows version number from the returned
    ' Long integer value.
    WindowsVersion = LoByte(LoWord(lWinInfo)) & "." & HiByte(LoWord(lWinInfo))
    ' Parse the DOS version number from the returned
    ' Long integer value (shown here for informational purposes -- not used).
    ' strDOSversion = HiByte(HiWord(lWinInfo)) & "." & LoByte(HiWord(lWinInfo))
    '
    ' If the version is less than 3.5 (Win NT 3.5)...
End Function

Function LoWord(lArg)
    LoWord = lArg And (lArg Xor &HFFFF0000)
End Function


Function HiWord(lArg)
    If lArg > &H7FFFFFFF Then
        HiWord = (lArg And &HFFFF0000) \ &H10000
    Else
        HiWord = ((lArg And &HFFFF0000) \ &H10000) Xor &HFFFF0000
    End If
End Function

Function HiByte(iArg)
    HiByte = (iArg And &HFF00) \ &H100
End Function
Function LoByte(iArg)
    LoByte = iArg Xor (iArg And &HFF00)
End Function