You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
285 lines
11 KiB
285 lines
11 KiB
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
Persistable = 0 'NotPersistable
|
|
DataBindingBehavior = 0 'vbNone
|
|
DataSourceBehavior = 0 'vbNone
|
|
MTSTransactionMode = 0 'NotAnMTSObject
|
|
END
|
|
Attribute VB_Name = "Queue"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = True
|
|
Attribute VB_Description = "APE Job Manager"
|
|
Option Explicit
|
|
'-------------------------------------------------------------------------
|
|
'The Class is public, creatable, multi-use. It is provide as an OLE interface
|
|
'for the Client applications to call, adding Service Requests to the Queue
|
|
' It implements the IQueue interface
|
|
'-------------------------------------------------------------------------
|
|
|
|
Implements APEInterfaces.IQueue
|
|
|
|
Public Enum APECallbackNotificationConstants
|
|
apeCallbackModeNone = giNO_CALLBACK
|
|
apeCallbackModeRegisterEveryRequest = giUSE_PASSED_CALLBACK
|
|
apeCallbackModeRegisterOnce = giUSE_DEFAULT_CALLBACK
|
|
apeCallbackModeUseRaiseEvent = giRETURN_BY_SYNC_EVENT
|
|
End Enum
|
|
|
|
Private moDefaultCallback As APEInterfaces.IClientCallback 'See DefaultCallback property comments
|
|
Private moEventObject As Object
|
|
Private mbHaveEventObject As Boolean
|
|
|
|
'******************
|
|
'Public Properties
|
|
'******************
|
|
|
|
Public Property Set IQueue_DefaultCallBack(ByVal oCallback As APEInterfaces.IClientCallback)
|
|
Attribute IQueue_DefaultCallBack.VB_Description = "Set the callback object to use when apeCallbackModeRegisterOnce is passed to the Add method as the callback mode."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: The property allows a client to set a default
|
|
' callback specific to the Queue class object
|
|
' that is referenced by the client. By setting
|
|
' this property a client can omit the CallBack parameter
|
|
' of the Queue.Add method and QueueMgr will use
|
|
' the default callback if a call back is required
|
|
'In:
|
|
' [oCallback]
|
|
' Must be a valid callback object having a callback method
|
|
'Effects:
|
|
' [moDefaultCallback]
|
|
' Class level variable is set equal to the passed object
|
|
'-------------------------------------------------------------------------
|
|
|
|
If oCallback Is Nothing Then Err.Raise giINVALID_CALLBACK + vbObjectError, Err.Source, LoadResString(giINVALID_CALLBACK)
|
|
Set moDefaultCallback = oCallback
|
|
End Property
|
|
|
|
Public Property Get IQueue_DefaultCallBack() As APEInterfaces.IClientCallback
|
|
Set IQueue_DefaultCallBack = moDefaultCallback
|
|
|
|
End Property
|
|
|
|
'*****************
|
|
'Public Methods
|
|
'*****************
|
|
|
|
Private Function IQueue_Add(ByVal sCommand As String, ByVal sServiceID As String, _
|
|
ByVal iCallBackMode As APEInterfaces.APECallbackNotificationConstants, Optional ByVal vData As Variant, _
|
|
Optional ByVal CallBack As APEInterfaces.IClientCallback) As Boolean
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: Called by client Applications to add a Service request to the
|
|
' Queue.
|
|
'IN:
|
|
' [sCommand]
|
|
' The string that will be given to a worker with the passed data
|
|
' The worker uses this string to determine what OLE Server to
|
|
' use as a Service provider. Part of the string is passed to the
|
|
' Service provider from the Worker.
|
|
' [sServiceID]
|
|
' An ID that identifies the service request
|
|
' [iCallBackMode]
|
|
' Defines if and how data is returned to client calling this function
|
|
' [vData]
|
|
' (Optional) Variant data that will be given to the Worker also.
|
|
' The Worker and the QueueMgr do not know what type of data this is
|
|
' The Worker will just pass it the the Service provider
|
|
' [Callback]
|
|
' (Optional) Callback object. If present, it will be immediately passed
|
|
' to the Expediter. The expediter will use it to callback
|
|
' delivering results that the Worker gives to it
|
|
'Return: True if the Service request was processed
|
|
' else returns false.
|
|
'Effects:
|
|
' The Expediter will get called if a Callback is passed or bUseDefaultCallback
|
|
' is true
|
|
' [gbBusyAdding]
|
|
' is true during this procedure
|
|
' [gcQueue]
|
|
' will get a clsService class object, storing the Service request
|
|
' information.
|
|
'Assumptions:
|
|
' [gcQueue]
|
|
' Is a valid collection object
|
|
'-------------------------------------------------------------------------
|
|
Dim oService As clsService 'clsService class object which is filled
|
|
'with Service request data and added to collection
|
|
Dim bDataPresent As Boolean 'Flag that data is present
|
|
Dim oCallback As APEInterfaces.IClientCallback 'Callback object that will be passed to Expediter
|
|
|
|
Dim lCount As Long 'gcQueue.count
|
|
|
|
On Error GoTo AddError
|
|
|
|
IQueue_Add = False
|
|
|
|
'Exit sub if Stopping Queue
|
|
If gbStopTest Then Exit Function
|
|
|
|
gbBusyAdding = True
|
|
'Check if the QueueMgr is too busy to process request
|
|
If gcQueue.Count >= glMaxQueueSize Then Err.Raise giQUEUE_MGR_IS_BUSY
|
|
'Check if data was passed
|
|
If IsMissing(vData) Then bDataPresent = False Else bDataPresent = True
|
|
'Validate that the Expediter was created successfully
|
|
If iCallBackMode <> giNO_CALLBACK Then
|
|
If gbFailedToCreateExpediter Then Err.Raise giCOULD_NOT_CREATE_EXPEDITER
|
|
End If
|
|
'Validate callback object
|
|
Select Case iCallBackMode
|
|
Case giUSE_PASSED_CALLBACK
|
|
If CallBack Is Nothing Then
|
|
Err.Raise giINVALID_CALLBACK
|
|
Else
|
|
Set oCallback = CallBack
|
|
End If
|
|
Case giUSE_DEFAULT_CALLBACK
|
|
If moDefaultCallback Is Nothing Then
|
|
Err.Raise giINVALID_CALLBACK
|
|
Else
|
|
Set oCallback = moDefaultCallback
|
|
End If
|
|
Case giRETURN_BY_SYNC_EVENT
|
|
If Not mbHaveEventObject Then Err.Raise giFIRST_GET_WITHEVENTS_OBJECT
|
|
End Select
|
|
|
|
'Iterate count of this method call
|
|
glAddCallCount = glAddCallCount + 1
|
|
|
|
'Update U/I if form is visible
|
|
If gbShow Then frmQueueMgr.lblCount = glAddCallCount
|
|
|
|
Set oService = New clsService
|
|
|
|
LogEvent giADD_RECEIVED, sServiceID
|
|
|
|
'Create the put the Service request values
|
|
'in the clsService object
|
|
With oService
|
|
.ID = sServiceID
|
|
.Command = sCommand
|
|
.CallBackMode = iCallBackMode
|
|
Select Case iCallBackMode
|
|
Case giUSE_PASSED_CALLBACK, giUSE_DEFAULT_CALLBACK
|
|
Set .CallBack = oCallback
|
|
Case giRETURN_BY_SYNC_EVENT
|
|
Set .EventObject = moEventObject
|
|
End Select
|
|
.DataPresent = bDataPresent
|
|
'Check what data type vData return is
|
|
'in order to determine how to handle it
|
|
If bDataPresent Then
|
|
Select Case VarType(vData)
|
|
Case vbEmpty, vbNull
|
|
.Data = Null
|
|
Case vbObject, vbError, vbDataObject
|
|
Set .Data = vData
|
|
Case Else
|
|
.Data = vData
|
|
End Select
|
|
End If
|
|
End With
|
|
'Add oService to Queue using ID as Key
|
|
gcQueue.Add oService, sServiceID
|
|
|
|
'Display stats
|
|
lCount = gcQueue.Count
|
|
If gbShow Then frmQueueMgr.lblQueue = lCount
|
|
If lCount > glPeakQueueSize Then
|
|
glPeakQueueSize = lCount
|
|
If gbShow Then frmQueueMgr.lblPeak = glPeakQueueSize
|
|
End If
|
|
|
|
If gbStopTest And Not gbBusyGetServiceRequest And Not gbBusyGetServiceResults Then StopQueue
|
|
|
|
'Flip the status flag right before the calling client is released
|
|
'A worker should not be allowed to take an activity request
|
|
'until the client is released. This keeps the the expediter
|
|
'from calling the client with Service results before the client
|
|
'is released with the return value, the Service ID
|
|
oService.Status = giWAITING_FOR_WORKER
|
|
Set oService = Nothing
|
|
gbBusyAdding = False
|
|
|
|
IQueue_Add = True
|
|
|
|
Exit Function
|
|
AddError:
|
|
Select Case Err.Number
|
|
Case giQUEUE_MGR_IS_BUSY
|
|
gbBusyAdding = False
|
|
Err.Raise Err.Number + vbObjectError, Err.Source, LoadResString(Err.Number)
|
|
Exit Function
|
|
Case Is > giERROR_THRESHOLD
|
|
LogError Err, gsNULL_SERVICE_ID
|
|
gbBusyAdding = False
|
|
Err.Raise Err.Number + vbObjectError, Err.Source, LoadResString(Err.Number)
|
|
Exit Function
|
|
Case RPC_E_CALL_REJECTED
|
|
'Collision error, the OLE server is busy
|
|
Dim iRetry As Integer
|
|
Dim il As Integer
|
|
Dim ir As Integer
|
|
'First check for stop test
|
|
If gbStopTest And Not gbBusyGetServiceRequest Then StopQueue: Exit Function
|
|
If iRetry < giMAX_ALLOWED_RETRIES Then
|
|
iRetry = iRetry + 1
|
|
ir = Int((giRETRY_WAIT_MAX - giRETRY_WAIT_MIN + 1) * Rnd + giRETRY_WAIT_MIN)
|
|
For il = 0 To ir
|
|
DoEvents
|
|
Next il
|
|
LogEvent giCALL_REJECTED_RETRY, sServiceID
|
|
Resume
|
|
Else
|
|
'We reached our max retries
|
|
LogError Err, sServiceID
|
|
gbBusyAdding = False
|
|
Err.Raise Err.Number, Err.Source, Err.Description
|
|
End If
|
|
Case giCOULD_NOT_CREATE_EXPEDITER
|
|
LogError Err, sServiceID
|
|
gbBusyAdding = False
|
|
Err.Raise giCOULD_NOT_CREATE_EXPEDITER + vbObjectError, Err.Source, LoadResString(giCOULD_NOT_CREATE_EXPEDITER)
|
|
Case giFIRST_GET_WITHEVENTS_OBJECT
|
|
LogError Err, sServiceID
|
|
gbBusyAdding = False
|
|
Err.Raise giFIRST_GET_WITHEVENTS_OBJECT + vbObjectError, Err.Source, LoadResString(giFIRST_GET_WITHEVENTS_OBJECT)
|
|
Case giINVALID_CALLBACK
|
|
LogError Err, sServiceID
|
|
gbBusyAdding = False
|
|
Err.Raise giINVALID_CALLBACK + vbObjectError, Err.Source, LoadResString(giINVALID_CALLBACK)
|
|
Case ERR_OVER_FLOW
|
|
LogError Err, sServiceID
|
|
If glAddCallCount = glMAX_ID Then glAddCallCount = 0
|
|
Resume
|
|
Case Else
|
|
LogError Err, sServiceID
|
|
gbBusyAdding = False
|
|
Err.Raise Err.Number, Err.Source, Err.Description
|
|
Exit Function
|
|
End Select
|
|
End Function
|
|
|
|
Public Function IQueue_GetEventObject() As Object
|
|
Attribute IQueue_GetEventObject.VB_Description = "Returns the event source object that a client must respond to when apeCallbackModeUseRaiseEvent is passed to the Add method as the callback mode."
|
|
If Not mbHaveEventObject Then
|
|
Set moEventObject = goExpediter.GetEventObject
|
|
mbHaveEventObject = True
|
|
End If
|
|
Set IQueue_GetEventObject = moEventObject
|
|
End Function
|
|
|
|
'*******************
|
|
'Private methods
|
|
'*******************
|
|
|
|
Private Sub Class_Initialize()
|
|
CountInitialize
|
|
End Sub
|
|
|
|
Private Sub Class_Terminate()
|
|
CountTerminate
|
|
End Sub
|