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 >
Text File  |  1995-08-14  |  9KB  |  267 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "Information"
  6. Attribute VB_Creatable = True
  7. Attribute VB_Exposed = True
  8. ' Information class -- INFO.CLS
  9. '   Provides access to WinAPI information functions.
  10. '
  11. '   Properties
  12. '       None
  13. '
  14. '   Methods
  15. '       MeetsCritera
  16. '       GetTasks
  17. '       IsRunning
  18. '       MakeVisible
  19. '       FindWindow
  20. '       WindowsVersion
  21. '
  22. Option Explicit
  23. ' Declare Windows API functions for finding running applicaitons.
  24. #If Win16 Then
  25. Private Declare Function GetNextWindow Lib "User" _
  26.     (ByVal hwnd As Integer, ByVal wFlag As Integer) As Integer
  27. Private Declare Function GetActiveWindow Lib "User" () As Integer
  28. Private Declare Function GetWindowText Lib "User" _
  29.     (ByVal hwnd As Integer, ByVal lpString As String, ByVal aint As Integer) As Integer
  30. Private Declare Function APIFindWindow Lib "User" _
  31.     Alias "FindWindow" _
  32.     (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Integer
  33.  
  34. Private Declare Function GlobalCompact Lib "Kernel" (ByVal dwMinFree As Long) As Long
  35. Private Declare Function GetWinFlags Lib "Kernel" () As Long
  36. Private Declare Function GetVersion Lib "Kernel" () As Long
  37.  
  38. ' DeclareWindows API functions for showing invisible instances of applications.
  39. Private Declare Function ShowWindow Lib "User" (ByVal hwnd As Integer, ByVal nCmdShow As Integer) As Integer
  40. #Else
  41. Private Declare Function GetNextWindow Lib "user32" _
  42.     Alias "GetNextQueueWindow" _
  43.     (ByVal hwnd As Long, ByVal wFlag As Integer) _
  44.     As Long
  45. Private Declare Function GetActiveWindow Lib "user32" _
  46.     () As Long
  47. Private Declare Function GetWindowText Lib "user32" _
  48.     Alias "GetWindowTextA" (ByVal hwnd As Long, _
  49.     ByVal lpString As String, ByVal cch As Long) _
  50.     As Long
  51. Private Declare Function APIFindWindow Lib "user32" _
  52.     Alias "FindWindowA" (ByVal lpClassName As String, _
  53.     ByVal lpWindowName As String) As Long
  54. Private Declare Sub GetSystemInfo Lib "Kernel32" _
  55.     (lpSystemInfo As SYSTEM_INFO)
  56. Private Declare Sub GlobalMemoryStatus Lib "Kernel32" _
  57.     (lpBuffer As MEMORYSTATUS)
  58.  
  59. Private Declare Function GetVersion Lib "Kernel32" _
  60.     () As Long
  61. Private Declare Function ShowWindow Lib "user32" _
  62.     (ByVal hwnd As Long, ByVal nCmdShow As Long) _
  63.     As Long
  64.     
  65. ' Type declaration for system information.
  66. Private Type SYSTEM_INFO
  67.     dwOemId As Long
  68.     dwPageSize As Long
  69.     lpMinimumApplicationAddress As Long
  70.     lpMaximumApplicationAddress As Long
  71.     dwActiveProcessorMask As Long
  72.     dwNumberOfProcessors As Long
  73.     dwProcessorType As Long
  74.     dwAllocationGranularity As Long
  75.     dwReserved As Long
  76. End Type
  77.  
  78. ' Type declaration for system information.
  79. Private Type MEMORYSTATUS
  80.     dwLength As Long        ' sizeof(MEMORYSTATUS)
  81.     dwMemoryLoad As Long    ' percent of memory in use
  82.     dwTotalPhys As Long     ' bytes of physical memory
  83.     dwAvailPhys As Long     ' free physical memory bytes
  84.     dwTotalPageFile As Long ' bytes of paging file
  85.     dwAvailPageFile As Long ' free bytes of paging file
  86.     dwTotalVirtual As Long  ' user bytes of address space
  87.     dwAvailVirtual As Long  ' free user bytes
  88. End Type
  89. #End If
  90.  
  91. Const WF_CPU286 = &H2
  92. Const WF_CPU386 = &H4
  93. Const WF_CPU486 = &H8
  94.  
  95. Const GW_HWNDNEXT = 2
  96.  
  97. Const SW_SHOW = 5
  98.  
  99.  
  100.  
  101.  
  102. ' Checks if a system meets processor and memory hardware requirement.
  103. ' iProcessor is a three-digit number: 286, 386, or 486
  104. ' iMemory is the number of megabytes of physical memory required.
  105. Public Function MeetsCriteria(iProcessor As Integer, iMemory As Integer) As Boolean
  106.     Dim iAvailableMemory  As Integer, lWinFlags As Long
  107.     Dim bProcessor As Boolean
  108.     #If Win16 Then
  109.         lWinFlags = GetWinFlags()
  110.     #Else
  111.         Dim SysInfo As SYSTEM_INFO
  112.         GetSystemInfo SysInfo
  113.         lWinFlags = SysInfo.dwProcessorType
  114.     #End If
  115.     Select Case iProcessor
  116.         Case 286
  117.             ' Windows 3.1 won't run on earlier machines, so True.
  118.             bProcessor = True
  119.         Case 386
  120.             ' If meets critieria, set to True.
  121.             #If Win16 Then
  122.                 If lWinFlags >= WF_CPU386 Then bProcessor = True
  123.             #Else
  124.                 If lWinFlags >= 386 Then bProcessor = True
  125.             #End If
  126.         Case 486
  127.             #If Win16 Then
  128.                 If lWinFlags And WF_CPU486 Then bProcessor = True
  129.             #Else
  130.                 If lWinFlags >= 486 Then bProcessor = True
  131.             #End If
  132.         Case 586
  133.             #If Win16 Then
  134.                 ' There is no test for 586 under Win16,
  135.                 ' so test for 486 -- probably
  136.                 ' better than returning an error.
  137.                 If lWinFlags And WF_CPU486 Then bProcessor = True
  138.             #Else
  139.                 If lWinFlags >= 586 Then bProcessor = True
  140.             #End If
  141.     End Select
  142.     ' Win16 and Win32 have different ways of getting
  143.     ' available physical memory.
  144.     #If Win16 Then
  145.         ' Get available physical memory.
  146.         iAvailableMemory = GlobalCompact(0) _
  147.             / (1024000)
  148.     #Else
  149.         Dim MemStatus As MEMORYSTATUS
  150.         GlobalMemoryStatus MemStatus
  151.         iAvailableMemory = MemStatus.dwTotalPhys / (1024000)
  152.     #End If
  153.     ' Combine results of two tests: True And True = True.
  154.     MeetsCriteria = bProcessor And iAvailableMemory >= iMemory
  155. End Function
  156.  
  157. Public Function GetTasks() As Variant
  158.     ReDim strTaskList(200) As String
  159.     Dim hwnd As Integer, hWndNext As Integer
  160.     Dim iLen As Integer, iTaskCount As Integer
  161.     Dim strTitle As String * 80
  162.     hwnd = GetActiveWindow()
  163.     Do Until hwnd = 0
  164.         hWndNext = GetNextWindow(hwnd, GW_HWNDNEXT)
  165.         iLen = GetWindowText(hWndNext, strTitle, Len(strTitle))
  166.         If iLen Then
  167.             strTaskList(iTaskCount) = Left$(strTitle, iLen)
  168.             iTaskCount = iTaskCount + 1
  169.         End If
  170.         hwnd = hWndNext
  171.     Loop
  172.     ' Trim off unused elements.
  173.     ReDim Preserve strTaskList(iTaskCount)
  174.     GetTasks = strTaskList
  175. End Function
  176.  
  177. Public Function FindWindow(ByRef strTitle As String) As Integer
  178.     FindWindow = APIFindWindow("", strTitle)
  179. End Function
  180.     
  181. Public Function IsRunning(strAppName) As Boolean
  182.     #If Win16 Then
  183.     Dim hwnd As Integer, hWndStop As Long, hWndNext As Integer, iLen As Integer
  184.     #Else
  185.     Dim hwnd As Long, hWndStop As Long, hWndNext As Long, iLen As Long
  186.     #End If
  187.     Dim strTitle As String * 80
  188.     ' Get a handle to the active window (first in task list).
  189.     hwnd = GetActiveWindow()
  190.     hWndStop = hwnd
  191.     ' Loop until you reach the end of the list.
  192.     Do
  193.         ' Get the next window handle.
  194.         hWndNext = GetNextWindow(hwnd, GW_HWNDNEXT)
  195.         ' Get the text from the window's caption.
  196.         iLen = GetWindowText(hWndNext, strTitle, Len(strTitle))
  197.         If iLen Then
  198.             ' If found, return True.
  199.             If InStr(strTitle, strAppName) Then
  200.                 IsRunning = True
  201.                 Exit Function
  202.             End If
  203.         End If
  204.         hwnd = hWndNext
  205.     Loop Until hwnd = hWndStop
  206.     ' Not found, so return False.
  207.     IsRunning = False
  208. End Function
  209.  
  210. ' Makes all applications visible.
  211. Public Sub MakeVisible()
  212.     #If Win16 Then
  213.     Dim hwnd As Integer, hWndFirst As Integer, iTemp As Integer, iLen As Integer
  214.     #Else
  215.     Dim hwnd As Long, hWndFirst As Long, iTemp As Long, iLen As Long
  216.     #End If
  217.     Dim strTitle As String * 80
  218.     ' Get a handle to the active window (first in task list).
  219.     hwnd = GetActiveWindow()
  220.     hWndFirst = hwnd
  221.     ' Loop until you reach the end of the list.
  222.     Do
  223.         iLen = GetWindowText(hwnd, strTitle, Len(strTitle))
  224.         If iLen Then
  225.             iTemp = ShowWindow(hwnd, SW_SHOW)
  226.         End If
  227.         ' Get the next window handle.
  228.         hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)
  229.     Loop Until hwnd = hWndFirst
  230. End Sub
  231.  
  232.  
  233. Public Function WindowsVersion() As String
  234.     Dim lWinInfo As Long
  235.     ' Retrieve Windows version information.
  236.     lWinInfo = GetVersion()
  237.     ' Parse the Windows version number from the returned
  238.     ' Long integer value.
  239.     WindowsVersion = LoByte(LoWord(lWinInfo)) & "." & HiByte(LoWord(lWinInfo))
  240.     ' Parse the DOS version number from the returned
  241.     ' Long integer value (shown here for informational purposes -- not used).
  242.     ' strDOSversion = HiByte(HiWord(lWinInfo)) & "." & LoByte(HiWord(lWinInfo))
  243.     '
  244.     ' If the version is less than 3.5 (Win NT 3.5)...
  245. End Function
  246.  
  247. Function LoWord(lArg)
  248.     LoWord = lArg And (lArg Xor &HFFFF0000)
  249. End Function
  250.  
  251.  
  252. Function HiWord(lArg)
  253.     If lArg > &H7FFFFFFF Then
  254.         HiWord = (lArg And &HFFFF0000) \ &H10000
  255.     Else
  256.         HiWord = ((lArg And &HFFFF0000) \ &H10000) Xor &HFFFF0000
  257.     End If
  258. End Function
  259.  
  260. Function HiByte(iArg)
  261.     HiByte = (iArg And &HFF00) \ &H100
  262. End Function
  263. Function LoByte(iArg)
  264.     LoByte = iArg Xor (iArg And &HFF00)
  265. End Function
  266.  
  267.