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.
547 lines
23 KiB
547 lines
23 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 = "clsPoolTestTool"
|
|
Attribute VB_GlobalNameSpace = True
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
'-------------------------------------------------------------------------
|
|
'This class provides a RunTest method to be called to run a Pool
|
|
'Management model test.
|
|
'-------------------------------------------------------------------------
|
|
|
|
Public Sub RunTest()
|
|
'-------------------------------------------------------------------------
|
|
'Purpose: Executes a loop for glNumberOfCalls each time calling
|
|
' AEWorker.Worker.DoActivity. Before each call a Worker
|
|
' is Requested from AEPoolMgr.Pool after each call the
|
|
' Worker is released and PoolMgr is called again to
|
|
' notify of release. This method actually runs
|
|
' a test according to set properties
|
|
'Assumes: All Client properties have been set.
|
|
'Effects:
|
|
' Calls CompleteTest when finished calling Worker
|
|
' [gbRunning]
|
|
' Is true during procedure
|
|
' [glFirstServiceTick]
|
|
' becomes the tick count of when the test is started
|
|
' [glLastCallbackTick]
|
|
' becomes the tick count of when the last call is made
|
|
' [glCallsMade]
|
|
' is incremented every time the Worker is called
|
|
' Exceptions:
|
|
' If only an MTS transaction is being performed, the MTS, not APE's
|
|
' Pool Manager, provides the pool management services.
|
|
'-------------------------------------------------------------------------
|
|
|
|
'Called by tmrStartTest so that the StartTest method can release
|
|
'the calling program.
|
|
|
|
Const lMAX_COUNT = 2147483647
|
|
Dim s As String 'Error message
|
|
Dim sServiceID As String 'Service Request ID
|
|
Dim lTicks As Long 'Tick Count
|
|
Dim lEndTick As Long 'DoEvents loop until this Tick Count
|
|
Dim lCallNumber As Long 'Number of calls to Worker
|
|
Dim lNumberOfCalls As Long 'Test duration in number of calls
|
|
Dim iDurationMode As Integer 'Test duration mode
|
|
Dim lDurationTicksEnd As Long 'Tick that test should end on
|
|
Dim bPostingServices As Boolean 'In main loop of procedure
|
|
Dim iRetry As Integer 'Number of call reties made by error handling resume
|
|
Dim vSendData As Variant 'Data to send with Service request
|
|
Dim bRandomSendData As Boolean 'If true vSendData needs generated before each new request
|
|
Dim sSendCommand As String 'Command string to be sent with Service Request
|
|
Dim bRandomCommand As Boolean 'If true sSendCommand needs generated before each new request
|
|
Dim lCallWait As Long 'Number of ticks to wait between calls
|
|
Dim bRandomWait As Boolean 'If true lCallWait needs generated before each new request
|
|
Dim bSendSomething As Boolean 'If true data needs passed with request
|
|
Dim bReceiveSomething As Boolean 'If true data is expected back from request
|
|
Dim oWorker As APEInterfaces.IWorker 'Local reference to the Worker
|
|
Dim oPool As APEInterfaces.IPool
|
|
Dim bLog As Boolean 'If true log records
|
|
Dim bShow As Boolean 'If true update display
|
|
Dim iPoolWaitRetryCount As Integer 'Number of times retry is need for each call loop
|
|
Dim bReleaseWorker As Boolean ' If True, the worker needs to be released before leaving the procedure
|
|
|
|
bReleaseWorker = False
|
|
|
|
On Error GoTo RunTestError
|
|
'If there is reentry by a timer click exit sub
|
|
If gbRunning Then Exit Sub
|
|
gbRunning = True
|
|
|
|
' If only an MTS transaction is being performed, use MTS as pool manager
|
|
If (giServiceTask = (giMASK_USE_DB_TASK Or giMASK_WRITE_MTS_TRANSACTION)) Then
|
|
RunMTSTest
|
|
Exit Sub
|
|
End If
|
|
|
|
'Set the local variables to direct the testing
|
|
Set oPool = CreateObject("AEPoolMgr.Pool")
|
|
|
|
bRandomSendData = GetTestData(bSendSomething, bReceiveSomething, vSendData)
|
|
lCallWait = GetValueFromRange(gudtWaitPeriod, bRandomWait)
|
|
sSendCommand = GetServiceCommand(bRandomCommand)
|
|
bLog = gbLog
|
|
bShow = gbShow
|
|
|
|
s = LoadResString(giTEST_STARTED)
|
|
If bLog Then AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
|
|
DisplayStatus s
|
|
glFirstServiceTick = GetTickCount()
|
|
glLastCallbackTick = glFirstServiceTick ' If 0 calls are completed, the time spent will be 0 ticks
|
|
|
|
'Test duration variables
|
|
iDurationMode = giTestDurationMode
|
|
If iDurationMode = giTEST_DURATION_CALLS Then
|
|
lNumberOfCalls = glNumberOfCalls
|
|
ElseIf iDurationMode = giTEST_DURATION_TICKS Then
|
|
lDurationTicksEnd = glFirstServiceTick + glTestDurationInTicks
|
|
End If
|
|
|
|
bPostingServices = True
|
|
Do While Not gbStopping
|
|
'Check if new data needs generated because of randomization
|
|
If bRandomSendData Then bRandomSendData = GetTestData(bSendSomething, bReceiveSomething, vSendData)
|
|
If bRandomWait Then lCallWait = GetValueFromRange(gudtWaitPeriod, bRandomWait)
|
|
If bRandomCommand Then sSendCommand = GetServiceCommand(bRandomCommand)
|
|
|
|
'Increment number of calls made
|
|
lCallNumber = glCallsMade + 1
|
|
'Get a Worker from the PoolMgr
|
|
'Post the service to a worker
|
|
'Post a synchronous service
|
|
sServiceID = glClientID & "." & lCallNumber
|
|
iRetry = 0
|
|
iPoolWaitRetryCount = 0
|
|
RunTest_GetWorkerRetry:
|
|
Set oWorker = oPool.GetWorker
|
|
'Pool Manager may reject request for worker
|
|
'If it does wait sometime and retry
|
|
If oWorker Is Nothing Then GoTo RunTest_WaitForPool
|
|
bReleaseWorker = True
|
|
iRetry = 0
|
|
iPoolWaitRetryCount = 0
|
|
'Display CallsMade
|
|
If bShow Then
|
|
With frmClient
|
|
.lblCallsMade = lCallNumber
|
|
.lblCallsMade.Refresh
|
|
End With
|
|
End If
|
|
If bSendSomething Then
|
|
oWorker.DoService sServiceID, sSendCommand, vSendData
|
|
Else
|
|
oWorker.DoService sServiceID, sSendCommand
|
|
End If
|
|
glLastCallbackTick = GetTickCount
|
|
Set oWorker = Nothing
|
|
oPool.ReleaseWorker
|
|
bReleaseWorker = False
|
|
|
|
'Display CallsReturned
|
|
If bShow Then
|
|
With frmClient
|
|
.lblCallsReturned = lCallNumber
|
|
.lblCallsReturned.Refresh
|
|
End With
|
|
End If
|
|
'If gbStopping Then Exit Do
|
|
'Go into an idle loop util the next call.
|
|
If lCallWait > 0 Then
|
|
lEndTick = GetTickCount + lCallWait
|
|
Do While GetTickCount() < lEndTick And Not gbStopping
|
|
DoEvents
|
|
Loop
|
|
End If
|
|
glCallsMade = lCallNumber
|
|
glCallsReturned = lCallNumber
|
|
|
|
'See if it is time to stop the test
|
|
If iDurationMode = giTEST_DURATION_CALLS Then
|
|
If lCallNumber >= lNumberOfCalls Then Exit Do
|
|
ElseIf iDurationMode = giTEST_DURATION_TICKS Then
|
|
If GetTickCount >= lDurationTicksEnd Then Exit Do
|
|
End If
|
|
Loop
|
|
StopTestNow:
|
|
bPostingServices = False
|
|
gbRunning = False
|
|
Set oWorker = Nothing
|
|
If gbStopping Then
|
|
'Someone hit the stop button on the Explorer.
|
|
gStopTest
|
|
GoTo CleanupAndExit
|
|
End If
|
|
If bLog Then AddLogRecord gsNULL_SERVICE_ID, LoadResString(giSERVICES_POSTED), GetTickCount(), False
|
|
CompleteTest
|
|
GoTo CleanupAndExit
|
|
RunTest_WaitForPool:
|
|
If iPoolWaitRetryCount <= giMAX_ALLOWED_RETRIES Then
|
|
iPoolWaitRetryCount = iPoolWaitRetryCount + 1
|
|
lEndTick = GetTickCount + lCallWait + giPOOL_WAIT_RETRY_MIN
|
|
Do While GetTickCount() < lEndTick And Not gbStopping
|
|
DoEvents
|
|
Loop
|
|
GoTo RunTest_GetWorkerRetry
|
|
Else
|
|
'We reached our max retries
|
|
s = LoadResString(giPOOL_MGR_REJECTION_WAITS_EXHAUSTED)
|
|
If bLog Then AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
|
|
DisplayStatus s
|
|
StopOnError s
|
|
Exit Sub
|
|
End If
|
|
Exit Sub
|
|
RunTestError:
|
|
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 if stopping test
|
|
If gbStopping Then GoTo StopTestNow
|
|
AddLogRecord gsNULL_SERVICE_ID, LoadResString(giQUEUE_SERVICE_COLLISION_RETRY), GetTickCount(), False
|
|
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
|
|
If gbStopping Then Resume Next Else Resume
|
|
Else
|
|
'We reached our max retries
|
|
s = LoadResString(giCOLLISION_ERROR)
|
|
AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
|
|
DisplayStatus s
|
|
StopOnError s
|
|
GoTo CleanupAndExit
|
|
End If
|
|
Case ERR_OBJECT_VARIABLE_NOT_SET
|
|
'Worker was not successfully created
|
|
s = LoadResString(giQUEUE_SERVICE_ERROR) & CStr(Err.Number) & gsSEPERATOR & Err.Source & gsSEPERATOR & Err.Description
|
|
DisplayStatus Err.Description
|
|
AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
|
|
StopOnError s
|
|
Exit Sub
|
|
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 oWorker = oInstancer.object("AEWorker.Worker")
|
|
Set oInstancer = Nothing
|
|
Resume Next
|
|
Case RPC_S_UNKNOWN_AUTHN_TYPE
|
|
'Tried to connect to a server that does not support
|
|
'specified authentication level. Display message and
|
|
'switch to no authentication and try again
|
|
Dim iResult As Integer
|
|
s = LoadResString(giUSING_NO_AUTHENTICATION)
|
|
DisplayStatus s
|
|
AddLogRecord gsNULL_SERVICE_ID, s, 0, False
|
|
glConnectionAuthentication = RPC_C_AUTHN_LEVEL_NONE
|
|
iResult = goRegClass.SetAutoServerSettings(True, "AEPoolMgr.Pool", , gsConnectionAddress, gsConnectionProtocol, glConnectionAuthentication)
|
|
Resume
|
|
Case ERR_OVER_FLOW
|
|
s = CStr(Err.Number) & gsSEPERATOR & Err.Source & gsSEPERATOR & Err.Description
|
|
lCallNumber = 0
|
|
AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
|
|
Case giRPC_ERROR_ACCESSING_COLLECTION
|
|
Set oWorker = Nothing
|
|
oPool.ReleaseWorker
|
|
bReleaseWorker = False
|
|
s = LoadResString(giRPC_ERROR_ACCESSING_COLLECTION)
|
|
DisplayStatus s
|
|
AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
|
|
StopOnError s
|
|
Exit Sub
|
|
Case RPC_PROTOCOL_SEQUENCE_NOT_FOUND
|
|
'Most probably because of an attempt to create a Named Pipe under Win95
|
|
If frmClient.SysInfo.OSPlatform = 1 And gbConnectionNetOLE = False And gbConnectionRemote = True _
|
|
And gsConnectionProtocol = "ncacn_np" Then
|
|
Set oWorker = Nothing
|
|
oPool.ReleaseWorker
|
|
bReleaseWorker = False
|
|
s = LoadResString(giNO_NAMED_PIPES_UNDER_WIN95)
|
|
AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
|
|
DisplayStatus s
|
|
StopOnError s
|
|
Exit Sub
|
|
End If
|
|
Case Else
|
|
s = LoadResString(giQUEUE_SERVICE_ERROR) & CStr(Err.Number) & gsSEPERATOR & Err.Source & gsSEPERATOR & Err.Description
|
|
DisplayStatus Err.Description
|
|
AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
|
|
If bPostingServices Then
|
|
StopOnError s
|
|
GoTo CleanupAndExit
|
|
Else
|
|
Resume Next
|
|
End If
|
|
End Select
|
|
|
|
CleanupAndExit:
|
|
On Error Resume Next
|
|
If bReleaseWorker And Not oPool Is Nothing Then
|
|
oPool.ReleaseWorker
|
|
End If
|
|
End Sub
|
|
|
|
Public Sub RunMTSTest()
|
|
' Similar to RunTest, but specifically for using MTS, not APE's Pool Manager, for pooling objects.
|
|
' This occurs when an MTS transaction (and no CPU task) is being performed.
|
|
Const lMAX_COUNT = 2147483647
|
|
|
|
Const miMinQueryRetryDelay As Integer = 20 ' Min delay (ms) between retries of a query that failed due to a locking contention
|
|
Const miMaxQueryRetryDelay As Integer = 100 ' Max delay (ms) between retries of a query that failed due to a locking contention
|
|
|
|
Dim s As String 'Error message
|
|
Dim lTicks As Long 'Tick Count
|
|
Dim lEndTick As Long 'DoEvents loop until this Tick Count
|
|
Dim lCallNumber As Long 'Number of calls to Worker
|
|
Dim lNumberOfCalls As Long 'Test duration in number of calls
|
|
Dim iDurationMode As Integer 'Test duration mode
|
|
Dim lDurationTicksEnd As Long 'Tick that test should end on
|
|
Dim bPostingServices As Boolean 'In main loop of procedure
|
|
Dim iRetry As Integer 'Number of call reties made by error handling resume
|
|
Dim lCallWait As Long 'Number of ticks to wait between calls
|
|
Dim bRandomWait As Boolean 'If true lCallWait needs generated before each new request
|
|
Dim bLog As Boolean 'If true log records
|
|
Dim bShow As Boolean 'If true update display
|
|
Dim oMoveMoney As APEInterfaces.IMTSMoveMoney
|
|
Dim sConnect As String ' Connect string
|
|
Dim eConnectOptions As ape_DbConnectionOptions ' Database connection option
|
|
Dim bLogMTSTransactions As Boolean ' If True, log MTS events
|
|
Dim bShowMTSTransactions As Boolean ' If True, show MTS events
|
|
Dim iTransferRetries As Integer ' Number of attempts at performing the transfer
|
|
|
|
On Error GoTo RunMTSTestError
|
|
bLog = gbLog
|
|
bShow = gbShow
|
|
|
|
' Set up connect string and database connection options
|
|
sConnect = gvServiceConfiguration(ape_conConnectionString)
|
|
eConnectOptions = gvServiceConfiguration(ape_conConnectionOption)
|
|
bLogMTSTransactions = gvServiceConfiguration(ape_conLogMTSTransactions)
|
|
bShowMTSTransactions = gvServiceConfiguration(ape_conShowMTSTransactions)
|
|
|
|
s = LoadResString(giTEST_STARTED)
|
|
If bLog Then AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
|
|
DisplayStatus s
|
|
Randomize
|
|
glFirstServiceTick = GetTickCount()
|
|
glLastCallbackTick = glFirstServiceTick ' If 0 calls are completed, the time spent will be 0 ticks
|
|
|
|
'Test duration variables
|
|
iDurationMode = giTestDurationMode
|
|
If iDurationMode = giTEST_DURATION_CALLS Then
|
|
lNumberOfCalls = glNumberOfCalls
|
|
ElseIf iDurationMode = giTEST_DURATION_TICKS Then
|
|
lDurationTicksEnd = glFirstServiceTick + glTestDurationInTicks
|
|
End If
|
|
|
|
bPostingServices = True
|
|
Do While Not gbStopping
|
|
'Increment number of calls made
|
|
lCallNumber = glCallsMade + 1
|
|
'Get a Worker from the PoolMgr
|
|
'Post the service to a worker
|
|
'Post a synchronous service
|
|
iRetry = 0
|
|
|
|
' Create the appropriate MoveMoney object
|
|
Set oMoveMoney = CreateObject("AEMTSSvc.MoveMoney")
|
|
|
|
iRetry = 0
|
|
If bLogMTSTransactions Then
|
|
AddLogRecord gsNULL_SERVICE_ID, LoadResString(giBEGIN_MTS_TRANSACTION), GetTickCount(), False
|
|
End If
|
|
On Error Resume Next
|
|
Const iMAX_ACCOUNT_NO = 1000 ' Highest account number (1 is presumed to be the lowest)
|
|
Dim lFromAccount As Long, lToAccount As Long
|
|
lFromAccount = 1 + Int(iMAX_ACCOUNT_NO * Rnd)
|
|
lToAccount = 1 + Int(iMAX_ACCOUNT_NO * Rnd)
|
|
iTransferRetries = 0
|
|
|
|
Dim bRetry As Boolean
|
|
Do
|
|
bRetry = False
|
|
oMoveMoney.Transfer sConnect, eConnectOptions, lFromAccount, lToAccount, 1
|
|
glLastCallbackTick = GetTickCount
|
|
Dim lError As Long
|
|
lError = Err.Number
|
|
On Error GoTo RunMTSTestError
|
|
' If the error is due to a locking contention, try again
|
|
If lError <> 0 And iTransferRetries < giMAX_ALLOWED_RETRIES Then
|
|
Select Case eConnectOptions
|
|
Case ape_idcADO
|
|
bRetry = (lError = -2147467259)
|
|
Case ape_idcDAO
|
|
If lError = 3146 Then
|
|
' First make sure the cause really is a locking contention
|
|
Dim DAOErr As DAO.Error
|
|
For Each DAOErr In DBEngine.Errors
|
|
If DAOErr.Number = 1205 Then ' 1205 = SQL Server record locking contention
|
|
bRetry = True
|
|
End If
|
|
Next
|
|
End If
|
|
Case ape_idcRDO
|
|
If lError = 40002 Then
|
|
' First make sure the cause really is a locking contention
|
|
Dim RDOErr As RDO.rdoError
|
|
For Each RDOErr In rdoEngine.rdoErrors
|
|
If RDOErr.Number = 1205 Then ' 1205 = SQL Server record locking contention
|
|
bRetry = True
|
|
End If
|
|
Next
|
|
End If
|
|
Case ape_idcODBC
|
|
bRetry = (lError = ErrorResourceDeadlock)
|
|
End Select
|
|
If bRetry Then
|
|
iTransferRetries = iTransferRetries + 1
|
|
Sleep miMinQueryRetryDelay + (miMaxQueryRetryDelay - miMinQueryRetryDelay) * Rnd ' Randomize the delay to avoid repeated contentions
|
|
DoEvents
|
|
End If
|
|
End If
|
|
Loop While bRetry
|
|
If bLogMTSTransactions Then
|
|
AddLogRecord gsNULL_SERVICE_ID, LoadResString(IIf(lError = 0, giEND_MTS_TRANSACTION_SUCCEEDED, _
|
|
giEND_MTS_TRANSACTION_FAILED)), GetTickCount(), False
|
|
End If
|
|
If bShowMTSTransactions Then
|
|
frmService.MTSResults (lError = 0)
|
|
End If
|
|
Set oMoveMoney = Nothing
|
|
|
|
'Display CallsMade
|
|
If bShow Then
|
|
With frmClient
|
|
.lblCallsMade = lCallNumber
|
|
.lblCallsReturned = lCallNumber
|
|
.lblCallsMade.Refresh
|
|
.lblCallsReturned.Refresh
|
|
End With
|
|
End If
|
|
'If gbStopping Then Exit Do
|
|
'Go into an idle loop util the next call.
|
|
If lCallWait > 0 Then
|
|
lEndTick = GetTickCount + lCallWait
|
|
Do While GetTickCount() < lEndTick And Not gbStopping
|
|
DoEvents
|
|
Loop
|
|
End If
|
|
glCallsMade = lCallNumber
|
|
glCallsReturned = lCallNumber
|
|
|
|
'See if it is time to stop the test
|
|
If iDurationMode = giTEST_DURATION_CALLS Then
|
|
If lCallNumber >= lNumberOfCalls Then Exit Do
|
|
ElseIf iDurationMode = giTEST_DURATION_TICKS Then
|
|
If GetTickCount >= lDurationTicksEnd Then Exit Do
|
|
End If
|
|
Loop
|
|
StopMTSTestNow:
|
|
bPostingServices = False
|
|
gbRunning = False
|
|
Set oMoveMoney = Nothing
|
|
If gbStopping Then
|
|
'Someone hit the stop button on the Explorer.
|
|
gStopTest
|
|
Exit Sub
|
|
End If
|
|
If bLog Then AddLogRecord gsNULL_SERVICE_ID, LoadResString(giSERVICES_POSTED), GetTickCount(), False
|
|
CompleteTest
|
|
Exit Sub
|
|
RunMTSTestError:
|
|
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 if stopping test
|
|
If gbStopping Then GoTo StopMTSTestNow
|
|
AddLogRecord gsNULL_SERVICE_ID, LoadResString(giQUEUE_SERVICE_COLLISION_RETRY), GetTickCount(), False
|
|
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
|
|
If gbStopping Then Resume Next Else Resume
|
|
Else
|
|
'We reached our max retries
|
|
s = LoadResString(giCOLLISION_ERROR)
|
|
AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
|
|
DisplayStatus s
|
|
StopOnError s
|
|
Exit Sub
|
|
End If
|
|
Case ERR_OBJECT_VARIABLE_NOT_SET
|
|
'Worker was not successfully created
|
|
s = LoadResString(giQUEUE_SERVICE_ERROR) & CStr(Err.Number) & gsSEPERATOR & Err.Source & gsSEPERATOR & Err.Description
|
|
DisplayStatus Err.Description
|
|
AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
|
|
StopOnError s
|
|
Exit Sub
|
|
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 oMoveMoney = oInstancer.object("AEMTSService.MoveMoney")
|
|
Set oInstancer = Nothing
|
|
Resume Next
|
|
Case ERR_OVER_FLOW
|
|
s = CStr(Err.Number) & gsSEPERATOR & Err.Source & gsSEPERATOR & Err.Description
|
|
lCallNumber = 0
|
|
AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
|
|
Case ERR_CANT_CREATE_OBJECT ' CreateObject failed
|
|
s = LoadResString(giERROR_CREATE_MTS_OBJECT)
|
|
DisplayStatus s
|
|
AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
|
|
StopOnError s
|
|
Exit Sub
|
|
Case Else
|
|
s = LoadResString(giQUEUE_SERVICE_ERROR) & CStr(Err.Number) & gsSEPERATOR & Err.Source & gsSEPERATOR & Err.Description
|
|
DisplayStatus Err.Description
|
|
AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
|
|
If bPostingServices Then
|
|
StopOnError s
|
|
Exit Sub
|
|
Else
|
|
Resume Next
|
|
End If
|
|
End Select
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
|