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.
724 lines
31 KiB
724 lines
31 KiB
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
Persistable = 0 'False
|
|
DataBindingBehavior = 0 'vbNone
|
|
DataSourceBehavior = 0 'vbNone
|
|
END
|
|
Attribute VB_Name = "QueueMgr"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = True
|
|
Attribute VB_Description = "APE Job Manager"
|
|
Option Explicit
|
|
'-------------------------------------------------------------------------
|
|
'This public multi-use class provides the OLE interface for the APE Manager
|
|
'or another application designed to be the Manager
|
|
' It implements the IQueueManager interface
|
|
'-------------------------------------------------------------------------
|
|
|
|
Implements APEInterfaces.IQueueManager
|
|
|
|
'***********************
|
|
'Public Properties
|
|
'***********************
|
|
Private Property Get IQueueManager_IsIdle() As Boolean
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: Returns True if the Queue is idle.
|
|
'-------------------------------------------------------------------------
|
|
If gcQueue.Count = 0 Then
|
|
Dim oWorker As clsWorker
|
|
IQueueManager_IsIdle = True
|
|
For Each oWorker In gcWorkers
|
|
If oWorker.Busy Then
|
|
IQueueManager_IsIdle = False
|
|
Exit For
|
|
End If
|
|
Next
|
|
Else
|
|
IQueueManager_IsIdle = False
|
|
End If
|
|
End Property
|
|
|
|
Public Property Let IQueueManager_MaxQueueSize(ByVal lMax As Long)
|
|
Attribute IQueueManager_MaxQueueSize.VB_Description = "Sets or returns the value that controls the size of the Queue that causes Service Requests to be rejected."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: MaxQueueSize property determines the maximum amount
|
|
' of ServiceRequests that will be allowed to back up
|
|
'Effects: [glMax] becomes value of parameter
|
|
'-------------------------------------------------------------------------
|
|
glMaxQueueSize = lMax
|
|
End Property
|
|
|
|
Public Property Get IQueueManager_MaxQueueSize() As Long
|
|
IQueueManager_MaxQueueSize = glMaxQueueSize
|
|
End Property
|
|
|
|
Public Property Let IQueueManager_ShowQueue(ByVal bShow As Boolean)
|
|
Attribute IQueueManager_ShowQueue.VB_Description = "Determines whether the AEQueueMgr shows a form."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: Show property determines whether or not a form
|
|
' is displayed while QueueMgr is loaded
|
|
'Effects: [gbShow] becomes value of parameter
|
|
' If parameter is true frmQueueMgr is show, else form
|
|
' is Unloaded.
|
|
'-------------------------------------------------------------------------
|
|
If Not gbShow = bShow Then
|
|
gbShow = bShow
|
|
If bShow Then
|
|
With frmQueueMgr
|
|
.Show
|
|
.lblCount.Caption = glAddCallCount
|
|
.lblPeak.Caption = glPeakQueueSize
|
|
.lblQueue.Caption = gcQueue.Count
|
|
.lblWorkerCount.Caption = gcWorkers.Count
|
|
End With
|
|
Else
|
|
Unload frmQueueMgr
|
|
End If
|
|
End If
|
|
|
|
End Property
|
|
|
|
Public Property Get IQueueManager_ShowQueue() As Boolean
|
|
IQueueManager_ShowQueue = gbShow
|
|
End Property
|
|
|
|
Public Property Let IQueueManager_LogQueue(ByVal bLog As Boolean)
|
|
Attribute IQueueManager_LogQueue.VB_Description = "Determines if the AEQueueMgr logs its events and errors to the AELogger.Logger object."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: If log is true create logger class object and log Services
|
|
'Effects: [gbLog] becomes value of parameter
|
|
' [goLogger] is set to a new AELogger.Logger object if parameter
|
|
' is true. If false goLogger is destroyed
|
|
'-------------------------------------------------------------------------
|
|
On Error GoTo LogQueueError
|
|
If Not gbLog = bLog Then
|
|
gbLog = bLog
|
|
If bLog Then
|
|
Set goLogger = CreateObject("AELogger.Logger")
|
|
Else
|
|
Set goLogger = Nothing
|
|
End If
|
|
End If
|
|
Exit Property
|
|
LogQueueError:
|
|
Select Case Err.Number
|
|
Case ERR_CANT_FIND_KEY_IN_REGISTRY
|
|
'AEInstancer.Instancer is a work around for error
|
|
'-2147221166 which occurrs every time a client
|
|
'object creates an instance of a remote server,
|
|
'destroys it, registers it local, and tries to
|
|
'create a local instance. The client can not
|
|
'create an object registered locally after it created
|
|
'an instance while it was registered remotely
|
|
'until it shuts down and restarts. Therefore,
|
|
'it works to call another process to create the
|
|
'local instance and pass it back.
|
|
Dim oInstancer As APEInterfaces.IInstancer
|
|
Set oInstancer = CreateObject("AEInstancer.Instancer")
|
|
Set goLogger = oInstancer.Object("AELogger.Logger")
|
|
Set oInstancer = Nothing
|
|
Resume Next
|
|
Case Else
|
|
Err.Raise Err.Number, Err.Source, Err.Description
|
|
End Select
|
|
End Property
|
|
|
|
Public Property Get IQueueManager_LogQueue() As Boolean
|
|
IQueueManager_LogQueue = gbLog
|
|
End Property
|
|
|
|
'********************
|
|
'Worker Properties
|
|
'********************
|
|
Public Property Let IQueueManager_LogWorkers(ByVal bLog As Boolean)
|
|
Attribute IQueueManager_LogWorkers.VB_Description = "Sets the value that is used to set the Log property of AEWorker.Worker objects."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: To set the Log property of all the Workers
|
|
'Effects:
|
|
' [gbLogWorkers]
|
|
' becomes equal to the passed parameter
|
|
'Assumes: There is a collection of one or more valid Worker objects
|
|
'-------------------------------------------------------------------------
|
|
'If the property setting actually
|
|
'changes the current property pass
|
|
'the property change to all the Workers
|
|
Dim oWork As clsWorker
|
|
If Not bLog = gbLogWorkers Then
|
|
For Each oWork In gcWorkers
|
|
oWork.Worker.Log = bLog
|
|
Next oWork
|
|
gbLogWorkers = bLog
|
|
End If
|
|
End Property
|
|
|
|
Public Property Get IQueueManager_LogWorkers() As Boolean
|
|
IQueueManager_LogWorkers = gbLogWorkers
|
|
End Property
|
|
|
|
Public Property Let IQueueManager_PersistentServices(ByVal bPersistent As Boolean)
|
|
Attribute IQueueManager_PersistentServices.VB_Description = "Sets the value that is used to set the PersistentServices property of AEWorker.Worker objects."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: To set the PersistentServices property of all the Workers
|
|
'Effects:
|
|
' [gbPersistentServices]
|
|
' becomes equal to the passed parameter
|
|
'Assumes: There is a collection of one or more valid Worker objects
|
|
'-------------------------------------------------------------------------
|
|
'If the property setting actually
|
|
'changes the current property pass
|
|
'the property change to all the Workers
|
|
Dim oWork As clsWorker
|
|
If Not bPersistent = gbPersistentServices Then
|
|
For Each oWork In gcWorkers
|
|
oWork.Worker.PersistentServices = bPersistent
|
|
Next oWork
|
|
gbPersistentServices = bPersistent
|
|
End If
|
|
End Property
|
|
|
|
Public Property Get IQueueManager_PersistentServices() As Boolean
|
|
IQueueManager_PersistentServices = gbPersistentServices
|
|
End Property
|
|
|
|
Public Property Let IQueueManager_EarlyBindServices(ByVal bEarlyBind As Boolean)
|
|
Attribute IQueueManager_EarlyBindServices.VB_Description = "Sets the value that is used to set the EarlyBindServices property of AEWorker.Worker objects."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: To set the EarlyBindServices property of all the Workers
|
|
'Effects:
|
|
' [gbEarlyBindServices]
|
|
' becomes equal to the passed parameter
|
|
'Assumes: There is a collection of one or more valid Worker objects
|
|
'-------------------------------------------------------------------------
|
|
'If the property setting actually
|
|
'changes the current property pass
|
|
'the property change to all the Workers
|
|
Dim oWork As clsWorker
|
|
If Not bEarlyBind = gbEarlyBindServices Then
|
|
For Each oWork In gcWorkers
|
|
oWork.Worker.EarlyBindServices = bEarlyBind
|
|
Next oWork
|
|
gbEarlyBindServices = bEarlyBind
|
|
End If
|
|
End Property
|
|
|
|
Public Property Get IQueueManager_EarlyBindServices() As Boolean
|
|
IQueueManager_EarlyBindServices = gbEarlyBindServices
|
|
End Property
|
|
|
|
'********************
|
|
'Expediter Properties
|
|
'********************
|
|
|
|
Public Property Let IQueueManager_ShowExpediter(ByVal bShow As Boolean)
|
|
Attribute IQueueManager_ShowExpediter.VB_Description = "Sets the Show property of the AEExpediter.Expediter object."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: To set the Show property of the Expediter
|
|
'Effects:
|
|
' [gbShowExpediter]
|
|
' becomes equal to the passed parameter
|
|
'Assumes:
|
|
' [goExpediter]
|
|
' Is a valid AEExpediter.Expediter object
|
|
'-------------------------------------------------------------------------
|
|
'If the property setting actually
|
|
'changes the current property pass
|
|
'the property change to the expediter
|
|
If Not bShow = gbShowExpediter Then
|
|
goExpediter.Show = bShow
|
|
gbShowExpediter = bShow
|
|
End If
|
|
End Property
|
|
|
|
Public Property Get IQueueManager_ShowExpediter() As Boolean
|
|
IQueueManager_ShowExpediter = gbShowExpediter
|
|
End Property
|
|
|
|
Public Property Let IQueueManager_LogExpediter(ByVal bLog As Boolean)
|
|
Attribute IQueueManager_LogExpediter.VB_Description = "Set the Log property of the AEExpediter.Expediter object."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: To set the Log property of the Expediter
|
|
'Effects:
|
|
' [gbLogExpediter]
|
|
' becomes equal to the passed parameter
|
|
'Assumes:
|
|
' [goExpediter]
|
|
' Is a valid AEExpediter.Expediter object
|
|
'-------------------------------------------------------------------------
|
|
'If the property setting actually
|
|
'changes the current property pass
|
|
'the property change to the expediter
|
|
If Not bLog = gbLogExpediter Then
|
|
goExpediter.Log = bLog
|
|
gbLogExpediter = bLog
|
|
End If
|
|
End Property
|
|
|
|
Public Property Get IQueueManager_LogExpediter() As Boolean
|
|
IQueueManager_LogExpediter = gbLogExpediter
|
|
End Property
|
|
|
|
'****************************
|
|
'Public Methods
|
|
'****************************
|
|
|
|
Public Sub IQueueManager_SetProperties(ByVal bShow As Boolean, Optional ByVal bLog As Variant)
|
|
Attribute IQueueManager_SetProperties.VB_Description = "Sets all of the AEQueueMgr.QueueMgr related properties in one method call."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: To set the QueueMgr properties in one method call
|
|
'Effects: Sets the following properties to parameter values
|
|
' ShowQueue, LogQueue, WorkerQuantity
|
|
'-------------------------------------------------------------------------
|
|
With Me
|
|
.IQueueManager_ShowQueue = bShow
|
|
If Not IsMissing(bLog) Then .IQueueManager_LogQueue = bLog
|
|
End With
|
|
End Sub
|
|
|
|
Public Sub IQueueManager_SetWorkerProperties(ByVal bLog As Boolean, Optional ByVal bEarlyBindServices As Variant, _
|
|
Optional ByVal bPersistentServices As Variant)
|
|
Attribute IQueueManager_SetWorkerProperties.VB_Description = "Sets all of the AEWorker.Worker related properties on one method call."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: To set the Worker properties in one method call
|
|
'Effects: Sets the following properties to parameter values
|
|
' ShowWorkers, LogWorkers, EarlyBindServices, PersistentServices
|
|
'-------------------------------------------------------------------------
|
|
Dim oWork As clsWorker
|
|
gbLogWorkers = bLog
|
|
If Not IsMissing(bEarlyBindServices) Then gbEarlyBindServices = bEarlyBindServices
|
|
If Not IsMissing(bPersistentServices) Then IQueueManager_PersistentServices = bPersistentServices
|
|
For Each oWork In gcWorkers
|
|
oWork.Worker.SetProperties gbLogWorkers, gbEarlyBindServices, gbPersistentServices
|
|
Next oWork
|
|
End Sub
|
|
|
|
Public Sub IQueueManager_SetExpediterProperties(ByVal bShow As Boolean, Optional ByVal bLog As Variant)
|
|
Attribute IQueueManager_SetExpediterProperties.VB_Description = "Sets all of the AEExpediter.Expediter related properties in one method call."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: To set the Expediter properties in one method call
|
|
'Effects: Sets the following properties to parameter values
|
|
' ShowExpediter, LogExpediter
|
|
'-------------------------------------------------------------------------
|
|
gbShowExpediter = bShow
|
|
If Not IsMissing(bLog) Then gbLogExpediter = bLog
|
|
goExpediter.SetProperties gbShowExpediter, gbLogExpediter
|
|
|
|
End Sub
|
|
|
|
Public Sub IQueueManager_SetConnectionProperties(ByVal bUseDCOM As Boolean, Optional ByVal sProtocol As Variant, _
|
|
Optional ByVal lAuthentication As Variant)
|
|
Attribute IQueueManager_SetConnectionProperties.VB_Description = "Sets the connection parameters to be used when creating remote AEWorker.Worker objects."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: To set the Connection Settings that the QueueMgr will use
|
|
' to connect to remote Workers
|
|
'In:
|
|
' [bUseDCOM]
|
|
' If true workers will be created using DCOM instead of
|
|
' Remote Automation.
|
|
' [sProtocol]
|
|
' Protocol sequence to use when connecting to remote objects
|
|
' [lAuthentication]
|
|
' Authentication level to use
|
|
'Effects:
|
|
' [gbUseDCOM]
|
|
' becomes equal to bUseDCOM parameter
|
|
' [gsProtocol]
|
|
' becomes equal to sProtocol parameter
|
|
' [glAuthentication]
|
|
' becomes equal to lAuthentication parameter
|
|
'-------------------------------------------------------------------------
|
|
Dim iVarType As Integer 'Variant type code of lAuthentication
|
|
gbUseDCOM = bUseDCOM
|
|
If Not IsMissing(sProtocol) Then
|
|
If VarType(sProtocol) = vbString Then gsProtocol = sProtocol
|
|
End If
|
|
If Not IsMissing(lAuthentication) Then
|
|
iVarType = VarType(lAuthentication)
|
|
If iVarType = vbLong Or iVarType = vbInteger Or iVarType = vbDouble Or iVarType = vbSingle Then
|
|
glAuthentication = lAuthentication
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
Public Function IQueueManager_CreateWorkers(ByVal bRemoteWorkers As Boolean, Optional ByVal lWorkerQuantity As Variant, _
|
|
Optional ByVal lWorkersPerMachine As Variant, Optional ByVal vaMachineList As Variant, _
|
|
Optional ByVal bUseLocalMachine As Variant) As String
|
|
Attribute IQueueManager_CreateWorkers.VB_Description = "Creates AEWorker.Worker objects. Returns a string that describes any errors that occurred."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: Sets the settings for remote workers. These settings provide
|
|
' The QueueMgr the information needed to create Workers on several
|
|
' remote machines rather than just the local one.
|
|
'IN:
|
|
' [bRemoteWorkers]
|
|
' If true, the QueueMgr will create Workers on remote machines.
|
|
' If false, the QueueMgr will only create Workers on the local machine.
|
|
' [lWorkerQuantity]
|
|
' The total number of Workers to be created.
|
|
' [lWorkersPerMachine]
|
|
' A variant long specifing the maximum allowed number of Workers
|
|
' to create on a single machine.
|
|
' [vaMachineList]
|
|
' A string array, providing the list of machine names
|
|
' to create the workers on. If this is not a valid
|
|
' array of strings it will be treated like no machine
|
|
' names were specified
|
|
' [bUseLocalMachine]
|
|
' If true, include local machine in list of remote machine names
|
|
'Return: String to display to user and print to log file. Will contain
|
|
' any error information and the total number of workers created
|
|
'-------------------------------------------------------------------------
|
|
|
|
Static stbUseDCOM As Boolean 'Last DCom automation setting used
|
|
Static stsProtocol As String 'Last Automation protocol setting used
|
|
Static stlAuthentication As Long 'Last Automation Authentication setting used
|
|
Dim sResult As String 'Result of SetWorkersOnMachine function
|
|
Dim sErrors As String 'String with error descriptions to return for
|
|
'display to user
|
|
Dim oWorkerMachine As clsWorkerMachines 'Object in gcWorkerMachines collection
|
|
'that stores how many workers are instanciated
|
|
'on a particular machine
|
|
Dim lUB As Long 'Ubound of passed array
|
|
Dim bListExists As Boolean 'True if a array of machine names exists
|
|
Dim bInList As Boolean 'If true the Machine Name is in the passed array
|
|
Dim i As Integer 'For...Next loop counter
|
|
Dim lAdd As Long 'Number of Workers to add on machine
|
|
Dim lNumOnMach As Long 'Number of workers on a machine
|
|
Dim iVarType As Integer 'Variant data type of a parameter
|
|
|
|
On Error GoTo CreateWorkersError
|
|
|
|
'Validate the parameters
|
|
'validate lWorkerQuantity
|
|
iVarType = VarType(lWorkerQuantity)
|
|
If Not (iVarType = vbLong Or iVarType = vbInteger Or iVarType = vbSingle Or iVarType = vbDouble) Then
|
|
Err.Raise giINVALID_PARAMETER, , LoadResString(giINVALID_PARAMETER)
|
|
ElseIf lWorkerQuantity <= 0 Then
|
|
'Make sure at least one worker is created
|
|
lWorkerQuantity = 1
|
|
End If
|
|
If bRemoteWorkers Then
|
|
'validate vaMachineList
|
|
iVarType = VarType(vaMachineList)
|
|
If (iVarType = vbArray + vbString) Or (iVarType = vbArray + vbVariant) Then
|
|
On Error Resume Next
|
|
lUB = UBound(vaMachineList)
|
|
If Err.Number <> ERR_SUBSCRIPT_OUT_OF_RANGE Then
|
|
bListExists = True
|
|
End If
|
|
On Error GoTo CreateWorkersError
|
|
End If
|
|
'validate lworkerspermachine
|
|
iVarType = VarType(lWorkersPerMachine)
|
|
If Not (iVarType = vbLong Or iVarType = vbInteger Or iVarType = vbSingle Or iVarType = vbDouble) Then
|
|
Err.Raise giINVALID_PARAMETER, , LoadResString(giINVALID_PARAMETER)
|
|
ElseIf lWorkersPerMachine <= 0 Then
|
|
lWorkersPerMachine = 1
|
|
End If
|
|
'validate bUseLocalMachine
|
|
On Error Resume Next
|
|
bUseLocalMachine = CBool(bUseLocalMachine)
|
|
If Err.Number = ERR_TYPE_MISMATCH Then
|
|
On Error GoTo CreateWorkersError
|
|
Err.Raise giINVALID_PARAMETER, , LoadResString(giINVALID_PARAMETER)
|
|
Else
|
|
On Error GoTo CreateWorkersError
|
|
End If
|
|
End If
|
|
|
|
'First destroy all workers that can not be used any more
|
|
'If connection settings have been changed or if bRemoteWorkers
|
|
'is false all Workers on remote machines must be destroyed
|
|
If (Not bRemoteWorkers) Or (stbUseDCOM <> gbUseDCOM) Or (stsProtocol <> gsProtocol) Or (stlAuthentication <> glAuthentication) Then
|
|
'Reset the Last Connection setting static variables
|
|
stbUseDCOM = gbUseDCOM
|
|
stsProtocol = gsProtocol
|
|
stlAuthentication = glAuthentication
|
|
'Destroy all remote Workers
|
|
For Each oWorkerMachine In gcWorkerMachines
|
|
If oWorkerMachine.Remote Then
|
|
sResult = SetWorkersOnMachine(True, oWorkerMachine.MachineName, 0)
|
|
sErrors = sErrors & sResult
|
|
End If
|
|
Next
|
|
Else
|
|
'If we did not destroy all workers on remote machines
|
|
'destroy workers that are on machines that are not
|
|
'in the passed list of remote worker machines
|
|
|
|
'Check if the machine names currently in gcWorkerMachines
|
|
'are in the passed array
|
|
For Each oWorkerMachine In gcWorkerMachines
|
|
If oWorkerMachine.Remote Then
|
|
bInList = False
|
|
If bListExists Then
|
|
For i = 0 To lUB
|
|
If vaMachineList(i) = oWorkerMachine.MachineName Then
|
|
bInList = True
|
|
Exit For
|
|
End If
|
|
Next
|
|
End If
|
|
If Not bInList Then
|
|
sResult = SetWorkersOnMachine(True, oWorkerMachine.MachineName, 0)
|
|
sErrors = sErrors & sResult
|
|
End If
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
'See if Workers on local machine need destroyed
|
|
If bRemoteWorkers Then
|
|
If Not bUseLocalMachine Then
|
|
sResult = SetWorkersOnMachine(False, "", 0)
|
|
sErrors = sErrors & sResult
|
|
End If
|
|
End If
|
|
|
|
'Create Workers
|
|
If Not bRemoteWorkers Then
|
|
'Just create all workers on local machine
|
|
sResult = SetWorkersOnMachine(False, "", CLng(lWorkerQuantity))
|
|
sErrors = sErrors & sResult
|
|
Else
|
|
'Now loop through machine name list and add workers
|
|
'to each machine until giWorkerCount equals
|
|
'lWorkerQuantity or the end of the machine list is
|
|
'reached
|
|
If giWorkerCount <= lWorkerQuantity Then
|
|
'First create workers on local machine
|
|
If bUseLocalMachine Then
|
|
'Get the number of workers currently on this machine
|
|
lNumOnMach = gcWorkerMachines.Item(1).WorkerKeys.Count
|
|
'Set number of Workers to be on current machine
|
|
lAdd = lWorkersPerMachine
|
|
If lAdd > (lWorkerQuantity + lNumOnMach) - giWorkerCount Then lAdd = (lWorkerQuantity + lNumOnMach) - giWorkerCount
|
|
sResult = SetWorkersOnMachine(False, "", lAdd)
|
|
sErrors = sErrors & sResult
|
|
End If
|
|
|
|
If bListExists Then
|
|
Do Until (i > lUB Or giWorkerCount = lWorkerQuantity)
|
|
On Error Resume Next
|
|
'Get the number of workers currently on this machine
|
|
Set oWorkerMachine = gcWorkerMachines.Item(vaMachineList(i))
|
|
If Err.Number = ERR_INVALID_PROCEDURE_CALL Then
|
|
lNumOnMach = 0
|
|
Else
|
|
lNumOnMach = oWorkerMachine.WorkerKeys.Count
|
|
End If
|
|
On Error GoTo CreateWorkersError
|
|
'Set number of Workers to be on current machine
|
|
lAdd = lWorkersPerMachine
|
|
If lAdd > (lWorkerQuantity + lNumOnMach) - giWorkerCount Then lAdd = (lWorkerQuantity + lNumOnMach) - giWorkerCount
|
|
sResult = SetWorkersOnMachine(True, CStr(vaMachineList(i)), lAdd)
|
|
sErrors = sErrors & sResult
|
|
i = i + 1
|
|
Loop
|
|
End If
|
|
Else
|
|
'There may be too many workers, so destroy workers to
|
|
'make the right count
|
|
If bListExists Then
|
|
i = lUB
|
|
Do While i >= 0
|
|
On Error Resume Next
|
|
'Get the number of workers currently on this machine
|
|
Set oWorkerMachine = gcWorkerMachines.Item(vaMachineList(i))
|
|
If Err.Number = ERR_INVALID_PROCEDURE_CALL Then
|
|
lNumOnMach = 0
|
|
Else
|
|
lNumOnMach = oWorkerMachine.WorkerKeys.Count
|
|
End If
|
|
On Error GoTo CreateWorkersError
|
|
If lNumOnMach > 0 Then
|
|
lAdd = 0
|
|
If lNumOnMach > (giWorkerCount - lWorkerQuantity) Then lAdd = lNumOnMach - (giWorkerCount - lWorkerQuantity)
|
|
sResult = SetWorkersOnMachine(True, CStr(vaMachineList(i)), lAdd)
|
|
sErrors = sErrors & sResult
|
|
End If
|
|
i = i - 1
|
|
Loop
|
|
End If
|
|
|
|
'if there are still too many workers
|
|
'reduce the number of workers on the local machine
|
|
If giWorkerCount > lWorkerQuantity Then
|
|
lNumOnMach = gcWorkerMachines.Item(1).WorkerKeys.Count
|
|
lAdd = 0
|
|
If lNumOnMach > (giWorkerCount - lWorkerQuantity) Then lAdd = lNumOnMach - (giWorkerCount - lWorkerQuantity)
|
|
sResult = SetWorkersOnMachine(False, "", lAdd)
|
|
sErrors = sErrors & sResult
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
'Check if any workers were created and raise error if none were created
|
|
If giWorkerCount < lWorkerQuantity Then
|
|
If giWorkerCount = 0 Then
|
|
Err.Raise giNO_WORKERS_CREATED, , sErrors & vbCrLf & LoadResString(giNO_WORKERS_CREATED)
|
|
Else
|
|
sErrors = sErrors & vbCrLf & ReplaceString(LoadResString(giONLY_N_WORKERS_CREATED), gsNUMBER_TOKEN, CStr(giWorkerCount))
|
|
End If
|
|
Else
|
|
sErrors = sErrors & vbCrLf & LoadResString(giALL_WORKERS_CREATED)
|
|
End If
|
|
|
|
IQueueManager_CreateWorkers = sErrors
|
|
Exit Function
|
|
CreateWorkersError:
|
|
Select Case Err.Number
|
|
Case Is > giERROR_THRESHOLD
|
|
Err.Raise Err.Number + vbObjectError, Err.Source, Err.Description
|
|
Case Else
|
|
Err.Raise Err.Number, Err.Source, Err.Description
|
|
End Select
|
|
End Function
|
|
|
|
Public Function IQueueManager_GetRemoteLoggerCollection() As Collection
|
|
Attribute IQueueManager_GetRemoteLoggerCollection.VB_Description = "Returns a collection of remote AELogger.Logger objects that were created by remote AEWorker.Worker objects."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: Returnse the collection of loggers created on the same
|
|
' machines as remote Workers
|
|
'Assumes:
|
|
' [gcWorkerMachines]
|
|
' a valid collection of clsWorkerMachines object
|
|
' [clsWorkerMachines]
|
|
' If .Remote is true .WorkerKeys.Count is > 0
|
|
'-------------------------------------------------------------------------
|
|
Dim cRemoteLoggers As Collection 'Collection to return
|
|
Dim oWorkerMachine As clsWorkerMachines 'Object representing each Worker machine
|
|
Dim oLogger As APEInterfaces.ILogger 'Valid logger object or nothing
|
|
|
|
Set cRemoteLoggers = New Collection
|
|
|
|
For Each oWorkerMachine In gcWorkerMachines
|
|
With oWorkerMachine
|
|
If .Remote Then
|
|
Dim oWork As clsWorker
|
|
Set oWork = gcWorkers.Item(CStr(.WorkerKeys(1)))
|
|
Set oLogger = oWork.Worker.GetLogger
|
|
If Not oLogger Is Nothing Then
|
|
cRemoteLoggers.Add oLogger
|
|
End If
|
|
End If
|
|
End With
|
|
Next
|
|
|
|
If cRemoteLoggers.Count = 0 Then Set cRemoteLoggers = Nothing
|
|
Set IQueueManager_GetRemoteLoggerCollection = cRemoteLoggers
|
|
End Function
|
|
|
|
Public Sub IQueueManager_LoadServiceObject(ByVal ServiceLibClass As String, ByVal vServiceConfiguration As Variant)
|
|
Attribute IQueueManager_LoadServiceObject.VB_Description = "Causes all created AEWorker.Worker objects to create an object whose ProgID matches ServiceLibClass."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: Purpose is to call LoadServiceObject method in each
|
|
' instanciated worker. It is ignored if gbPeristentServices
|
|
' is false
|
|
'Assumes:
|
|
' [gcWorkers]
|
|
' Is a collection of valid AEWorker.Worker objects
|
|
'-------------------------------------------------------------------------
|
|
Dim oWork As clsWorker
|
|
If gbPersistentServices Then
|
|
For Each oWork In gcWorkers
|
|
oWork.Worker.LoadServiceObject ServiceLibClass, vServiceConfiguration
|
|
Next oWork
|
|
End If
|
|
End Sub
|
|
|
|
Public Sub IQueueManager_StopTest()
|
|
Attribute IQueueManager_StopTest.VB_Description = "Causes the AEQueueMgr to stop processing Service Requests and to empty its queue."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: Stops all Queue Managers processes
|
|
'Effects:
|
|
' May call StopQueue
|
|
' [gbStopTest]
|
|
' Becomes true
|
|
'-------------------------------------------------------------------------
|
|
'Call this to halt the Queue Manager and the Expediter
|
|
goExpediter.StopTest
|
|
gbStopTest = True
|
|
If Not gbBusyAdding And Not gbBusyGetServiceRequest Then StopQueue
|
|
Exit Sub
|
|
End Sub
|
|
|
|
Public Sub IQueueManager_StartTest()
|
|
Attribute IQueueManager_StartTest.VB_Description = "Prepares the AEQueueMgr to process Service Requests after StopTest has been called."
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: Call this to allow processing of Services after calling StopTest
|
|
'Effects:
|
|
' Resets U/I to look like QueueMgr just started
|
|
' [gbStopTest]
|
|
' Becomes False
|
|
'-------------------------------------------------------------------------
|
|
|
|
Dim oWork As clsWorker
|
|
Dim iRetry As Integer
|
|
|
|
On Error GoTo StartTestError
|
|
|
|
'Reset stats
|
|
gbStopTest = False
|
|
|
|
With goExpediter
|
|
iRetry = 0
|
|
'.QueueMgrRef must be set before StartTest is called
|
|
Set .QueueMgrRef = New clsQueueDelegator
|
|
.StartTest
|
|
End With
|
|
If gbShow Then
|
|
DisplayStatus ""
|
|
glAddCallCount = 0
|
|
glPeakQueueSize = 0
|
|
With frmQueueMgr
|
|
.lblCount.Caption = 0
|
|
.lblPeak.Caption = 0
|
|
.lblQueue.Caption = 0
|
|
.lblWorkerCount.Caption = gcWorkers.Count
|
|
.lblCount.Refresh
|
|
.lblPeak.Refresh
|
|
.lblQueue.Refresh
|
|
.lblWorkerCount.Refresh
|
|
End With
|
|
End If
|
|
Exit Sub
|
|
StartTestError:
|
|
Select Case Err.Number
|
|
Case RPC_E_CALL_REJECTED
|
|
'Collision error, the OLE server is busy
|
|
Dim il As Integer
|
|
Dim ir As Integer
|
|
'First check for stop test
|
|
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, gsNULL_SERVICE_ID
|
|
Resume
|
|
Else
|
|
'We reached our max retries
|
|
LogError Err, gsNULL_SERVICE_ID
|
|
Resume Next
|
|
End If
|
|
Case Else
|
|
Err.Raise Err.Number, Err.Source, Err.Description
|
|
End Select
|
|
End Sub
|
|
|
|
'********************
|
|
'Private Procedures
|
|
'********************
|
|
|
|
Private Sub Class_Initialize()
|
|
CountInitialize
|
|
End Sub
|
|
|
|
Private Sub Class_Terminate()
|
|
CountTerminate
|
|
End Sub
|
|
|