home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / vbpg32 / samples5 / ch14 / appwatch.cls next >
Encoding:
Visual Basic class definition  |  1997-02-16  |  2.3 KB  |  88 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "dwAppWatch"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Option Explicit
  11. ' Copyright ⌐ 1997 by Desaware Inc. All Rights Reserved
  12.  
  13. Private CallbackObject As Object
  14.  
  15. ' Process handle to watch
  16. Private processhnd As Long
  17. Private nprocessid As Long
  18.  
  19. ' Internal state machine for dwAppWatch object
  20. ' 0 - Idle
  21. ' 1 - Waiting on process to terminate
  22. ' 2 - Process has terminated
  23. Private state As Integer
  24.  
  25. Public Property Get Signaled() As Boolean
  26.     If state = 2 Then Signaled = True Else Signaled = False
  27. End Property
  28.  
  29. ' Called by the timer routine
  30. Public Sub TimerEvent()
  31.     Dim res&
  32.     If state = 0 Or state = 2 Then Exit Sub
  33.     res = WaitForSingleObject(processhnd, 0)
  34.     Select Case res
  35.         Case WAIT_OBJECT_0
  36.             Call CloseHandle(processhnd)
  37.             state = 2
  38.             On Error GoTo cantcallback
  39.             If Not (CallbackObject Is Nothing) Then
  40.                 CallbackObject.dwAppTerminated Me
  41.             End If
  42.             On Error GoTo 0
  43.             ' Pull object off the timer list
  44.             RemovingClass Me
  45.             
  46.         Case WAIT_FAILED
  47.             Call CloseHandle(processhnd)
  48.             state = 0
  49.     End Select
  50.     Exit Sub
  51. cantcallback:
  52.     Resume Next
  53. End Sub
  54.  
  55. Public Sub SetAppWatch(ByVal pid&)
  56.     ' If we're already watching a process, error
  57.     If state = 1 Then
  58.         RaiseError 1, "dwAppWatch", "Application already attached"
  59.         Exit Sub
  60.     End If
  61.     processhnd = OpenProcess(SYNCHRONIZE, True, pid)
  62.     If processhnd = 0 Then
  63.         RaiseError 2, "dwAppWatch", "Unable to open specified process"
  64.         Exit Sub
  65.     End If
  66.     ' Set the new state
  67.     nprocessid = pid
  68.     state = 1
  69.     ' Add this object to main collection
  70.     WatchCollection.Add Me
  71. End Sub
  72.  
  73. Public Property Get ProcessId() As Long
  74.     ProcessId = nprocessid
  75. End Property
  76.  
  77.  
  78. ' Set the callback object - make sure it is valid
  79. Public Sub SetAppCallback(o As Object)
  80.     If agIsValidName(o, "dwAppTerminated") = 0 Then
  81.         RaiseError 3, "dwAppWatch", "Callback object function undefined"
  82.         Exit Sub
  83.     End If
  84.     
  85.     Set CallbackObject = o
  86. End Sub
  87.  
  88.