home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Programmer'…arterly (Limited Edition)
/
Visual_Basic_Programmers_Journal_VB-CD_Quarterly_Limited_Edition_1995.iso
/
code
/
ch21code
/
info.cls
< prev
next >
Wrap
Text File
|
1995-08-14
|
9KB
|
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