Initial full mirror of c:\VWE (source + assets + toolchain + outputs) via Git LFS

Complete disaster-recovery snapshot: engine/game source, game data assets,
VC6 toolchain + DX SDKs, build outputs, deployed game, and _UNUSED archive.
Large binaries in Git LFS; text preserved byte-for-byte (core.autocrlf=false,
no eol attributes). See RECOVERY.md for the one-clone rebuild procedure.

build-env/VisualStudio6/Common/Tools/APE/AEMTSSVC.PAK

@@ -0,0 +1,80 @@
+[{63E1ECAD-A520-11D1-9D8B-0020781039AF} - I1]
+Roles=0
+InterfaceID={63E1ECAC-A520-11D1-9D8B-0020781039AF}
+Description=
+AuthLevel=4
+ProxyStubDLL=
+[{63E1ECAD-A520-11D1-9D8B-0020781039AF} - I2]
+Roles=0
+InterfaceID={C93809AB-684C-11D1-9D3E-0020781039AF}
+Description=
+AuthLevel=4
+ProxyStubDLL=
+[{21D61CE6-A517-11D1-9D8B-0020781039AF} - C1]
+Roles=0
+Clsid={63E1ECAD-A520-11D1-9D8B-0020781039AF}
+Description=APE MTS Transaction Account Component
+ProgID=AEMTSSvc.Account
+Transaction=Required
+RunInASP=Y
+InProc=N
+Local=Y
+Remote=N
+Internet=N
+Security=Y
+AuthLevel=4
+System=N
+Origin=Install
+Wrapped=Y
+CompDLL=AEMTSSvc.dll
+TypeLib=AEMTSSvc.dll
+Interfaces=2
+[{63E1ECAF-A520-11D1-9D8B-0020781039AF} - I1]
+Roles=0
+InterfaceID={63E1ECAE-A520-11D1-9D8B-0020781039AF}
+Description=
+AuthLevel=4
+ProxyStubDLL=
+[{63E1ECAF-A520-11D1-9D8B-0020781039AF} - I2]
+Roles=0
+InterfaceID={C93809AC-684C-11D1-9D3E-0020781039AF}
+Description=
+AuthLevel=4
+ProxyStubDLL=
+[{21D61CE6-A517-11D1-9D8B-0020781039AF} - C2]
+Roles=0
+Clsid={63E1ECAF-A520-11D1-9D8B-0020781039AF}
+Description=APE MTS Transaction MoveMoney Component
+ProgID=AEMTSSvc.MoveMoney
+Transaction=Required
+RunInASP=Y
+InProc=N
+Local=Y
+Remote=N
+Internet=N
+Security=Y
+AuthLevel=4
+System=N
+Origin=Install
+Wrapped=Y
+CompDLL=AEMTSSvc.dll
+TypeLib=AEMTSSvc.dll
+Interfaces=2
+[{21D61CE6-A517-11D1-9D8B-0020781039AF}]
+Name=Visual Studio APE Package
+Description=APE MTS Transaction Package for Microsoft Visual Studio 6.0
+System=N
+Latency=3
+Shutdown=N
+Security=N
+AuthLevel=4
+Components=2
+Roles=0
+Activation=Local
+Changeable=Y
+Deleteable=Y
+[Packages]
+Package1={21D61CE6-A517-11D1-9D8B-0020781039AF}
+Packages=1
+Version=2.01
+ExtendedVersion=2.01

build-env/VisualStudio6/Common/Tools/APE/Source/Aeclient/AECLIENT.RC

@@ -0,0 +1,66 @@
+STRINGTABLE DISCARDABLE 
+BEGIN
+	//Logging strings
+	1	"*** Do *NOT* Localize any string that starts with '***'.  They are comments to be used by localizers to identify sections.  They also mark the beginning of a new 'section' within the String Table."
+	2	"Client"
+	3	"Callback Received"
+	4	"Callback Error Received"
+	5	"Asynchronous Service Posted"
+
+	7	"Error:  RunTest"
+	9	"RunTest Collision Retry"
+
+	12	"Error:  WaitPeriod property"
+	13	"Start Test Received"
+	14	"Stop Test Received"
+	16	"Test Started"
+	17	"Test Complete"
+	18	"Calls Complete"
+	19	"Callbacks Complete"
+	20	"Initializing Test"
+	
+	21	"Synchronous Service Posted"
+	22	"DoService Posted"
+	23	"Writing Temporary Log File"
+	24	"No authentication used"
+	26	"Disk full, logging turned off."
+	27	"PoolMgr rejection retries exhausted."
+	28	"Could not create MTS Service. Check the documentation for further help."
+	29	"*** Font information for all forms.  Index 30 is the Character set, Index 31 is Font name, Index 32 is Font Size"
+	30	"0"
+	31	"Tahoma"
+	32	"10"
+	50	"Error:  "
+	
+	//U/I captions
+	100	"*** U/I captions"
+	101	"Client"		//Form Caption
+	102	"Calls Made"		//Calls Made Caption
+	103	"Calls Returned"	//Calls Returned Caption
+	
+	110	"Successful Transactions:"
+	111	"Aborted Transactions:"
+	112	"Begin MTS Transaction"
+	113	"End MTS Transaction - Failed"
+	114	"End MTS Transaction - Succeeded"
+	115	"MTS Transaction Status"
+
+	//Racreg32 error codes with 200 added for offset
+	200	"*** Racreg32 error codes with 200 added for offset"
+	201	"Unknown run time error occurred"
+	202	"No protocol was specified"
+	203	"No server machine name was specified"
+	204	"An error occurred reading from the registry"
+	205	"An error occurred writing to the registry"
+	206	"Both the ProgID and CLSID parameters were missing"
+	207	"There is no local server (either in-process or cross-process, 16-bit or 32-bit)"
+	208	"There was an error looking for the Proxy DLLs, check that they were installed properly"
+
+	//Errors
+	32000	"Error descriptions"
+	32767	"OLE collision retries exhausted"
+	32765	"A required parameter is missing."
+	32750	"An error occurred changing server connection settings: <NAME>."
+	32740	"An error occured during communication with remote services. Refer to the APE troubleshooting in help."
+	32739	"Remote Automation Failure: Microsoft Windows 95 cannot create named pipes. Select a different Remote Automation protocol."
+END

build-env/VisualStudio6/Common/Tools/APE/Source/Aeclient/AECLIENT.VBP

@@ -0,0 +1,64 @@
+Type=OleExe
+Reference=*\G{244D13BD-AFDB-11CE-85D1-00AA00695286}#1.1#0#C:\WINNT\System32\RACREG32.DLL#RacReg
+Reference=*\G{C93809A0-684C-11D1-9D3E-0020781039AF}#1.0#0#..\AEIntrfc\AEIntrfc.TLB#Application Performance Explorer 2.0 Interfaces
+Reference=*\G{133C84D0-7340-11D1-9D4A-0020781039AF}#1.0#0#..\AEIntrfc\AEExpdtr.tlb#Application Performance Explorer Expediter Event Return Interfaces
+Reference=*\G{00000200-0000-0010-8000-00AA006D2EA4}#2.0#0#C:\Program Files\Common Files\System\ADO\msado15.dll#Microsoft ActiveX Data Objects 2.0 Library
+Reference=*\G{00025E01-0000-0000-C000-000000000046}#4.0#0#C:\Program Files\Common Files\Microsoft Shared\DAO\DAO350.DLL#Microsoft DAO 3.51 Object Library
+Reference=*\G{EE008642-64A8-11CE-920F-08002B369A33}#2.0#0#C:\WINNT\System32\msrdo20.dll#Microsoft Remote Data Object 2.0
+Class=Client; client.cls
+Module=modClient; modclnt.bas
+Class=clsCallback; clscalbk.cls
+Class=clsClientService; clscntsv.cls
+Class=clsDirectTestTool; clsdrttl.cls
+Class=clsQueueTestTool; clsquetl.cls
+Module=modAEConstants; ..\AEInclud\modaecon.bas
+Module=modVBErrors; ..\AEInclud\modvberr.bas
+Module=modWin32Errors; ..\AEInclud\modwiner.bas
+Class=clsPositionForm; ..\AEInclud\clsposfm.cls
+Form=frmclnt.frm
+Class=clsPoolTestTool; clsPooTl.cls
+Module=modAEGlobals; ..\AEInclud\modAEGlb.bas
+Module=Utility; ..\AEInclud\Utility.bas
+Module=Localize; ..\AEInclud\Localize.bas
+Form=..\AEServic\Service.frm
+Object={6FBA474E-43AC-11CE-9A0E-00AA0062BB4C}#1.0#0; SYSINFO.OCX
+ResFile32="aeclient.res"
+Module=ODBCAPI; ..\AEInclud\ODBCAPI.bas
+IconForm="frmClient"
+Startup="(None)"
+HelpFile=""
+Title="APE Client"
+ExeName32="AEClient.exe"
+Path32="..\..\Retail"
+Command32=""
+Name="AEClient"
+HelpContextID="0"
+Description="Application Performance Explorer Client"
+CompatibleMode="1"
+CompatibleEXE32="..\AECompat\AEClient.cmp"
+MajorVer=2
+MinorVer=0
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+VersionCompanyName="Microsoft Corporation"
+VersionFileDescription="Application Performance Explorer Client"
+VersionLegalCopyright="Copyright © 1996-1998 Microsoft Corp."
+VersionLegalTrademarks="Microsoft® is a registered trademark of Microsoft Corporation. Windows(TM) is a trademark of Microsoft Corporation"
+VersionProductName="Application Performance Explorer Client"
+CompilationType=0
+OptimizationType=0
+FavorPentiumPro(tm)=0
+CodeViewDebugInfo=0
+NoAliasing=0
+BoundsCheck=0
+OverflowCheck=0
+FlPointCheck=0
+FDIVCheck=0
+UnroundedFP=0
+StartMode=1
+Unattended=0
+Retained=0
+ThreadPerObject=0
+MaxNumberOfThreads=1
+DebugStartupOption=0

build-env/VisualStudio6/Common/Tools/APE/Source/Aeclient/CLIENT.CLS

@@ -0,0 +1,892 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = 0   'False
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "Client"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = True
+Attribute VB_Description = "APE Client"
+Option Explicit
+
+Implements APEInterfaces.IClient
+
+'Private class level variables
+Private mbFirstClientOnMachine As Boolean   'If true, this is the first Client application
+                                            'started on this machine
+'*****************
+'Public Properties
+'*****************
+
+Public Property Set IClient_Explorer(ByVal oExplorer As APEInterfaces.IManagerCallback)
+Attribute IClient_Explorer.VB_Description = "Set the Manager object that the Client will use to notify test completion."
+    '-------------------------------------------------------------------------
+    'Purpose:   To give the client a reference to AEManager.Explorer
+    'IN:
+    '   [oExplorer]
+    '           must be valid reference to a AEManager.Explorer class object
+    'Effects:
+    '   [goExplorer]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    Set goExplorer = oExplorer
+End Property
+
+Public Property Get IClient_MachineName() As String
+Attribute IClient_MachineName.VB_Description = "Returns the computer name that the Client is instanciated on."
+    'Get the local computer name
+    Dim l As Long
+    Dim s As String
+    s = Space$(255)
+    l = GetComputerName(s, 255)
+    l = InStr(s, vbNullChar)
+    s = Left$(s, l - 1)
+    IClient_MachineName = s
+End Property
+
+Public Property Let IClient_ConnectionAddress(ByVal sAddress As String)
+Attribute IClient_ConnectionAddress.VB_Description = "Set the network address for the location of the APE server."
+    '-------------------------------------------------------------------------
+    'Purpose:   The netaddress used for remote connections
+    'Effects:
+    '   [gsConnectionAddress]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    gsConnectionAddress = sAddress
+End Property
+
+Public Property Get IClient_ConnectionAddress() As String
+    IClient_ConnectionAddress = gsConnectionAddress
+End Property
+
+Public Property Let IClient_ConnectionProtocol(ByVal sProtocol As String)
+Attribute IClient_ConnectionProtocol.VB_Description = "Sets the protocol to be used for Remote Automation connections."
+    '-------------------------------------------------------------------------
+    'Purpose:   The RPC protocol to use for all remote connections.
+    'Effects:
+    '   [gsConnectionProtocol]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    gsConnectionProtocol = sProtocol
+End Property
+
+Public Property Get IClient_ConnectionProtocol() As String
+    IClient_ConnectionProtocol = gsConnectionProtocol
+End Property
+
+Public Property Let IClient_ConnectionAuthentication(ByVal lAuthentication As Long)
+Attribute IClient_ConnectionAuthentication.VB_Description = "Sets the authentication level to be used for Remote Automation connections."
+    '-------------------------------------------------------------------------
+    'Purpose:   The RPC authenticaion to enforce for all remote connections.
+    'Effects:
+    '   [gsConnectionAuthentication]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    glConnectionAuthentication = lAuthentication
+End Property
+
+Public Property Get IClient_ConnectionAuthentication() As Long
+    IClient_ConnectionAuthentication = glConnectionAuthentication
+End Property
+
+Public Property Let IClient_ConnectionRemote(ByVal bRemote As Boolean)
+Attribute IClient_ConnectionRemote.VB_Description = "Determines if the Client will connect to a remote APE server or to a local APE server."
+    '-------------------------------------------------------------------------
+    'Purpose:   If true server is remote and ConnectionAddress, ConnectionProtocol,
+    '           ConnectionNetOLE, and ConnectionAuthentication apply
+    'Effects:
+    '   [gsConnectionRemote]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    gbConnectionRemote = bRemote
+End Property
+
+Public Property Get IClient_ConnectionRemote() As Boolean
+    IClient_ConnectionRemote = gbConnectionRemote
+End Property
+
+Public Property Let IClient_ConnectionNetOLE(ByVal bNetOLE As Boolean)
+Attribute IClient_ConnectionNetOLE.VB_Description = "Determines if the Client will use DCOM to connect to the APE server."
+    '-------------------------------------------------------------------------
+    'Purpose:   If true use NetOLE (DCOM) for remote connection, instead of
+    '           Remote Automation
+    'Effects:
+    '   [gsConnectionNetOLE]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    gbConnectionNetOLE = bNetOLE
+End Property
+
+Public Property Get IClient_ConnectionNetOLE() As Boolean
+    IClient_ConnectionNetOLE = gbConnectionNetOLE
+End Property
+
+Public Property Let IClient_ID(ByVal lID As Long)
+Attribute IClient_ID.VB_Description = "Sets and returns the Client ID for Client management."
+    '-------------------------------------------------------------------------
+    'Purpose:   Unique ID for the client in this test.  ID is used to seperate
+    '           Clients log records and differentiate title bars
+    'Effects:
+    '   [glClientID]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    glClientID = lID
+End Property
+
+Public Property Get IClient_ID() As Long
+    IClient_ID = glClientID
+End Property
+
+Public Property Let IClient_Model(ByVal lModel As Long)
+Attribute IClient_Model.VB_Description = "Determines what test model the Client will perform."
+    '-------------------------------------------------------------------------
+    'Purpose:   'What model to use for this test.
+    '               0 or giMODEL_QUEUE - Queue Management
+    '               2 or gimodel_direct - Direct Instanciation
+    'Effects:
+    '   [glModel]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    glModel = lModel
+End Property
+
+Public Property Get IClient_Model() As Long
+    IClient_Model = glModel
+End Property
+
+Public Property Let IClient_Show(ByVal bShow As Boolean)
+Attribute IClient_Show.VB_Description = "Determines if the Client will show a form."
+    '-------------------------------------------------------------------------
+    'Purpose:   If true, show the Client's U/I
+    'Effects:
+    '   [gbShow]
+    '           Set equal to parameter
+    '   [frmClient.Visible]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    frmClient.Visible = bShow
+    gbShow = bShow
+    If bShow Then
+        'Update values on U/I
+        With frmClient
+            .lblCallsMade.Caption = 0
+            .lblCallsReturned.Caption = 0
+            .lblCallsMade.Refresh
+            .lblCallsReturned.Refresh
+        End With
+    End If
+End Property
+
+Public Property Get IClient_Show() As Boolean
+    IClient_Show = gbShow
+End Property
+
+Public Property Let IClient_Log(ByVal bLog As Boolean)
+Attribute IClient_Log.VB_Description = "Determines if the Client logs its events and errors."
+    '-------------------------------------------------------------------------
+    'Purpose:   If true, log events in the Client
+    'Effects:
+    '   [gbLog]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    gbLog = bLog
+End Property
+
+Public Property Get IClient_Log() As Boolean
+    IClient_Log = gbLog
+End Property
+
+Public Property Let IClient_CallbackMode(ByVal lCallbackMode As APECallbackNotificationConstants)
+Attribute IClient_CallbackMode.VB_Description = "Determines what Callback mode that will be used."
+    '-------------------------------------------------------------------------
+    'Purpose:   Determines if and how client receives results from
+    '           services requested from QueueManager
+    '           see "Callback mode keys" in modAEConstants
+    'Effects:
+    '   [glCallbackMode]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    Select Case lCallbackMode
+        Case giUSE_DEFAULT_CALLBACK, giUSE_PASSED_CALLBACK, giRETURN_BY_SYNC_EVENT
+            glCallbackMode = lCallbackMode
+        Case Else
+            'Default callback mode
+            glCallbackMode = giUSE_PASSED_CALLBACK
+    End Select
+End Property
+
+Public Property Get IClient_CallbackMode() As APECallbackNotificationConstants
+    IClient_CallbackMode = glCallbackMode
+End Property
+
+'How many Kb should the log collection be allowed to take
+'before it is cached to a temporary file?
+'If zero, the log is not cached to a file.
+Public Property Let IClient_LogThreshold(ByVal lKB As Long)
+Attribute IClient_LogThreshold.VB_Description = "Sets the log threshold in kilobytes that determines when log records are written to a file and purged from memory."
+    '-------------------------------------------------------------------------
+    'Purpose:   Client uses the LogThreshold property to determine how many
+    '           kilobytes should be held in memory before writing to a file
+    '           and emptying log record array.
+    'Effects:   [glLogThreshold]
+    '               Becomes equal to the passed parameter
+    '           [glLogThresholdRecs]
+    '               Becomes an estimated number of records equivalent
+    '-------------------------------------------------------------------------
+    On Error Resume Next
+    glLogThreshold = lKB
+    glLogThresholdRecs = lKB * giLOG_RECORD_KILOBYTES
+End Property
+
+Public Property Get IClient_LogThreshold() As Long
+    IClient_LogThreshold = glLogThreshold
+End Property
+
+Public Property Let IClient_PreLoadServices(ByVal bPreLoad As Boolean)
+Attribute IClient_PreLoadServices.VB_Description = "Determines if LoadServiceObject will be called on a directly instantiated AEWorker.Worker object before beginning the test."
+    '-------------------------------------------------------------------------
+    'Purpose:   If true, call the Worker's PreLoadService method before
+    '           starting test
+    'Effects:
+    '   [gbPreloadServices]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    gbPreloadServices = bPreLoad
+End Property
+
+Public Property Get IClient_PreLoadServices() As Boolean
+    IClient_PreLoadServices = gbPreloadServices
+End Property
+
+Public Property Let IClient_PersistentServices(ByVal bPersistent As Boolean)
+Attribute IClient_PersistentServices.VB_Description = "Sets the value that is used to set the PersistentServices property of a directly instantiated AEWorker.Worker object."
+    '-------------------------------------------------------------------------
+    'Purpose:   Sets the Worker's PersistentServices property
+    'Effects:
+    '   [gbPersistentServices]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    gbPersistentServices = bPersistent
+End Property
+
+Public Property Get IClient_PersistentServices() As Boolean
+    IClient_PersistentServices = gbPersistentServices
+End Property
+
+Public Property Let IClient_LogWorker(ByVal bLog As Boolean)
+Attribute IClient_LogWorker.VB_Description = "Sets the value that is used to set the Log property of a directly instantiated AEWorker.Worker object."
+    '-------------------------------------------------------------------------
+    'Purpose:   Sets the Worker's Log property
+    'Effects:
+    '   [gbLogWorker]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    gbLogWorker = bLog
+End Property
+
+Public Property Get IClient_LogWorker() As Boolean
+    IClient_Log = gbLogWorker
+End Property
+
+Public Property Let IClient_EarlyBindServices(ByVal bEarlyBind As Boolean)
+Attribute IClient_EarlyBindServices.VB_Description = "Sets the value that is used to set the EarlyBindServices property of a directly instantiated AEWorker.Worker object."
+    '-------------------------------------------------------------------------
+    'Purpose:   Sets the Worker's EarlyBindServices property
+    'Effects:
+    '   [gbEarlyBindServices]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    gbEarlyBindServices = bEarlyBind
+End Property
+
+Public Property Get IClient_EarlyBindServices() As Boolean
+    IClient_EarlyBindServices = gbEarlyBindServices
+End Property
+
+'************************
+'Public Methods
+'************************
+
+Function IClient_GetStatistics() As Variant
+Attribute IClient_GetStatistics.VB_Description = "Returns a variant array of test statistics."
+    '-------------------------------------------------------------------------
+    'Purpose:   Get the all summary status from the client.
+    'Return:    Returns a single dimension long array in which
+    '           element 0 = number of calls, 1 = Begin Milliseonds,
+    '           and 2 = End Milliseconds
+    '-------------------------------------------------------------------------
+    'Returns statistical data for Explorer computation
+    Dim lReturn(giSTAT_ARRAY_DIMENSION) As Long
+    lReturn(giNUM_CALLS_ELEMENT) = glCallsReturned
+    lReturn(giBEGIN_TICKS_ELEMENT) = glFirstServiceTick
+    lReturn(giEND_TICKS_ELEMENT) = glLastCallbackTick
+    IClient_GetStatistics = lReturn()
+End Function
+
+Public Function IClient_GetRecords() As Variant
+Attribute IClient_GetRecords.VB_Description = "Returns a variant array of log records."
+    '-------------------------------------------------------------------------
+    'Purpose:   Use to retrieve all of the log records created by the client
+    '           Keep calling until, it does not return a variant array
+    'Return:    Returns a two dimension array in which
+    '           the first four elements of the first dimension
+    '           are Component(string), ServiceID(Long),Comment(string),
+    '           and Milliseconds(long) respectively
+    '           the second dimension represents the number of log records
+    '           User Defined Types can not be returned from public
+    '           procedures of public classes
+    'Effects:   [gaLog]
+    '               Redimensioned after calling GetRecords to not have empty
+    '               records at the end
+    '           [glLastAddedRecord]
+    '               becomes equal to giNO_RECORDS
+    '-------------------------------------------------------------------------
+    
+    GetWrittenLog
+    'Trim the array to only send the filled elements
+    If glLastAddedRecord >= 0 Then
+        If UBound(gaLog, 2) <> glLastAddedRecord Then ReDim Preserve gaLog(giLOG_ARRAY_DIMENSION_ONE, glLastAddedRecord)
+        IClient_GetRecords = gaLog()
+        'Setting the glLastAddedRecord flag to giNO_RECORD will cause
+        'Write log to ignore records on the next call
+        glLastAddedRecord = giNO_RECORD
+    Else
+        IClient_GetRecords = Null
+    End If
+End Function
+
+Public Sub IClient_StartTest(Optional ByVal lStartDelay As Long = -1&)
+Attribute IClient_StartTest.VB_Description = "Starts a test."
+    '-------------------------------------------------------------------------
+    'Purpose:   Tells the client to start its Test
+    'IN:
+    '   [lStartDelay]
+    '           If present it will be used as the timer interval so the start test
+    '           can be delayed.  If missing, a default will be used.
+    'Assumes:   All properties have already been set
+    'Effects:
+    '   [gbRunCompleteProcedure]
+    '           becomes false
+    '   [tmrStartTest]
+    '           becomes enabled
+    '-------------------------------------------------------------------------
+    Dim s As String
+    
+    If gbTestInProcess Then Exit Sub
+    s = LoadResString(giSTART_TEST)
+    If gbLog Then AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
+    DisplayStatus s
+    ' Display or hide MTS Transaction status dialog
+    If glModel = giMODEL_POOL And gvServiceConfiguration(ape_conShowMTSTransactions) _
+             And (giServiceTask = (giMASK_USE_DB_TASK Or giMASK_WRITE_MTS_TRANSACTION)) Then
+        With frmService
+            .Show vbModeless, frmClient
+            .Reset
+        End With
+    Else
+        Unload frmService
+    End If
+    'Start timer and release the calling program.  When trmStarTest
+    'get's its first event it will set its inteval to 0 and call
+    'RunTest.
+    gbRunCompleteProcedure = False
+    gbStopping = False
+    With frmClient.tmrStartTest
+        If lStartDelay <= 0 Then lStartDelay = giDEFAULT_TIMER_INTERVAL
+        .Interval = lStartDelay
+        .Enabled = True
+    End With
+    Exit Sub
+End Sub
+
+
+Public Sub IClient_StopTest()
+Attribute IClient_StopTest.VB_Description = "Ends a test."
+    '-------------------------------------------------------------------------
+    'Purpose:   Tells the client to Stop its Test
+    '-------------------------------------------------------------------------
+    gStopTest
+End Sub
+
+Public Sub IClient_SetSendData(ByVal lContainerType As APEDatasetTypeConstants, ByVal lRowSize As Long, _
+                            Optional ByVal bRandomizeRowSize As Variant, Optional ByVal lRowSizeMin As Variant, _
+                            Optional ByVal lRowSizeMax As Variant, _
+                            Optional ByVal lNumRows As Variant, Optional ByVal bRandomizeNumRows As Variant, _
+                            Optional ByVal lNumRowsMin As Variant, Optional ByVal lNumRowsMax As Variant)
+Attribute IClient_SetSendData.VB_Description = "Determines the type and size of data that will be passed with Service Requests."
+    '-------------------------------------------------------------------------
+    'Purpose:   Set all of the parameter for data being passed
+    '           in with the Service Request from the client.
+    'In:
+    '   [lContainerType]
+    '           A code specifying the type of data to send with the Service
+    '           Request.  See modAECon.bas for constants
+    '   [lRowSize]
+    '           The size of the row in bytes
+    '   [bRandomizeRowSize]
+    '           If true Client will pick a random RowSize for every Service
+    '           Request.  lRowSizeMin will become the Lower bound of the range
+    '           and lRowSizeMax will become the upper bound.
+    '   [lRowSizeMin]
+    '           Required if bRandomizeRowSize is true
+    '   [lRowSizemax]
+    '           Required if bRandomizeRowSize is true
+    '   [lNumRows]
+    '           The number of rows of data to send with the Service Request
+    '   [bRandomizeNumRows
+    '           If true Client will pick a random NumRows for every Service
+    '           Request.  lNumRowsMin will become the Lower bound of the range
+    '           and lNumRowsMax will become the upper bound.
+    '   [lNumRowsMin]
+    '           Required if bRandomizeNumRows is true
+    '   [lNumRowsMax]
+    '           Required if bRandomizeNumRows is true
+    'Effects:
+    '   [gudtSendNumRows]
+    '           becomes value of lNumRows
+    '   [gudtSendRowSize]
+    '           becomes value of lRowSize
+    '   [glSendContainerType]
+    '           becomes value of lContainerType
+    '-------------------------------------------------------------------------
+    glSendContainerType = lContainerType
+    With gudtSendRowSize
+        .SpecificValue = lRowSize
+        If IsMissing(bRandomizeRowSize) Then .Random = False Else .Random = CBool(bRandomizeRowSize)
+        If .Random Then
+            If IsMissing(lRowSizeMin) Or IsMissing(lRowSizeMax) Then
+                GoTo SetSendData_InvalidParameter
+            Else
+                .LowerValue = lRowSizeMin
+                .UpperValue = lRowSizeMax
+            End If
+        End If
+    End With
+                
+    With gudtSendNumRows
+        If Not IsMissing(lNumRows) Then .SpecificValue = lNumRows
+        If IsMissing(bRandomizeNumRows) Then .Random = False Else .Random = CBool(bRandomizeNumRows)
+        If .Random Then
+            If IsMissing(lNumRowsMin) Or IsMissing(lNumRowsMax) Then
+                GoTo SetSendData_InvalidParameter
+            Else
+                .LowerValue = lNumRowsMin
+                .UpperValue = lNumRowsMax
+            End If
+        End If
+    End With
+    Exit Sub
+SetSendData_InvalidParameter:
+    Err.Raise giREQUIRED_PARAMETER_IS_MISSING + vbObjectError, , LoadResString(giREQUIRED_PARAMETER_IS_MISSING)
+End Sub
+
+Public Sub IClient_SetReceiveData(ByVal lContainerType As APEDatasetTypeConstants, ByVal lRowSize As Long, _
+                            Optional ByVal bRandomizeRowSize As Variant, Optional ByVal lRowSizeMin As Variant, _
+                            Optional ByVal lRowSizeMax As Variant, _
+                            Optional ByVal lNumRows As Variant, Optional ByVal bRandomizeNumRows As Variant, _
+                            Optional ByVal lNumRowsMin As Variant, Optional ByVal lNumRowsMax As Variant)
+Attribute IClient_SetReceiveData.VB_Description = "Determines the type and size of data that will be returned as Service Request results. "
+    '-------------------------------------------------------------------------
+    'Purpose:   Set all of the parameter for data being passed
+    '           to the client as results of the Service Request.
+    'In:
+    '   [lContainerType]
+    '           A code specifying the type of data to return from the Service
+    '           Request.  See modAECon.bas for constants
+    '   [lRowSize]
+    '           The size of the row in bytes
+    '   [bRandomizeRowSize]
+    '           If true Client will pick a random RowSize for every Service
+    '           Request.  lRowSizeMin will become the Lower bound of the range
+    '           and lRowSizeMax will become the upper bound.
+    '   [lRowSizeMin]
+    '           Required if bRandomizeRowSize is true
+    '   [lRowSizemax]
+    '           Required if bRandomizeRowSize is true
+    '   [lNumRows]
+    '           The number of rows of data to return from the Service Request
+    '   [bRandomizeNumRows
+    '           If true Client will pick a random NumRows for every Service
+    '           Request.  lNumRowsMin will become the Lower bound of the range
+    '           and lNumRowsMax will become the upper bound.
+    '   [lNumRowsMin]
+    '           Required if bRandomize NumRows is true
+    '   [lNumRowsMax]
+    '           Required if bRandomizeNumRows is true
+    'Effects:
+    '   [gudtSendNumRows]
+    '           becomes value of lNumRows
+    '   [gudtSendRowSize]
+    '           becomes value of lRowSize
+    '   [glSendContainerType]
+    '           becomes value of lContainerType
+    '-------------------------------------------------------------------------
+    glReceiveContainerType = lContainerType
+    With gudtReceiveRowSize
+        .SpecificValue = lRowSize
+        If IsMissing(bRandomizeRowSize) Then .Random = False Else .Random = CBool(bRandomizeRowSize)
+        If .Random Then
+            If IsMissing(lRowSizeMin) Or IsMissing(lRowSizeMax) Then
+                GoTo SetReceiveData_InvalidParameter
+            Else
+                .LowerValue = lRowSizeMin
+                .UpperValue = lRowSizeMax
+            End If
+        End If
+    End With
+                
+    With gudtReceiveNumRows
+        If Not IsMissing(lNumRows) Then .SpecificValue = lNumRows
+        If IsMissing(bRandomizeNumRows) Then .Random = False Else .Random = CBool(bRandomizeNumRows)
+        If .Random Then
+            If IsMissing(lNumRowsMin) Or IsMissing(lNumRowsMax) Then
+                GoTo SetReceiveData_InvalidParameter
+            Else
+                .LowerValue = lNumRowsMin
+                .UpperValue = lNumRowsMax
+            End If
+        End If
+    End With
+    Exit Sub
+SetReceiveData_InvalidParameter:
+    Err.Raise giREQUIRED_PARAMETER_IS_MISSING + vbObjectError, , LoadResString(giREQUIRED_PARAMETER_IS_MISSING)
+End Sub
+
+Public Sub IClient_SetServiceConfiguration(ByVal vServiceConfiguration As Variant)
+    gvServiceConfiguration = vServiceConfiguration
+End Sub
+
+Public Sub IClient_SetProperties(ByVal bShow As Boolean, Optional ByVal bLog As Variant, Optional ByVal lID As Variant, Optional ByVal lModel As Variant, _
+                        Optional ByVal lLogThreshold As Variant, Optional ByVal iCallbackMode As Variant)
+Attribute IClient_SetProperties.VB_Description = "Sets the Client related properties in one method call."
+    '-------------------------------------------------------------------------
+    'Purpose:   To set the Client properties in one method call
+    'Effects:   Sets the following properties to parameter values
+    '           Show, Log, Model, NumberOfCalls, WaitPeriod, ServiceCommand,
+    '           ServiceMilliseconds, UseProcessor, LogThreshold, UseDefaultCallback
+    '-------------------------------------------------------------------------
+    Me.IClient_Show = bShow
+    DisplayStatus LoadResString(giINITIALIZING_TEST)
+    If Not IsMissing(bLog) Then gbLog = bLog
+    If Not IsMissing(lID) Then Me.IClient_ID = lID
+    If Not IsMissing(lModel) Then glModel = lModel
+    If Not IsMissing(lLogThreshold) Then Me.IClient_LogThreshold = lLogThreshold
+    If Not IsMissing(iCallbackMode) Then Me.IClient_CallbackMode = iCallbackMode
+End Sub
+
+Public Sub IClient_SetTestDuration(Optional ByVal lNumberOfCalls As Variant, _
+                           Optional ByVal lNumberOfMilliseconds As Variant)
+Attribute IClient_SetTestDuration.VB_Description = "Sets how long a test will last in number of calls or number of milliseconds."
+    '-------------------------------------------------------------------------
+    'Purpose:   The the parameters effecting the TestDuration
+    'In:        If no parameters are present then the test will continue
+    '           until interupted by the Stop test method.
+    '   [lNumberOfCalls]
+    '           If present, the test duration will last for a number of
+    '           calls specified by this parameter
+    '   [lNumberOfMilliseconds]
+    '           If present and lNumberOfCalls is missing, the test duration
+    '           will last for the number of milliseconds specified by this
+    '           parameter.
+    '-------------------------------------------------------------------------
+    If Not IsMissing(lNumberOfCalls) Then
+        giTestDurationMode = giTEST_DURATION_CALLS
+        glNumberOfCalls = lNumberOfCalls
+    ElseIf Not IsMissing(lNumberOfMilliseconds) Then
+        giTestDurationMode = giTEST_DURATION_TICKS
+        glTestDurationInTicks = lNumberOfMilliseconds
+    Else
+        giTestDurationMode = giTEST_DURATION_CONTINUE
+    End If
+End Sub
+
+Public Sub IClient_SetWaitPeriod(ByVal lMilliseconds As Long, Optional ByVal bRandom As Variant, _
+                            Optional ByVal lMillisecondsMin As Variant, _
+                            Optional ByVal lMillisecondsMax As Variant)
+Attribute IClient_SetWaitPeriod.VB_Description = "Sets how long the Client will wait between submitting Service Requests in milliseconds."
+    '-------------------------------------------------------------------------
+    'Purpose:   Specifies how many Milliseconds to wait between each call
+    'Effects:
+    '   [gudtWaitPeriod]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    With gudtWaitPeriod
+        .SpecificValue = lMilliseconds
+        If IsMissing(bRandom) Then .Random = False Else .Random = CBool(bRandom)
+        If .Random Then
+            If IsMissing(lMillisecondsMin) Or IsMissing(lMillisecondsMax) Then
+                GoTo SetWaitPeriod_InvalidParameter
+            Else
+                .LowerValue = lMillisecondsMin
+                .UpperValue = lMillisecondsMax
+            End If
+        End If
+    End With
+    Exit Sub
+SetWaitPeriod_InvalidParameter:
+    Err.Raise giREQUIRED_PARAMETER_IS_MISSING + vbObjectError, , LoadResString(giREQUIRED_PARAMETER_IS_MISSING)
+End Sub
+
+Public Sub IClient_SetTaskDuration(ByVal lMilliseconds As Long, Optional ByVal bRandom As Variant, _
+                            Optional ByVal lMillisecondsMin As Variant, _
+                            Optional ByVal lMillisecondsMax As Variant)
+Attribute IClient_SetTaskDuration.VB_Description = "Sets how long the default service object's task will execute in milliseconds."
+    '-------------------------------------------------------------------------
+    'Purpose:   Specifies how many milliseconds the Service should use the processor on each call
+    'Effects:
+    '   [gudtTaskDuration]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    With gudtTaskDuration
+        .SpecificValue = lMilliseconds
+        If IsMissing(bRandom) Then .Random = False Else .Random = CBool(bRandom)
+        If .Random Then
+            If IsMissing(lMillisecondsMin) Or IsMissing(lMillisecondsMax) Then
+                GoTo SetTaskDuration_InvalidParameter
+            Else
+                .LowerValue = lMillisecondsMin
+                .UpperValue = lMillisecondsMax
+            End If
+        End If
+    End With
+    Exit Sub
+SetTaskDuration_InvalidParameter:
+    Err.Raise giREQUIRED_PARAMETER_IS_MISSING + vbObjectError, , LoadResString(giREQUIRED_PARAMETER_IS_MISSING)
+End Sub
+
+Public Sub IClient_SetSleepPeriod(ByVal lMilliseconds As Long, Optional ByVal bRandom As Variant, _
+                            Optional ByVal lMillisecondsMin As Variant, _
+                            Optional ByVal lMillisecondsMax As Variant)
+    '-------------------------------------------------------------------------
+    'Purpose:   Specifies how many milliseconds the Service should sleep on each call
+    'Effects:
+    '   [gudtSleepPeriod]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    With gudtSleepPeriod
+        .SpecificValue = lMilliseconds
+        If IsMissing(bRandom) Then .Random = False Else .Random = CBool(bRandom)
+        If .Random Then
+            If IsMissing(lMillisecondsMin) Or IsMissing(lMillisecondsMax) Then
+                GoTo SetSleepPeriod_InvalidParameter
+            Else
+                .LowerValue = lMillisecondsMin
+                .UpperValue = lMillisecondsMax
+            End If
+        End If
+    End With
+    Exit Sub
+SetSleepPeriod_InvalidParameter:
+    Err.Raise giREQUIRED_PARAMETER_IS_MISSING + vbObjectError, , LoadResString(giREQUIRED_PARAMETER_IS_MISSING)
+End Sub
+
+Public Sub IClient_SetServiceTask(ByVal iServiceTask As Integer)
+Attribute IClient_SetServiceTask.VB_Description = "Sets the task that the default service will execute."
+    '-------------------------------------------------------------------------
+    'Purpose:   To instruct Client what task to require from AEService.Service
+    'Effects:
+    '   [giServiceTask]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    giServiceTask = iServiceTask
+End Sub
+
+Public Sub IClient_SetDatabaseQuery(ByVal sQuery As String)
+    '-------------------------------------------------------------------------
+    'Purpose:   Specifies the query used for a database task
+    'Effects:
+    '   [gsDatabaseQuery]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    gsDatabaseQuery = sQuery
+End Sub
+
+Public Sub IClient_SetServiceCommand(ByVal bUseDefaultService As Boolean, Optional ByVal sName As Variant)
+Attribute IClient_SetServiceCommand.VB_Description = "Determines if the default Service object or a custom service object will be used."
+    '-------------------------------------------------------------------------
+    'Purpose:   Specifies what ProgID to and command to use for Service
+    '           requests
+    'IN:
+    '   [bUseDefaultService]
+    '           If true use default service, else use require following parameter
+    '           as service command
+    '   [sName]
+    '           Required if bUseDefaultService is False
+    '           Ex: "Library.Class.Method"
+    'Effects:
+    '   [gsServiceCommand]
+    '           Set equal to parameter
+    '-------------------------------------------------------------------------
+    gbUseDefaultService = bUseDefaultService
+    If Not bUseDefaultService Then
+        If IsMissing(sName) Then
+            GoTo SetServiceCommand_InvalidParameter
+        ElseIf VarType(sName) <> vbString Then
+            GoTo SetServiceCommand_InvalidParameter
+        Else
+            gsServiceCommand = sName
+        End If
+    End If
+    Exit Sub
+SetServiceCommand_InvalidParameter:
+    Err.Raise giREQUIRED_PARAMETER_IS_MISSING + vbObjectError, , LoadResString(giREQUIRED_PARAMETER_IS_MISSING)
+End Sub
+
+Public Sub IClient_SetWorkerProperties(ByVal bLog As Boolean, Optional ByVal bEarlyBindServices As Variant, _
+        Optional ByVal bPersistentServices As Variant, Optional ByVal bPreloadServices As Variant)
+Attribute IClient_SetWorkerProperties.VB_Description = "Sets all Worker related properties in one method call."
+    '-------------------------------------------------------------------------
+    'Purpose:   To set the Worker properties in one method call
+    'Effects:   Sets the following properties to parameter values
+    '           ShowWorker, LogWorker, EarlyBindServices, PersistentServices
+    '           PreloadServices
+    '-------------------------------------------------------------------------
+    gbLogWorker = bLog
+    If Not IsMissing(bEarlyBindServices) Then gbEarlyBindServices = bEarlyBindServices
+    If Not IsMissing(bPersistentServices) Then IClient_PersistentServices = bPersistentServices
+    If Not IsMissing(bPreloadServices) Then gbPreloadServices = bPreloadServices
+
+End Sub
+
+Public Sub IClient_SetConnectionProperties(ByVal bRemote As Boolean, Optional ByVal bNetOLE As Variant, _
+        Optional ByVal sAddress As Variant, Optional ByVal sProtocol As Variant, _
+        Optional ByVal lAuthentication As Variant)
+Attribute IClient_SetConnectionProperties.VB_Description = "Sets the connection properties in one method call."
+    '-------------------------------------------------------------------------
+    'Purpose:   To set the Connection Settings that the Client will use to
+    '           connect to a remote Worker
+    'In:
+    '   [bRemote]
+    '           If true connect to a remote Worker instead of a local one
+    '   [bNetOLE]
+    '           If true use NetOLE (DCOM) instead of Remote Automation
+    '   [sAddress]
+    '           Machine name to connect to
+    '   [sProtocol]
+    '           Protocol sequence to use when connecting to remote objects
+    '   [lAuthentication]
+    '           Authentication level to use
+    'Effects:   The following globals are set to the value of the corresponding
+    '           parameters:
+    '           gbConnectionRemote, gbConnectionNetOLE, gsConnectionAddress
+    '           gsConnectionProtocol, glConnectionAuthentication
+    '-------------------------------------------------------------------------
+    gbConnectionRemote = bRemote
+    If Not IsMissing(bNetOLE) Then gbConnectionNetOLE = bNetOLE
+    If Not IsMissing(sAddress) Then gsConnectionAddress = sAddress
+    If Not IsMissing(sProtocol) Then gsConnectionProtocol = sProtocol
+    If Not IsMissing(lAuthentication) Then glConnectionAuthentication = lAuthentication
+        
+End Sub
+
+'******************
+'Private Procedures
+'******************
+
+Private Sub RestoreLocalConnSettings()
+    '-------------------------------------------------------------------------
+    'Purpose:       If this AEClient was the first client created on the local
+    '               machine, restores the Connections Settings of the Worker and
+    '               the QueueMgr to local.  Settings need to be restored to
+    '               local incase machine is used as a server in another session.
+    '-------------------------------------------------------------------------
+    Dim iResult As Integer
+    'Called by Class_Terminate
+    
+    If mbFirstClientOnMachine Then
+        iResult = goRegClass.SetAutoServerSettings(False, "AEWorker.Worker")
+        iResult = goRegClass.SetAutoServerSettings(False, "AEQueueMgr.Queue")
+        iResult = goRegClass.SetAutoServerSettings(False, "AEPoolMgr.Pool")
+    End If
+End Sub
+
+Private Sub Class_Initialize()
+    On Error GoTo Class_InitializeError
+    '-------------------------------------------------------------------------
+    'Purpose:   If this is the first instanciation
+    '           Put the Client in a "Ready" state.  Load RacReg, set property
+    '           defaults
+    'Effects:
+    '   [glInstances]
+    '           increments it by one
+    '-------------------------------------------------------------------------
+    'Keep track of the number of instances
+    'to responsd to the first instancing
+    glInstances = glInstances + 1
+    If glInstances = 1 Then
+        If Not App.PrevInstance Then mbFirstClientOnMachine = True
+        'Make sure we don't get a timeout when starting OLE server across the net.
+        App.OleServerBusyRaiseError = True
+        App.OleServerBusyTimeout = 10000
+        'Create Objects
+        Set goRegClass = New RacReg.RegClass
+        
+        Set gcServices = New Collection
+        glLastAddedRecord = giNO_RECORD
+        'Get a temp file name
+        gsTempFile = GetTempFile
+        'Default Properties and variables
+        glModel = giMODEL_QUEUE
+        gbTestInProcess = False
+        glSendContainerType = giCONTAINER_TYPE_VARRAY
+        glReceiveContainerType = giCONTAINER_TYPE_VARRAY
+        gbShow = True
+        gbLog = True
+        glModel = giMODEL_QUEUE
+        glCallsMade = 0
+        gbShow = True
+        gbLog = True
+        gbLogWorker = True
+        glLogThreshold = 0
+        'Set status flags
+        gbStopping = False
+    End If
+    Exit Sub
+Class_InitializeError:
+    LogError Err
+    Resume Next
+End Sub
+
+Private Sub Class_Terminate()
+    '-------------------------------------------------------------------------
+    'Purpose:   If the last reference to the Client is destroyed
+    '           Close the Client
+    'Effects:
+    '           Restore Local connection settings
+    '           Run gStopTest
+    '           Delete Temporary file
+    '   [glInstances]
+    '           decrements it by one
+    '-------------------------------------------------------------------------
+    On Error GoTo Class_TerminateError
+    glInstances = glInstances - 1
+    If glInstances <= 0 Then
+        'There is one internal reference to the Client class in the form module.  So,
+        'we need to terminate when glInstances = 1 not 0.
+        'Call gStopTest so that Services are cancelled
+        'and set flag for shut down after Services are cancelled
+        RestoreLocalConnSettings
+        Close   'close in case getting logs was canceled
+        Kill gsTempFile
+        gbShutDown = True
+        gStopTest
+        Set goExplorer = Nothing
+    End If
+    Exit Sub
+Class_TerminateError:
+    Select Case Err.Number
+        Case ERR_FILE_NOT_FOUND
+            'There is no file to kill
+            Resume Next
+        Case Else
+            LogError Err
+            Resume Next
+    End Select
+End Sub
+
+

build-env/VisualStudio6/Common/Tools/APE/Source/Aeclient/CLSCALBK.CLS

@@ -0,0 +1,36 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0   'False
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+END
+Attribute VB_Name = "clsCallback"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = True
+Attribute VB_Description = "Callback object passed to AEQueueMgr.Queue for the return of Service Request results."
+Option Explicit
+    '-------------------------------------------------------------------------
+    'Used to for callback objects to be sent with Service Requests to QueueMgr.
+    '-------------------------------------------------------------------------
+Implements APEInterfaces.IClientCallback
+
+Private Sub IClientCallback_CallBack(ByVal sServiceID As String, ByVal vServiceReturn As Variant, ByVal sServiceError As String)
+    '-------------------------------------------------------------------------
+    'Purpose:   Used by the Expediter to notify a Client when an Service is complete.
+    'IN:
+    '   [sServiceID]
+    '           Service Request ID
+    '   [vServiceReturn]
+    '           Data returned by Service Request
+    '   [sServiceError]
+    '           Error information for errors that occured processing Service Request.
+    '           Information is delimited by a semi-colon and a space in the following
+    '           format:  "number; source; description"
+    'Effects:
+    '   Calls CallbackHandler procedure
+    '-------------------------------------------------------------------------
+    CallBackHandler sServiceID, vServiceReturn, sServiceError
+End Sub

build-env/VisualStudio6/Common/Tools/APE/Source/Aeclient/CLSCNTSV.CLS

@@ -0,0 +1,23 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0   'False
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+END
+Attribute VB_Name = "clsClientService"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+'-------------------------------------------------------------------------
+'This class is used a structure for information about expected
+'Service Request callbacks.  Objects of this class are
+'added to the gcService collection
+'-------------------------------------------------------------------------
+
+Public sID As String          'Service Request ID
+Public sCommand As String   'Service Request Command
+Public lStartTicks As Long  'Tick Count of when call was made
+

build-env/VisualStudio6/Common/Tools/APE/Source/Aeclient/CLSDRTTL.CLS

@@ -0,0 +1,254 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "clsDirectTestTool"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+'-------------------------------------------------------------------------
+'This class provides a RunTest method to be called to run a Direct
+'Instanciation model test.
+'-------------------------------------------------------------------------
+
+Public Sub RunTest()
+    '-------------------------------------------------------------------------
+    'Purpose:   Executes a loop for glNumberOfCalls each time calling
+    '           AEWorker.Worker.DoActivity.  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
+    '-------------------------------------------------------------------------
+    
+    '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 bLog As Boolean             'If true log records
+    Dim bShow As Boolean            'If true update display
+    
+    On Error GoTo RunTestError
+    'If there is reentry by a timer click exit sub
+    If gbRunning Then Exit Sub
+    gbRunning = True
+    
+    'Set the local variables to direct the testing
+    Set oWorker = CreateObject("AEWorker.Worker")
+    'Pass configuration settings to the Worker
+    With oWorker
+        .SetProperties gbLogWorker, gbEarlyBindServices, gbPersistentServices, glClientID   'The Worker ID is the same as the Clients' ID in direct case
+        If gbPreloadServices Then
+            .LoadServiceObject IIf(gbUseDefaultService, gsSERVICE_LIB_CLASS, gsServiceCommand), gvServiceConfiguration
+        End If
+    End With
+    
+    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
+KeepPostingServices:
+    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
+        'Post the service to a worker
+        'Post a synchronous service
+        sServiceID = glClientID & "." & lCallNumber
+        iRetry = 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
+        '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
+        Exit Sub
+    End If
+    If bLog Then AddLogRecord gsNULL_SERVICE_ID, LoadResString(giSERVICES_POSTED), GetTickCount(), False
+    CompleteTest
+    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
+                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 oWorker = oInstancer.object("AEWorker.Worker")
+            Set oInstancer = Nothing
+            Resume Next
+        Case RPC_S_UNKNOWN_AUTHN_TYPE
+            Dim iResult As Integer
+            'Tried to connect to a server that does not support
+            'specified authentication level.  Display message and
+            'switch to no authentication and try again
+            s = LoadResString(giUSING_NO_AUTHENTICATION)
+            DisplayStatus s
+            AddLogRecord gsNULL_SERVICE_ID, s, 0, False
+            glConnectionAuthentication = RPC_C_AUTHN_LEVEL_NONE
+            iResult = goRegClass.SetAutoServerSettings(True, "AEWorker.Worker", , 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
+            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
+                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
+                Exit Sub
+            Else
+                Resume Next
+            End If
+    End Select
+End Sub

build-env/VisualStudio6/Common/Tools/APE/Source/Aeclient/CLSPOOTL.CLS

@@ -0,0 +1,546 @@
+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
+
+
+    
+

build-env/VisualStudio6/Common/Tools/APE/Source/Aeclient/CLSQUETL.CLS

@@ -0,0 +1,329 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "clsQueueTestTool"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+'-------------------------------------------------------------------------
+'This class provides a RunTest method to be called to run a Queue Manager
+'model test
+'-------------------------------------------------------------------------
+Private WithEvents moEventReturn As AEExpediter.EventReturn  'Expediter may raise an event
+Attribute moEventReturn.VB_VarHelpID = -1
+                                                             'to return results
+
+Public Sub RunTest()
+    '-------------------------------------------------------------------------
+    'Purpose:   Executes a loop for glNumberOfCalls each time calling
+    '           AEQueueMgr.Queue.Add.  This method actually runs
+    '           a test according to set properties
+    'Assumes:   All Client properties have been set.
+    'Effects:
+    '           Calls CompleteTest when finished calling QueueMgr if no
+    '           callbacks are expected
+    '           Calls AddServiceRecord procedure after each call to QueueMgr
+    '           if callbacks are expected
+    '   [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 QueueMgr is called
+    '   [glCallsReturned]
+    '           is incremented every time the QueueMgr is called if no
+    '           callback is expected
+    '-------------------------------------------------------------------------
+    Const lMAX_COUNT = 2147483647
+    Dim s As String         'Error message to log and display
+    Dim sServiceID As String  'Service Request ID
+    Dim lTicks As Long      'Tick Count in milliseconds
+    Dim lEndTick As Long    'DoEvents loop until this tick count
+    Dim lCallNumber As Long 'Number of calls
+    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 iRetry As Integer   'Number of call retries made because call rejection
+    Dim bPostingServices As Boolean 'If true, in main loop of procedure
+    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 something is expeted back
+    Dim oCallback As clsCallback    'Callback object to pass with requests
+    Dim bLog As Boolean             'If true log records
+    Dim bShow As Boolean            'If true update display
+    Dim iCallbackMode As Integer    'Determines if and how results are returned from QueueMgr
+    Dim oQueue As APEInterfaces.IQueue  'Queue object to post service requests to
+
+    On Error GoTo RunTestError
+    
+    'If there is reentry by a timer click exit sub
+    If gbRunning Then Exit Sub
+    gbRunning = True
+    
+    'Set the local variables to direct the testing
+    Set oQueue = CreateObject("AEQueueMgr.Queue")
+    Set oCallback = New clsCallback
+    bRandomSendData = GetTestData(bSendSomething, bReceiveSomething, vSendData)
+    lCallWait = GetValueFromRange(gudtWaitPeriod, bRandomWait)
+    sSendCommand = GetServiceCommand(bRandomCommand)
+    bLog = gbLog
+    bShow = gbShow
+    iCallbackMode = glCallbackMode
+    
+    'Set the DefaultCallback property if it will be needed
+    'Setting the default callback even when the client will be passing
+    'a callback every call improves performance by keeping RemAuto and DCOM
+    'form tearing down the stub and proxy for the callback object
+    'when the expediter's reference count of the callback object is zero
+    'Having one reference always on the server side keeps the stub and proxy
+    'from being torn done, which removes the need for the stub and proxy to have
+    'to be continually recreated during the test
+    If iCallbackMode = giUSE_DEFAULT_CALLBACK Or giUSE_PASSED_CALLBACK Then Set oQueue.DefaultCallBack = oCallback
+    'Set the withevents object if it will be needed
+    If iCallbackMode = giRETURN_BY_SYNC_EVENT Then Set moEventReturn = oQueue.GetEventObject
+    
+    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
+        'Queue the Service
+        'Post this Service to the queue
+        'Queue an asynchronous Service
+        sServiceID = glClientID & "." & lCallNumber
+        iRetry = 0
+        lTicks = GetTickCount
+        
+        'Display CallsMade
+        If bShow Then
+            With frmClient.lblCallsMade
+                .Caption = lCallNumber
+                .Refresh
+            End With
+        End If
+        
+        If bReceiveSomething Then
+            Dim bProcessed As Boolean
+            'We are expecting a callback.
+            Select Case iCallbackMode
+                Case giUSE_DEFAULT_CALLBACK, giRETURN_BY_SYNC_EVENT
+                    bProcessed = oQueue.Add(sSendCommand, sServiceID, iCallbackMode, vSendData)
+                Case giUSE_PASSED_CALLBACK
+                    bProcessed = oQueue.Add(sSendCommand, sServiceID, iCallbackMode, vSendData, oCallback)
+            End Select
+            'If not bProcessed then QueueMgr did not process Service request
+            'because it was stopped.
+            If Not bProcessed Then Exit Do
+            AddServiceRecord sServiceID, sSendCommand, GetTickCount()
+        ElseIf bSendSomething Then
+            'Sending data but nothing comming back.
+            'Dont receive a callback.
+            oQueue.Add sSendCommand, sServiceID, giNO_CALLBACK, vSendData
+            glLastCallbackTick = GetTickCount
+            'Increment the CallsReturned global
+            glCallsReturned = glCallsReturned + 1
+            If bShow Then
+                With frmClient.lblCallsReturned
+                    .Caption = glCallsReturned
+                    .Refresh
+                End With
+            End If
+        Else
+            'Just make the call, nothing else.
+            oQueue.Add sSendCommand, sServiceID, giNO_CALLBACK
+            glLastCallbackTick = GetTickCount
+            'Increment the CallsReturned global
+            glCallsReturned = glCallsReturned + 1
+            If bShow Then
+                With frmClient.lblCallsReturned
+                    .Caption = glCallsReturned
+                    .Refresh
+                End With
+            End If
+        End If
+        If bLog Then AddLogRecord sServiceID, LoadResString(giQUEUE_SERVICE) & gsSEPERATOR & sSendCommand, lTicks, False
+        
+        'If gbStopping Then Exit Do
+        'Go into an idle loop util the next call.
+        'Also go into idle loop if difference between
+        'calls sent and calls received is greater than giCALL_SENT_AND_RECEIVED_MAX_DIFFERENCE
+        If lCallWait > 0 Or (lCallNumber - glCallsReturned) > giCALL_SENT_AND_RECEIVED_MAX_DIFFERENCE Then
+            lEndTick = GetTickCount + lCallWait
+            Do While ((GetTickCount() < lEndTick) Or ((lCallNumber - glCallsReturned) > giCALL_SENT_AND_RECEIVED_MAX_DIFFERENCE)) And Not gbStopping
+                DoEvents
+            Loop
+        End If
+        glCallsMade = 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
+    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
+    If Not bReceiveSomething Or glCallsReturned = glCallsMade Then
+        'Not expecting callbacks. The test is done.
+        CompleteTest
+    End If
+    Set oCallback = Nothing
+    Set oQueue = Nothing
+    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
+                Exit Sub
+            End If
+        Case giQUEUE_MGR_IS_BUSY + vbObjectError
+            lEndTick = GetTickCount + lCallWait + giQUEUE_WAIT_RETRY_MIN
+            AddLogRecord sServiceID, Err.Description, GetTickCount, False
+            Do While GetTickCount() < lEndTick And Not gbStopping
+                DoEvents
+            Loop
+            Resume
+        Case ERR_OBJECT_VARIABLE_NOT_SET
+            'QueueMgr was not successfully created
+            'stop client
+            'If gbStopping is true the error occurred
+            'because StopOnError was already called when
+            'handling a callback
+            If Not gbStopping Then
+                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
+            End If
+            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 oQueue = oInstancer.object("AEQueueMgr.Queue")
+            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, "AEQueueMgr.Queue", , gsConnectionAddress, gsConnectionProtocol, glConnectionAuthentication)
+            Resume
+        Case ERR_OVER_FLOW
+            s = CStr(Err.Number) & gsSEPERATOR & Err.Source & gsSEPERATOR & Err.Description
+            If lCallNumber = glMAX_LONG Then lCallNumber = 0
+            If glCallsReturned = glMAX_LONG Then glCallsReturned = 0
+            DisplayStatus Err.Description
+            AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
+        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
+                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
+                Exit Sub
+            Else
+                Resume Next
+            End If
+    End Select
+End Sub
+
+Private Sub moEventReturn_ServiceResult(ByVal sServiceID As String, ByVal vServiceReturn As Variant, ByVal sServiceError As String)
+    '-------------------------------------------------------------------------
+    'Purpose:   Event raised by Expediter class object to return results
+    'IN:
+    '   [sServiceID]
+    '           Service Request ID
+    '   [vServiceReturn]
+    '           Data returned by Service Request
+    '   [sServiceError]
+    '           Error information for errors that occured processing Service Request.
+    '           Information is delimited by a semi-colon and a space in the following
+    '           format:  "number; source; description"
+    'Effects:
+    '   Calls CallbackHandler procedure
+    '-------------------------------------------------------------------------
+    CallBackHandler sServiceID, vServiceReturn, sServiceError
+End Sub

build-env/VisualStudio6/Common/Tools/APE/Source/Aeclient/FRMCLNT.FRM

@@ -0,0 +1,222 @@
+VERSION 5.00
+Object = "{6FBA474E-43AC-11CE-9A0E-00AA0062BB4C}#1.0#0"; "SYSINFO.OCX"
+Begin VB.Form frmClient 
+   BorderStyle     =   1  'Fixed Single
+   Caption         =   "Client"
+   ClientHeight    =   2145
+   ClientLeft      =   270
+   ClientTop       =   1860
+   ClientWidth     =   3915
+   ClipControls    =   0   'False
+   Icon            =   "frmclnt.frx":0000
+   LinkTopic       =   "Form1"
+   LockControls    =   -1  'True
+   MaxButton       =   0   'False
+   ScaleHeight     =   2145
+   ScaleWidth      =   3915
+   StartUpPosition =   3  'Windows Default
+   Begin SysInfoLib.SysInfo SysInfo 
+      Left            =   1680
+      Top             =   840
+      _ExtentX        =   1005
+      _ExtentY        =   1005
+      _Version        =   393216
+   End
+   Begin VB.Timer tmrStartTest 
+      Enabled         =   0   'False
+      Interval        =   10
+      Left            =   240
+      Top             =   1200
+   End
+   Begin VB.ListBox lstLog 
+      Height          =   585
+      IntegralHeight  =   0   'False
+      Left            =   840
+      TabIndex        =   0
+      Top             =   1080
+      Visible         =   0   'False
+      Width           =   645
+   End
+   Begin VB.Label lblCallsReturnedCaption 
+      BackStyle       =   0  'Transparent
+      Caption         =   "Calls Returned"
+      BeginProperty Font 
+         Name            =   "Tahoma"
+         Size            =   9.75
+         Charset         =   0
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   255
+      Left            =   180
+      TabIndex        =   5
+      Top             =   480
+      Width           =   2535
+   End
+   Begin VB.Label lblCallsReturned 
+      BackStyle       =   0  'Transparent
+      BeginProperty Font 
+         Name            =   "Tahoma"
+         Size            =   9.75
+         Charset         =   0
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   255
+      Left            =   2800
+      TabIndex        =   4
+      Top             =   480
+      Width           =   1000
+   End
+   Begin VB.Label lblCallsMade 
+      BackStyle       =   0  'Transparent
+      Caption         =   "9999999999"
+      BeginProperty Font 
+         Name            =   "Tahoma"
+         Size            =   9.75
+         Charset         =   0
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   255
+      Left            =   2800
+      TabIndex        =   3
+      Top             =   150
+      Width           =   1000
+   End
+   Begin VB.Label lblStatus 
+      BackStyle       =   0  'Transparent
+      BeginProperty Font 
+         Name            =   "Tahoma"
+         Size            =   9.75
+         Charset         =   0
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   980
+      Left            =   180
+      TabIndex        =   2
+      Top             =   1000
+      Width           =   3550
+      WordWrap        =   -1  'True
+   End
+   Begin VB.Label lblCallsCaption 
+      BackStyle       =   0  'Transparent
+      Caption         =   "Calls Made"
+      BeginProperty Font 
+         Name            =   "Tahoma"
+         Size            =   9.75
+         Charset         =   0
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   255
+      Left            =   180
+      TabIndex        =   1
+      Top             =   150
+      Width           =   2535
+   End
+End
+Attribute VB_Name = "frmClient"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub Form_Load()
+    '-------------------------------------------------------------------------
+    'Effects:
+    '       Position form and load captions from string resource
+    '-------------------------------------------------------------------------
+    'Use clsPositionForm object to move
+    'Form to settings saved in registry
+    Dim oPosition As clsPositionForm
+    
+    Set oPosition = New clsPositionForm
+    
+    'Set Captions
+    ApplyFontToForm Me
+    Caption = LoadResString(giFORM_CAPTION)
+    lblCallsCaption.Caption = LoadResString(giCALLS_MADE_CAPTION)
+    lblCallsReturnedCaption.Caption = LoadResString(giCALLS_RETURNED_CAPTION)
+    
+    'Conditional compile toggles between release mode
+    'and a debug mode which displays a list box and
+    'list events as they occur in the box
+    #If ccShowList Then
+        lstLog.Visible = True
+        lblStatus.Visible = False
+        lblCallsCaption.Visible = False
+        lblCallsMade.Visible = False
+        lblCallsReturned.Visible = False
+        lblCallsReturnedCaption.Visible = False
+        oPosition.Move Me, True
+    #Else
+        oPosition.Move Me, False
+        Width = giDEFAULT_FORM_WIDTH
+        Height = giDEFAULT_FORM_HEIGHT
+    #End If
+End Sub
+
+
+Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
+    If UnloadMode = vbFormControlMenu And Not gbShutDown Then Cancel = True
+End Sub
+
+
+Private Sub Form_Resize()
+    #If ccShowList Then
+        Dim lX As Long
+        Dim lY As Long
+        If Me.ScaleHeight >= 2 * glFORM_MARGIN Then lY = (Me.ScaleHeight - (2 * glFORM_MARGIN)) Else lY = (2 * glFORM_MARGIN) - Me.ScaleHeight
+        If Me.ScaleWidth >= 2 * glFORM_MARGIN Then lX = (Me.ScaleWidth - (2 * glFORM_MARGIN)) Else lX = (2 * glFORM_MARGIN) - Me.ScaleWidth
+        lstLog.Move glFORM_MARGIN, glFORM_MARGIN, lX, lY
+    #End If
+End Sub
+
+Private Sub Form_Unload(Cancel As Integer)
+    'Use clsPositionForm object to save
+    'forms position in registry
+    Dim oPosition As clsPositionForm
+    Set oPosition = New clsPositionForm
+    oPosition.Save Me
+End Sub
+
+Private Sub tmrStartTest_Timer()
+    '-------------------------------------------------------------------------
+    'Purpose:
+    '       Calls Complete test or ConfigureTest and a RunTest method, depending
+    '       on gbRunCompleteProcedure flag
+    '-------------------------------------------------------------------------
+    Static stbInTimer As Boolean
+    tmrStartTest.Enabled = False
+    On Error GoTo tmrStartTestError
+    
+    If Not stbInTimer Then
+        stbInTimer = True
+        If gbRunCompleteProcedure Then
+            CompleteTest
+        Else
+            ConfigureTest
+            goTestTool.RunTest
+        End If
+        stbInTimer = False
+    End If
+    Exit Sub
+tmrStartTestError:
+    LogError Err
+    StopOnError Err.Description
+    stbInTimer = False
+    Exit Sub
+End Sub

build-env/VisualStudio6/Common/Tools/APE/Source/Aeclient/MODCLNT.BAS

@@ -0,0 +1,938 @@
+Attribute VB_Name = "modClient"
+Option Explicit
+'-------------------------------------------------------------------------
+'The project is the Client component of the Application Performance Explorer
+'This client is designed to be instanciated by and configured by the APE
+'Manager.  It can generate Service Request by calling the QueueManager.
+'Or it can call the Worker to produce synchronous work.  In either of these
+'sinarios the frequency can vary, and the type and size of data it passes
+'can vary.
+'
+'Key Files:
+'   frmClnt.frm     The only form in the app
+'   Client.cls      Single-use, creatable, public class that provides
+'                   OLE interface for Manager to instanciate and configure
+'   clsCalbk.cls    Not creatable, but public class that is passed to the
+'                   QueueMgr to receive call backs
+'   clsCntSv.cls    Class used to store data on expected callbacks
+'   clsDrtTl.cls    Class providing a runtest method for running direct
+'                   instanciation tests
+'   clsPosFm.cls    Tool form saving form position to registry
+'   clsQueTl.cls    Class providing a runtest method for running Queue
+'                   manager tests
+'-------------------------------------------------------------------------
+
+'Declares
+#If UNICODE Then
+    Declare Function GetTempFileName Lib "Kernel32" Alias "GetTempFileNameW" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
+    Declare Function GetTempPath Lib "Kernel32" Alias "GetTempPathW" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
+    Public Declare Function GetComputerName Lib "Kernel32" Alias "GetComputerNameW" (ByVal lpBuffer As String, nSize As Long) As Long
+#Else
+    Declare Function GetTempFileName Lib "Kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
+    Declare Function GetTempPath Lib "Kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
+    Public Declare Function GetComputerName Lib "Kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
+#End If
+Public Declare Function GetTickCount Lib "Kernel32" () As Long
+Public Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
+
+'Caption String Constants
+Public Const giFORM_CAPTION  As Integer = 101                   'Form Caption
+Public Const giCALLS_MADE_CAPTION  As Integer = 102
+Public Const giCALLS_RETURNED_CAPTION  As Integer = 103
+
+'Log String Constants
+Public Const giCOMPONENT_NAME  As Integer = 2
+Public Const giCALLBACK_RECEIVED  As Integer = 3
+Public Const giCALLBACK_ERROR_RECEIVED  As Integer = 4
+Public Const giQUEUE_SERVICE  As Integer = 5
+Public Const giQUEUE_SERVICE_ERROR  As Integer = 7
+Public Const giQUEUE_SERVICE_COLLISION_RETRY  As Integer = 9
+Public Const giWAIT_PERIOD_ERROR  As Integer = 12
+Public Const giSTART_TEST  As Integer = 13
+Public Const giSTOP_TEST  As Integer = 14
+Public Const giTEST_STARTED  As Integer = 16
+Public Const giTEST_COMPLETE  As Integer = 17
+Public Const giSERVICES_POSTED  As Integer = 18
+Public Const giCALLBACKS_COMPLETE As Integer = 19
+Public Const giINITIALIZING_TEST As Integer = 20
+Public Const giDIRECT_SERVICE  As Integer = 21
+Public Const giWRITING_TEMP_FILE  As Integer = 23
+Public Const giUSING_NO_AUTHENTICATION  As Integer = 24
+Public Const giDISK_FULL As Integer = 26
+Public Const giPOOL_MGR_REJECTION_WAITS_EXHAUSTED As Integer = 27
+Public Const giERROR_CREATE_MTS_OBJECT As Integer = 28
+
+Public Const giFONT_CHARSET_INDEX As Integer = 30
+Public Const giFONT_NAME_INDEX As Integer = 31
+Public Const giFONT_SIZE_INDEX  As Integer = 32
+
+Public Const giERROR_PREFIX  As Integer = 50                ' "Error:  "
+
+' MTS Transaction-related text
+Public Const giSUCCEEDED_TRANSACTIONS_CAPTION As Integer = 110
+Public Const giABORTED_TRANSACTIONS_CAPTION As Integer = 111
+Public Const giBEGIN_MTS_TRANSACTION As Integer = 112
+Public Const giEND_MTS_TRANSACTION_FAILED As Integer = 113
+Public Const giEND_MTS_TRANSACTION_SUCCEEDED As Integer = 114
+Public Const giMTS_FORM_CAPTION As Integer = 115
+
+Public Const giRACREG_ERROR_CODE_OFFSET As Integer = 200               'Add offset to racreg32 error codes
+                                                            'to make corresponding resource string key
+'Application Error Constants
+Public Const giCOLLISION_ERROR  As Integer = 32767          'OLE collision retries exausted
+Public Const giREQUIRED_PARAMETER_IS_MISSING As Integer = 32765
+Public Const giPOOLMGR_RETURNED_NOTHING As Integer = 32766
+Public Const giCONNECTION_SETTING_FAILED As Integer = 32750     'An error was returned by RacReg32
+Public Const giNO_NAMED_PIPES_UNDER_WIN95  As Integer = 32739     ' Named pipes cannot be created under Win95
+'Queue Manager errors
+Public Const giQUEUE_MGR_IS_BUSY As Integer = 32749
+
+'Other Constants
+Public Const giCALL_SENT_AND_RECEIVED_MAX_DIFFERENCE As Integer = 200   'If the number of calls that the
+                                                                'client has made is this much greater than
+                                                                'the number of calls received back then
+                                                                'pause making calls until callbacks catch up
+Public Const giREDIM_CHUNK_SIZE  As Integer = 100               'Size of redimension chunks of log array
+Public Const giNO_RECORD  As Integer = -1                       'Flag value meaning no records
+Public Const giMAX_ALLOWED_RETRIES  As Integer = 500            'Max allowed OLE automation call retries
+Public Const giRETRY_WAIT_MIN  As Integer = 1000                'Retry Wait is measure in DoEvent cyles
+Public Const giRETRY_WAIT_MAX  As Integer = 5000
+Public Const giROWS_RETURNED_PER_GET_RECORDS As Integer = 500   'Max number of records returned for
+                                                                'each call of GetRecords
+Public Const RPC_C_AUTHN_LEVEL_NONE  As Integer = 1             'Remote Automation Authentication level constant
+Public Const giPOOL_WAIT_RETRY_MIN As Integer = 1000            'The minum milliseconds to wait if the Pool Manager
+                                                                'rejects request for a Worker
+Public Const giQUEUE_WAIT_RETRY_MIN As Integer = 3000           'The minimum to wait in milliseconds if the Queue
+                                                                'raises an error that it is to busy to process
+                                                                'a Service Request
+Public Const glMAX_LONG As Long = 2147483647
+Public Const giDEFAULT_TIMER_INTERVAL As Integer = 100
+Public Const giSLEEP_INCREMENT As Integer = 500                     ' Time (ms) to sleep on each iteration of a delay loop
+
+'Type
+Public Type RANDOM_DATA_GROUP
+    Random As Boolean
+    SpecificValue As Long
+    UpperValue As Long
+    LowerValue As Long
+End Type
+
+'Global Variables and Objects
+Public goTestTool As Object             'Object of a class having RunTest method
+                                        'actually runs the test.  Different classes
+                                        'are used for different types of tests
+Public gcServices As Collection         'Collection of clsCllietnService class objects
+                                        'stores expected callback information
+Public gaLog() As Variant               'Array that stores log records
+Public glCallsMade As Long              'Number of calls made in test
+Public glCallsReturned As Long          'Number of callbacks made in a test
+Public glInstances As Long              'Count of intances of Client class
+Public glLogThresholdRecs As Long       'Log threshold in record count
+Public goRegClass As RacReg.RegClass    'RacReg used to change connection settings
+Public glLastAddedRecord As Long        'Last added log record array index
+Public glFirstServiceTick As Long       'Milliseconds of test start
+Public glLastCallbackTick As Long       'Milliseconds of end of test
+Public gsTempFile As String             'Temporary log file name
+
+'Flags
+Public gbTestInProcess As Boolean           'If true, test is in process
+Public gbStopping As Boolean                'If true, stopping test, procedures check it
+Public gbShutDown As Boolean                'If true, shutting down client
+Public gbRunCompleteProcedure As Boolean    'Timer will run CompleteTest
+Public gbRunning As Boolean                 'In a RunTest method
+Public gbGetWrittenLogCalled As Boolean     'GetWritten log was called
+
+'Public Property Variables
+Public gsServiceCommand As String               'Command string to pass to Queue.Add
+Public gbUseDefaultService As Boolean           'If true use default service object
+Public gudtWaitPeriod As RANDOM_DATA_GROUP      'How long to wait between calls
+Public glNumberOfCalls As Long                  'Number of Calls to make in test
+Public glTestDurationInTicks As Long            'Number of Milliseconds for Test to last
+Public giTestDurationMode As Integer            'Mode of determining test duration
+Public gudtSendNumRows As RANDOM_DATA_GROUP     'Number of rows of data to send with Service request
+Public gudtSendRowSize As RANDOM_DATA_GROUP     'Number of bytes of data to put in each row of data
+Public glSendContainerType As Long              'Type of data to send with Service request
+Public gudtReceiveNumRows As RANDOM_DATA_GROUP  'Number of rows to request back from Service request
+Public gudtReceiveRowSize As RANDOM_DATA_GROUP  'Size of each row in bytes to request back
+Public glReceiveContainerType As Long           'Container type to request back from Service request
+Public gudtTaskDuration As RANDOM_DATA_GROUP    'Length of time a Service request should use the processor
+Public gudtSleepPeriod As RANDOM_DATA_GROUP    'Length of time a Service request should sleep
+Public giServiceTask As Integer                'Code for whether Service should use processor cycles during
+Public gsDatabaseQuery As String        'Query for the Service to use to execute a database request
+Public giUseProcPercent As Integer              'Percentage of requests that services should use processor
+Public gvServiceConfiguration As Variant     'Service configuration information
+
+Public gbShow As Boolean                'If true, show frmClient during test
+Public gbLog As Boolean                 'If true log events during test
+Public glCallbackMode As Long           'Determines if and how client receives results from
+                                        'services requested from QueueManager
+                                        'see "Callback mode keys" in modAEConstants
+Public gbLogWorker As Boolean           'If true, have directly instanciated worker log
+Public gbPreloadServices As Boolean     'If true, have directly instanciated worker preload
+                                        'needed service object
+Public gbPersistentServices As Boolean  'If true, have directly instanciated worker retain
+                                        'references to Service objects
+Public gbEarlyBindServices As Boolean   'If true, have directly instanciated workers use
+                                        'earlybound service objects
+Public glModel As Long                  'APE framework model to use during test
+Public glClientID As Long               'Client ID Manager uses to manager Client object
+Public gsConnectionAddress As String    'Net address of APE server objects to use
+Public gsConnectionProtocol As String   'Protocol to connect with
+Public glConnectionAuthentication As String 'Authentiation level to use
+Public gbConnectionRemote As Boolean    'If true, connect to a remote server not local
+Public gbConnectionNetOLE As Boolean    'If true, use NetOLE (DCOM) instead of Remote Automation
+Public goExplorer As APEInterfaces.IManagerCallback 'Explorer object passed to client from Manager
+                                           'Client calls manager back with this
+Public glLogThreshold As Long           'Log threshodl in kilobytes
+
+Public Sub CompleteTest()
+    '-------------------------------------------------------------------------
+    'Purpose:   Release objects used during test, and call Manager with
+    '           notification the test.
+    'Effects:
+    '   [gbTestInProcess]
+    '           becomes false
+    '   [goTesttool]    destroyed
+    '   [goExplorer]    destroyed
+    '   [gcServices]    destroyed
+    '-------------------------------------------------------------------------
+    Dim s As String
+    Static stbInCompleteTest As Boolean 'If true already in this procedure
+    
+    'Exit if reentry caused by timer click
+    'while calling goExplorer
+    
+    If stbInCompleteTest Then Exit Sub
+    stbInCompleteTest = True
+    On Error GoTo CompleteTestError
+    s = LoadResString(giTEST_COMPLETE)
+    If gbLog Then AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
+    DisplayStatus s
+    If Not goExplorer Is Nothing Then goExplorer.Done ape_ctClient
+    Set goTestTool = Nothing
+    Set gcServices = Nothing
+    stbInCompleteTest = False
+    gbTestInProcess = False
+    Exit Sub
+CompleteTestError:
+    Select Case Err.Number
+        Case RPC_E_CALL_REJECTED
+            'Collision error, the OLE server is busy
+            Dim iRetry As Integer
+            Dim il As Integer
+            Dim ir As Integer
+            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
+                Resume
+            Else
+                'We reached our max retries
+                AddLogRecord gsNULL_SERVICE_ID, LoadResString(giCOLLISION_ERROR), GetTickCount(), False
+                Resume Next
+            End If
+        Case Else
+            s = LoadResString(giQUEUE_SERVICE_ERROR) & CStr(Err.Number) & gsSEPERATOR & Err.Source & gsSEPERATOR & Err.Description
+            AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
+            stbInCompleteTest = False
+            Err.Raise Err.Number, Err.Source, Err.Description
+            Exit Sub
+    End Select
+End Sub
+
+
+Public Sub gStopTest()
+    '-------------------------------------------------------------------------
+    'Purpose:   To stop cancel the current test
+    'Assumes:   If gbRunning is true, a method procedure or a callback method
+    '           are being processed.  We can exit this procedure and one of those
+    '           methods will check the gbStopping flag and call gStopTest again
+    '           If gbShutDown is true, then this procedure was called by the
+    '           Terminate event of the Client class on the release of its last
+    '           reference
+    'Effects:
+    '   [gbTestInProcess]
+    '                   becomes false
+    '   [goTesttool]    destroyed
+    '   [goExplorer]    destroyed
+    '   [gcServices]    destroyed
+    '   [goRegClass]
+    '           If gbShutDown is true destroy goRegClass
+    '   [frmClient]
+    '           If gbShutDown is true unload
+    '-------------------------------------------------------------------------
+    Dim oCA As clsClientService
+    Dim s As String
+    On Error GoTo gStopTestError
+    
+    gbStopping = True
+    s = LoadResString(giSTOP_TEST)
+    If gbLog Then AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
+    DisplayStatus s
+    'Make sure we are not in the middle of queueing an Service.
+    'If we are, get out.  QueueService will check the gbStopping flag
+    'and call the gStopTest method again when it's done.
+    If gbRunning Then Exit Sub
+    Set goTestTool = Nothing
+    Set gcServices = Nothing
+    gbTestInProcess = False
+    'See if this was called by Terminate if it was unload form
+    If gbShutDown Then
+        Set goRegClass = Nothing
+        Unload frmClient
+    End If
+    Exit Sub
+gStopTestError:
+    Select Case Err.Number
+        Case Else
+            LogError Err
+            If glInstances > 0 Then Err.Raise Err.Number, Err.Source, Err.Description
+            Resume Next
+    End Select
+End Sub
+
+
+Public Sub AddServiceRecord(sID As String, sCommand As String, lTicks As Long)
+    '-------------------------------------------------------------------------
+    'Purpose:   Put a new Service Request in the Service collection.
+    'In:
+    '   [sID]   Service Request ID
+    '   [sCommand]
+    '           Service Request Command sent to QueueMgr
+    '   [lTicks]
+    '           Tick count at time of call to QueueMgr
+    'Effects:
+    '   [gcServices]
+    '           Adds a clsClientService class object to collection
+    '-------------------------------------------------------------------------
+    Dim oCA As clsClientService     'Object with properties designed to store
+                                    'Service request information
+    
+    Set oCA = New clsClientService
+    With oCA
+        .sID = sID
+        .sCommand = sCommand
+        .lStartTicks = lTicks
+    End With
+    gcServices.Add oCA, oCA.sID
+End Sub
+
+Public Sub WriteLog()
+    '-------------------------------------------------------------------------
+    'Purpose:   Writes the current log records to a temp file and
+    '           removes the records from memory
+    'Assumes:   If gbGetWrittenLogCalled is true, any records currently in the
+    '           temporary file are no longer needed, but the file may still be
+    '           open.
+    'Effects:
+    '           All records currently in gaLog are written to a temporary file
+    '           and removed from the array
+    '   [gbGetWrittenLogCalled]
+    '           becomes false
+    '   [glLastAddedRecord]
+    '           becomes giNO_RECORD
+    '   [gaLog] becomes redimension to store new records
+    '-------------------------------------------------------------------------
+    'Don't save the Component name because the component
+    'is always the same
+    Dim sServiceID As String
+    Dim sComment As String
+    Dim lMilliseconds As Long
+    Dim lFile As Long
+    Dim l As Long
+    On Error GoTo WriteLogError
+    If glLastAddedRecord > giNO_RECORD Then
+        If gbLog Then
+            AddLogRecord gsNULL_SERVICE_ID, LoadResString(giWRITING_TEMP_FILE), GetTickCount, False
+        End If
+        
+        'Check to see if the contents of the temp file
+        'need deleted first, the reason it is not delete
+        'when the flag is flipped is to give one the chance
+        'of rescueing it if the Manager fails to retreive
+        'the records from it
+        If gbGetWrittenLogCalled Then
+            Close   'Close in case last GetWrittenLogs cancelled
+            Kill gsTempFile
+            gbGetWrittenLogCalled = False
+        End If
+            
+        lFile = FreeFile
+        Open gsTempFile For Append As lFile
+            For l = 0 To glLastAddedRecord
+                sServiceID = gaLog(giSERVICE_ELEMENT, l)
+                sComment = gaLog(giCOMMENT_ELEMENT, l)
+                lMilliseconds = gaLog(giMILLI_SECONDS_ELEMENT, l)
+                Write #lFile, sServiceID, sComment, lMilliseconds
+                'Reset logrecord counter no after writing the first record
+                'so that records are not added after the count that is being
+                'written and therefore, lost.  This also protects from
+                'Addlogrecord trying to write a record greater than
+                'giREDIM_CHUNK_SIZE write after gaLog is redimensioned
+                If l = 0 Then glLastAddedRecord = giNO_RECORD
+            Next
+        Close #lFile
+        'Remove LogRecords from memory
+        'Preserve is used because there is a potential
+        'for a log record to be added after the above line
+        'but before the following one
+        ReDim Preserve gaLog(giLOG_ARRAY_DIMENSION_ONE, giREDIM_CHUNK_SIZE)
+    End If
+    Exit Sub
+WriteLogError:
+    Select Case Err.Number
+        Case ERR_DISK_FULL
+            'Turn off logging erase array
+            'leave present file for later retrieval
+            DisplayStatus LoadResString(giDISK_FULL)
+            Close lFile
+            Erase gaLog
+            gbLog = False
+            Exit Sub
+        Case ERR_FILE_NOT_FOUND
+            'There is no temp file to kill
+            Resume Next
+        Case Else
+            Close lFile
+            Err.Raise Err.Number, Err.Source, Err.Description
+            Exit Sub
+    End Select
+End Sub
+
+
+Public Sub GetWrittenLog()
+    '-------------------------------------------------------------------------
+    'Purpose:   Checks to see if there is log records written to a temp file
+    '           If there are it inputs it and adds it to the gaLog array
+    '           If it reaches the chunk size for passing log records it will
+    '           exit the loop, leaving the file open. It is necessary to keep
+    '           calling this function until no records or added.  Do not call
+    '           this function more than once until the array that was filled
+    '           was erased.  The external process that is calling a method that
+    '           calls this procedure should be responsible for calling until
+    '           all records have been attained.
+    'Effects:
+    '           [gbGetWrittenLogCalled] becomes true
+    '           Temp file may be left open if all records are not read
+    '           AddlogRecord is called for each record read
+    'Assumption:
+    '           If gbGetWrittenLogCalled is true then the temp file is already
+    '           open, ready for the next record to be read.
+    '           If the EOF is not reached before the glROWS_RETURNED_PER_GET_RECORDS
+    '           is reached then the external process that called Logger.GetRecords
+    '           will call it again, to get the rest of the records
+    '-------------------------------------------------------------------------
+    
+    Static stlFile As Long      'File number
+    Dim sPath As String         'Path and file name of temporary file
+    Dim sServiceID As String      'Service Request ID
+    Dim sComment As String      'Comment in log record
+    Dim lMilliseconds As Long   'Milliseconds in log record
+    Dim lAddedCount As Long     'Count of how many records have been read and added to memory
+    
+    On Error GoTo GetWrittenLogError
+    sPath = gsTempFile
+    
+    'Open file if it is not open yet
+    If Not gbGetWrittenLogCalled Then
+        'Write records in memory first to order the records
+        'with any records that may have already been written
+        WriteLog
+        gbGetWrittenLogCalled = True
+        stlFile = FreeFile
+        Open sPath For Input As stlFile
+    End If
+    
+    Do Until EOF(stlFile)
+        'Component was not saved to temp file because
+        'the component name is always the same in this file
+        Input #stlFile, sServiceID, sComment, lMilliseconds
+        AddLogRecord sServiceID, sComment, lMilliseconds, True
+        lAddedCount = lAddedCount + 1
+        'Exit here if max record size was reached
+        If lAddedCount = giROWS_RETURNED_PER_GET_RECORDS Then Exit Sub
+    Loop
+    Close
+    Exit Sub
+GetWrittenLogError:
+    Select Case Err.Number
+        Case ERR_FILE_NOT_FOUND
+            'There are no written records so exit
+            Exit Sub
+        Case ERR_BAD_FILE_NAME
+            'We have already reached the end of the file
+            'and it has been closed
+            Exit Sub
+        Case Else
+            Close
+            Err.Raise Err.Number, Err.Source, Err.Description
+            Exit Sub
+    End Select
+End Sub
+
+
+Public Function GetTempFile() As String
+    '-------------------------------------------------------------------------
+    'Purpose:   Gets a temp file name from the system
+    'Return:    a valid temporary file name
+    '-------------------------------------------------------------------------
+    Dim lSize As Long
+    Dim sPath As String
+    Dim sName As String
+    Dim lResult As Long
+    
+    sPath = Space(255)
+    lResult = GetTempPath(255, sPath)
+    sPath = Left$(sPath, lResult)
+    sName = Space(255)
+    lResult = GetTempFileName(sPath, "AEC", 0, sName)
+    lResult = InStr(sName, vbNullChar)
+    sName = Left$(sName, lResult - 1)
+    
+    GetTempFile = sName
+End Function
+
+Public Sub DisplayString(s As String)
+    '-------------------------------------------------------------------------
+    'Purpose:   Adds the passed text to to the list box.  Only used if conditional
+    '           compile ccShowList is true.
+    'Assumes:   If gbShow is true, form is visible
+    '           If ccShowList is true, lstLog is visible and positioned
+    '-------------------------------------------------------------------------
+    If gbShow Then
+        With frmClient.lstLog
+            If .ListCount = giLIST_BOX_MAX Then .Clear
+            .AddItem s, 0
+        End With
+    End If
+End Sub
+
+Public Sub DisplayStatus(s As String)
+    '-------------------------------------------------------------------------
+    'Purpose:   If gbShow is true, displays passed string on forms status box
+    'Assumes:   If gbShow is true, form is loaded and visible
+    '-------------------------------------------------------------------------
+    If gbShow Then
+        AlignTextToBottom frmClient.lblStatus, s
+    End If
+End Sub
+
+
+'Puts a new log record into the private log array and updates the listbox
+'if the the UI is visible.  The logs will besent to the manager later.
+Public Sub AddLogRecord(sServiceID As String, sComment As String, lMilliseconds As Long, bIgnoreThreshod As Boolean)
+    '-------------------------------------------------------------------------
+    'Purpose:   Called to add a record to the gaLog.
+    'In:        [sServiceID]    Service ID that will be added
+    '           [sComment]      Comment that will be added
+    '           [lMilliseconds] Milliseconds that will be added
+    '           [bIgnoreThreshold]
+    '                           If true, procedure ignores the Threshold property
+    '                           It will not write the records to a file and
+    '                           remove them from the array
+    'Effects:   [gaLog]         May be redimensioned (preserve) to increase
+    '                           its size
+    '           [glLastAddedRecord]
+    '                           will be increased by one
+    '-------------------------------------------------------------------------
+    Dim lU As Long      'Ubound of array
+    Dim lIndex As Long  'array index to put records in
+
+    On Error GoTo AddLogRecordError
+AddLogRecordTop:
+        
+    'Check if the array needs dimensioned
+    If glLastAddedRecord = giNO_RECORD Then
+        ReDim gaLog(giLOG_ARRAY_DIMENSION_ONE, giREDIM_CHUNK_SIZE)
+        glLastAddedRecord = 0
+        lIndex = glLastAddedRecord
+    Else
+        lU = UBound(gaLog, 2)
+        glLastAddedRecord = glLastAddedRecord + 1
+        lIndex = glLastAddedRecord
+        If glLastAddedRecord > lU Then
+            'Redim gaRecords to increase size
+            lU = lU + giREDIM_CHUNK_SIZE
+            ReDim Preserve gaLog(giLOG_ARRAY_DIMENSION_ONE, lU)
+        End If
+    End If
+    gaLog(giCOMPONENT_ELEMENT, lIndex) = LoadResString(giCOMPONENT_NAME) & Str$(glClientID)
+    gaLog(giSERVICE_ELEMENT, lIndex) = sServiceID
+    gaLog(giCOMMENT_ELEMENT, lIndex) = sComment
+    gaLog(giMILLI_SECONDS_ELEMENT, lIndex) = lMilliseconds
+    If Not bIgnoreThreshod And glLogThresholdRecs > 0 And glLogThresholdRecs = glLastAddedRecord Then
+       'Write the log file
+       WriteLog
+    End If
+    #If ccShowList Then
+        DisplayString sServiceID & gsSEPERATOR & sComment: DoEvents
+    #End If
+    Exit Sub
+AddLogRecordError:
+    Select Case Err.Number
+        Case ERR_SUBSCRIPT_OUT_OF_RANGE
+            'Synchronicity issues caused this
+            'Got the glLastAddedRecord write before it got changed
+            'but tried to put record in array right after it got redim'ed
+            Dim bTried
+            'If already tried raise error
+            If bTried Then Err.Raise Err.Number, Err.Source, Err.Description
+            bTried = True
+            'Try the at the top again, getting a new glLastAddedRecord
+            GoTo AddLogRecordTop
+        Case Else
+            DisplayStatus Err.Description
+            Exit Sub
+    End Select
+End Sub
+
+Public Sub LogError(ByVal oErr As ErrObject)
+    '-------------------------------------------------------------------------
+    'Purpose:   Display error description on forms Status box if the form is
+    '           visible
+    'In:        [oErr]
+    '               Valid error object
+    '-------------------------------------------------------------------------
+    Dim s As String
+    s = LoadResString(giERROR_PREFIX) & Str$(oErr.Number) & gsSEPERATOR & oErr.Source & gsSEPERATOR & oErr.Description
+    AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
+    DisplayStatus oErr.Description
+End Sub
+
+Function GetValueFromRange(udtRangeData As RANDOM_DATA_GROUP, bRandomValueRequired As Boolean) As Long
+    Dim lReturn As Long
+    
+    With udtRangeData
+        If .Random Then
+            Randomize
+            lReturn = CLng((.UpperValue - .LowerValue + 1) * Rnd + .LowerValue)
+        Else
+            lReturn = .SpecificValue
+        End If
+        If Not bRandomValueRequired Then bRandomValueRequired = .Random
+    End With
+    GetValueFromRange = lReturn
+End Function
+
+Function GetServiceCommand(bRandomCommandRequired As Boolean) As String
+    Dim sSendCommand As String
+    Dim iRandom As Integer
+    
+    bRandomCommandRequired = False
+    'Get ServiceCommand to use
+    If gbUseDefaultService Then
+        sSendCommand = gsSERVICE_LIB_CLASS & "." & giServiceTask
+    Else
+        sSendCommand = gsServiceCommand
+    End If
+    GetServiceCommand = sSendCommand
+End Function
+
+
+Function GetTestData(bSendSomething As Boolean, bReceiveSomething As Boolean, vSendData As Variant) As Boolean
+    Dim s As String
+    Dim i As Integer
+    Dim lSendNumRows As Long
+    Dim lSendRowSize As Long
+    Dim lReceiveNumRows As Long
+    Dim lReceiveRowSize As Long
+    Dim cData As Collection
+    Dim aData() As Variant
+    Dim lSendContainerType As Long
+    Dim lReceiveContainerType As Long
+    Dim bRandomDataRequired As Boolean
+    Dim lTaskDuration As Long, lSleepPeriod As Long
+    
+    lReceiveContainerType = glReceiveContainerType
+    lSendContainerType = glSendContainerType
+    
+    'Get Data that will be worked with
+    lSendNumRows = GetValueFromRange(gudtSendNumRows, bRandomDataRequired)
+    lSendRowSize = GetValueFromRange(gudtSendRowSize, bRandomDataRequired)
+    lReceiveNumRows = GetValueFromRange(gudtReceiveNumRows, bRandomDataRequired)
+    lReceiveRowSize = GetValueFromRange(gudtReceiveRowSize, bRandomDataRequired)
+    lTaskDuration = GetValueFromRange(gudtTaskDuration, bRandomDataRequired)
+    lSleepPeriod = GetValueFromRange(gudtSleepPeriod, bRandomDataRequired)
+    
+    'Check if we are sending or receiving any data
+    'Clear the data structures
+    bSendSomething = True
+    bReceiveSomething = False
+ 
+    Set cData = New Collection
+    ReDim aData(0) As Variant
+    'Anything to send to the Service?
+    If (lSendNumRows = 0 Or lSendRowSize = 0) And (lReceiveNumRows = 0 Or lReceiveRowSize = 0) And _
+            lTaskDuration = 0 And lSleepPeriod = 0 Then
+        'Nothing to send to the Service
+        ' bSendSomething = False    We need to send the service configuration information with each call
+    Else
+        bSendSomething = True
+        'Fill the data class send data for passing to the Service
+        s = Space(lSendRowSize)
+        Select Case lSendContainerType
+            Case giCONTAINER_TYPE_VARRAY
+                ReDim Preserve aData(giRECORD_DATA_BEGIN + lSendNumRows - 1) As Variant
+                For i = giRECORD_DATA_BEGIN To giRECORD_DATA_BEGIN + lSendNumRows - 1
+                    aData(i) = s
+                Next i
+            Case giCONTAINER_TYPE_VCOLLECTION
+                For i = 1 To lSendNumRows
+                    cData.Add s
+                Next i
+         End Select
+    End If
+    'Anything to receive back from the Service?
+    If (lReceiveNumRows = 0 Or lReceiveRowSize = 0 Or lReceiveContainerType = giCONTAINER_TYPE_NULL) Then
+        bReceiveSomething = False
+        lReceiveNumRows = 0
+        lReceiveRowSize = 0
+        lReceiveContainerType = giCONTAINER_TYPE_NULL
+    Else
+        bReceiveSomething = True
+    End If
+    'Some data may actually be sent if something is expected back or a
+    'Milliseconds to be used is specified, but only enough data to instruct
+    'the Service on what to do.
+    If bReceiveSomething Or bSendSomething Then
+        'Fill the global data class receive parameters for passing to the Service
+        Select Case lSendContainerType
+        Case giCONTAINER_TYPE_VARRAY
+            'Make sure we have records in our array to fill
+            If UBound(aData) < giRECORD_DATA_BEGIN - 1 Then
+                ReDim aData(giRECORD_DATA_BEGIN - 1) As Variant
+            End If
+            aData(giRECORD_NUMROWS) = lReceiveNumRows
+            aData(giRECORD_ROWSIZE) = lReceiveRowSize
+            aData(giRECORD_TASK_DURATION) = lTaskDuration
+            aData(giRECORD_SLEEP_PERIOD) = lSleepPeriod
+            aData(giRECORD_CONTAINER_TYPE) = lReceiveContainerType
+            aData(giRECORD_DATABASE_QUERY) = gsDatabaseQuery
+            aData(giRECORD_SERVICE_CONFIGURATION) = gvServiceConfiguration
+        Case giCONTAINER_TYPE_VCOLLECTION
+            cData.Add lReceiveNumRows, CStr(giRECORD_NUMROWS)
+            cData.Add lReceiveRowSize, CStr(giRECORD_ROWSIZE)
+            cData.Add lTaskDuration, CStr(giRECORD_TASK_DURATION)
+            cData.Add lSleepPeriod, CStr(giRECORD_SLEEP_PERIOD)
+            cData.Add lReceiveContainerType, CStr(giRECORD_CONTAINER_TYPE)
+            cData.Add gsDatabaseQuery, CStr(giRECORD_DATABASE_QUERY)
+            cData.Add gvServiceConfiguration, CStr(giRECORD_SERVICE_CONFIGURATION)
+        End Select
+    End If
+    
+    'Set return value and out parameters
+    Select Case lSendContainerType
+    Case giCONTAINER_TYPE_VARRAY
+        vSendData = aData()
+    Case giCONTAINER_TYPE_VCOLLECTION
+        Set vSendData = cData
+    End Select
+    GetTestData = bRandomDataRequired
+End Function
+
+Sub ConfigureTest()
+    '-------------------------------------------------------------------------
+    'Purpose:   Configure the Client to run a test according to its current
+    '           properties.
+    'Effects:   U/I is reset for a new test
+    '           Remote Connection settings are made useing RacReg
+    '   [glCallsMade]
+    '           becomes 0
+    '   [glCallsReturned]
+    '           becomes 0
+    '   [gbTestInProcess]
+    '           becomes true
+    '   [gbStopping]
+    '           becomes false
+    '   [gcServices]
+    '           is destroyed and reinstanciated
+    '   [goTestTool]
+    '           is instanciated with the correct class having a RunTest method
+    'Assumption:
+    '           A test is not already in process
+    '-------------------------------------------------------------------------
+    'Configure test mode and connection settings
+    Dim iResult As Integer
+    
+    'Set the global status flags
+    'If there is reentry by a timer click exit sub
+    If gbTestInProcess Then Exit Sub
+    gbTestInProcess = True
+    'Clear the Services collection
+    Set gcServices = Nothing
+    Set gcServices = New Collection
+    'Set global variables
+    glCallsMade = 0
+    glCallsReturned = 0
+    'Display the stautus defaults
+    If gbShow Then
+        With frmClient
+            .lblCallsMade.Caption = 0
+            .lblCallsReturned.Caption = 0
+            .lblCallsMade.Refresh
+            .lblCallsReturned.Refresh
+        End With
+    End If
+    'Set the connection settings for AEWorker.Worker, AEQueueMgr.Queue, AEPoolMgr.Pool
+    With goRegClass
+        If gbConnectionRemote Then
+            If gbConnectionNetOLE Then
+                iResult = .SetNetOLEServerSettings(True, "AEQueueMgr.Queue", , gsConnectionAddress)
+                If iResult <> 0 Then GoTo ConfigureTest_RacRegError
+                iResult = .SetNetOLEServerSettings(True, "AEWorker.Worker", , gsConnectionAddress)
+                If iResult <> 0 Then GoTo ConfigureTest_RacRegError
+                iResult = .SetNetOLEServerSettings(True, "AEPoolMgr.Pool", , gsConnectionAddress)
+                If iResult <> 0 Then GoTo ConfigureTest_RacRegError
+            Else
+                iResult = .SetAutoServerSettings(True, "AEQueueMgr.Queue", , gsConnectionAddress, gsConnectionProtocol, glConnectionAuthentication)
+                If iResult <> 0 Then GoTo ConfigureTest_RacRegError
+                iResult = .SetAutoServerSettings(True, "AEWorker.Worker", , gsConnectionAddress, gsConnectionProtocol, glConnectionAuthentication)
+                If iResult <> 0 Then GoTo ConfigureTest_RacRegError
+                iResult = .SetAutoServerSettings(True, "AEPoolMgr.Pool", , gsConnectionAddress, gsConnectionProtocol, glConnectionAuthentication)
+                If iResult <> 0 Then GoTo ConfigureTest_RacRegError
+            End If
+        Else
+            iResult = .SetAutoServerSettings(False, "AEQueueMgr.Queue")
+            If iResult <> 0 Then GoTo ConfigureTest_RacRegError
+            iResult = .SetAutoServerSettings(False, "AEWorker.Worker")
+            If iResult <> 0 Then GoTo ConfigureTest_RacRegError
+            iResult = .SetAutoServerSettings(False, "AEPoolMgr.Pool")
+            If iResult <> 0 Then GoTo ConfigureTest_RacRegError
+        End If
+    End With
+    'Check our mode and create instances of the correct objects.
+    Select Case glModel
+        Case giMODEL_QUEUE
+            Set goTestTool = New clsQueueTestTool
+        Case giMODEL_DIRECT
+            Set goTestTool = New clsDirectTestTool
+        Case giMODEL_POOL
+            Set goTestTool = New clsPoolTestTool
+    End Select
+    Exit Sub
+ConfigureTest_RacRegError:
+    Err.Raise giCONNECTION_SETTING_FAILED, , ReplaceString(LoadResString(giCONNECTION_SETTING_FAILED), gsNAME_TOKEN, LoadResString(giRACREG_ERROR_CODE_OFFSET + iResult))
+End Sub
+
+Sub StopOnError(sMessage As String)
+    '-------------------------------------------------------------------------
+    'Purpose:   Stop current test immediately
+    'Effects:
+    '           Calls goExplorer.Done
+    '   [glLastCallbackTick]
+    '           becomes value of GetTickCount
+    '   [goTestTool]    is destroyed
+    '   [gcServices]    is destroyed
+    '   [goExplorer]    is destroyed
+    '   [gbTestInProcess]
+    '           becomes false
+    '-------------------------------------------------------------------------
+    On Error GoTo StopOnError_Error
+    glLastCallbackTick = GetTickCount()
+    gbRunning = False
+    gbStopping = True   'This flags will cause callbacks to be ignored
+    If gbLog Then AddLogRecord gsNULL_SERVICE_ID, LoadResString(giSERVICES_POSTED), GetTickCount(), False
+    goExplorer.Done ape_ctClient, sMessage
+    Set goTestTool = Nothing
+    Set gcServices = Nothing
+    gbTestInProcess = False
+    Exit Sub
+StopOnError_Error:
+    If gbLog Then AddLogRecord gsNULL_SERVICE_ID, LoadResString(giSERVICES_POSTED), GetTickCount(), False
+    LogError Err
+    Resume Next
+End Sub
+
+Public Sub CallBackHandler(sServiceID As String, vServiceReturn As Variant, sServiceError As String)
+    '-------------------------------------------------------------------------
+    'Purpose:   Called by clsCallback Callback method or .
+    'IN:
+    '   [sServiceID]
+    '           Service Request ID
+    '   [vServiceReturn]
+    '           Data returned by Service Request
+    '   [sServiceError]
+    '           Error information for errors that occured processing Service Request.
+    '           Information is delimited by a semi-colon and a space in the following
+    '           format:  "number; source; description"
+    'Effects:
+    '           May call CompleteTest procedure if all ServiceRequest have been returned
+    '   [glCallsReturned]
+    '           Increments by one
+    '   [gcServices]
+    '           Removes respective item
+    '-------------------------------------------------------------------------
+    Dim lTicks As Long                      'Milliseconds
+    Dim oClientService As clsClientService  'Object storing Service Request information
+                                            'one will be removed from gcServices
+    Dim s As String
+    
+    On Error GoTo CallBackHandlerError
+    'Grab the tics, keep a global copy of the last callback tick count for statistics.
+    glLastCallbackTick = GetTickCount()
+    'Exit sub if Stopping test
+    If gbStopping Then Exit Sub
+    'Lookup the Service
+    If IsNumeric(sServiceID) Then
+       'This is a valid Service.
+        'Look up the ID in our collection.
+        Set oClientService = gcServices.Item(sServiceID)
+        'No error.  This Service is in our Service collection
+        'Increment the CallsReturned global
+        glCallsReturned = glCallsReturned + 1
+        If gbShow Then
+            With frmClient.lblCallsReturned
+                .Caption = glCallsReturned
+                .Refresh
+            End With
+        End If
+        If gbLog Then AddLogRecord sServiceID, LoadResString(giCALLBACK_RECEIVED), glLastCallbackTick, False
+        'Remove the Service from the collection
+        gcServices.Remove (sServiceID)
+    End If
+    If Len(sServiceError) > 0 Then
+        'It's an error message.  Log it.
+        'And abort test
+        s = LoadResString(giCALLBACK_ERROR_RECEIVED) & gsSEPERATOR & sServiceError
+        If gbLog Then AddLogRecord sServiceID, s, lTicks, False
+        StopOnError s
+        
+    End If
+    'Are we through with the test yet?
+    Dim bDone As Boolean
+    Select Case giTestDurationMode
+        Case giTEST_DURATION_CALLS
+            bDone = (glCallsReturned = glNumberOfCalls)
+        Case giTEST_DURATION_TICKS
+            bDone = (glCallsReturned = glCallsMade) And Not gbRunning
+        Case Else
+            bDone = False
+    End Select
+    If bDone Then
+        'All Services have been queud and callbacks received.
+        If gbLog Then AddLogRecord gsNULL_SERVICE_ID, LoadResString(giCALLBACKS_COMPLETE), GetTickCount(), False
+        'Release the Explorer before running CompleteTest
+        gbRunCompleteProcedure = True
+        frmClient.tmrStartTest.Enabled = True
+    End If
+    Exit Sub
+CallBackHandlerError:
+    Select Case Err.Number
+        Case ERR_INVALID_PROCEDURE_CALL
+            'The ServiceID was not found in the Services collection.
+            LogError Err
+        Case ERR_OVER_FLOW
+            s = CStr(Err.Number) & gsSEPERATOR & Err.Source & gsSEPERATOR & Err.Description
+            glCallsReturned = 0
+            DisplayStatus Err.Description
+            AddLogRecord gsNULL_SERVICE_ID, s, GetTickCount(), False
+        Case Else
+            'Do not raise an error back to the expediter
+            LogError Err
+    End Select
+    Exit Sub
+End Sub
+

build-env/VisualStudio6/Common/Tools/APE/Source/Aeexpdtr/AEEXPDTR.RC

@@ -0,0 +1,27 @@
+STRINGTABLE DISCARDABLE 
+BEGIN
+	1	"*** Do *NOT* Localize any string that starts with '***'."
+	2	"*** They are comments to be used by localizers to identify sections."
+	3	"*** They also mark the beginning of a new 'section' within the String Table."
+	4	"Callback Called"
+	5	"Expediter"
+	7	"Calling Callback"
+	8	"StopTest Received"
+	9	"Call reject retries exhausted"		//message displayed when retry callbacks to
+							//to clients are exhausted
+	10	"Retrying rejected callback."
+	11	"GetServiceResults called with results returned"
+	12	"Could not find EventReturn object"
+	13	"Error: "
+	29	"*** Font information for all forms.  Index 30 is the Character set, Index 31 is Font name, Index 32 is Font Size"
+	30	"0"
+	31	"Tahoma"
+	32	"10"
+
+	//U/I captions
+	100	"*** Form U/I captions"
+	101	"Expediter"				//Form Caption
+	102	"Current Backlog"			//Current Backlog caption
+	103	"Peak Backlog"				//Peak Backlog caption
+	104	"Total Callbacks"			//Total Callbacks caption
+END

build-env/VisualStudio6/Common/Tools/APE/Source/Aeexpdtr/AEEXPDTR.VBP

@@ -0,0 +1,53 @@
+Type=OleExe
+Reference=*\G{C93809A0-684C-11D1-9D3E-0020781039AF}#1.0#0#..\AEINTRFC\AEIntrfc.tlb#Application Performance Explorer 2.0 Interfaces
+Module=modExpediter; modexpdt.bas
+Class=CallBackRef; callbkrf.cls
+Module=modAEConstants; ..\AEInclud\modaecon.bas
+Module=modVBErrors; ..\AEInclud\modvberr.bas
+Module=modWin32Errors; ..\AEInclud\modwiner.bas
+Class=clsPositionForm; ..\AEInclud\clsposfm.cls
+Form=frmexpdt.frm
+Class=Expediter; expeditr.cls
+Module=modAEGlobals; ..\AEInclud\modAEGlb.bas
+Class=EventReturn; SyncRtrn.cls
+Module=Utility; ..\AEInclud\Utility.bas
+Module=Localize; ..\AEInclud\Localize.bas
+ResFile32="aeexpdtr.res"
+IconForm="frmExpediter"
+Startup="Sub Main"
+HelpFile=""
+Title="APE Expediter"
+ExeName32="AEExpdtr.exe"
+Path32="..\..\Retail"
+Command32=""
+Name="AEExpediter"
+HelpContextID="0"
+Description="Application Performance Explorer Expediter"
+CompatibleMode="2"
+CompatibleEXE32="..\AECompat\AEExpdtr.cmp"
+VersionCompatible32="1"
+MajorVer=2
+MinorVer=0
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+VersionCompanyName="Microsoft Corporation"
+VersionFileDescription="Application Performance Explorer Expediter"
+VersionLegalCopyright="Copyright © 1996-1998 Microsoft Corp."
+VersionLegalTrademarks="Microsoft® is a registered trademark of Microsoft Corporation. Windows(TM) is a trademark of Microsoft Corporation"
+VersionProductName="Application Performance Explorer Expediter"
+CompilationType=0
+OptimizationType=0
+FavorPentiumPro(tm)=0
+CodeViewDebugInfo=0
+NoAliasing=0
+BoundsCheck=0
+OverflowCheck=0
+FlPointCheck=0
+FDIVCheck=0
+UnroundedFP=0
+StartMode=1
+Unattended=0
+ThreadPerObject=0
+MaxNumberOfThreads=1
+DebugStartupOption=0

build-env/VisualStudio6/Common/Tools/APE/Source/Aeexpdtr/CALLBKRF.CLS

@@ -0,0 +1,48 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0   'False
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+END
+Attribute VB_Name = "CallBackRef"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+'-------------------------------------------------------------------------
+'Purpose:   This class forms a data structure to store Service request
+'           information.  New CallBacksRef objects can be added to a
+'           collection to store the data
+'-------------------------------------------------------------------------
+Private mvResult As Variant     ' Stores the data to be returned
+
+Public ServiceID As String        'Service Request ID
+Public Object As APEInterfaces.IClientCallback  'Callback object that will be called
+Public SyncObject As EventReturn
+Public Error As String          'Error description that occurred in Worker
+                                'while processing task.
+Public UseSyncEvent As Boolean
+Public CallAttempts As Long     'The number of failed attempts to call the
+                                'Callback method of the Object property
+
+Public Property Get Result() As Variant
+    Select Case VarType(mvResult)
+        Case vbEmpty, vbNull
+            Result = Null
+        Case vbObject, vbError, vbDataObject
+            Set Result = mvResult
+        Case Else
+            Result = mvResult
+    End Select
+End Property
+
+Public Property Let Result(ByVal vNewValue As Variant)
+    mvResult = vNewValue
+End Property
+
+Public Property Set Result(ByVal vNewValue As Variant)
+    Set mvResult = vNewValue
+End Property
+

build-env/VisualStudio6/Common/Tools/APE/Source/Aeexpdtr/EXPEDITR.CLS

@@ -0,0 +1,230 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0   'False
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+END
+Attribute VB_Name = "Expediter"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = True
+Attribute VB_Description = "APE Expediter"
+Option Explicit
+'-------------------------------------------------------------------------
+'The Class is the only public class in this project.  See notes in
+'modExpediter for purpose.
+' It implements the IExpediter interface.
+'-------------------------------------------------------------------------
+
+Implements APEInterfaces.IExpediter
+
+'***********************
+'Public Properties
+'***********************
+
+Public Property Set IExpediter_QueueMgrRef(ByVal oQueueMgr As APEInterfaces.IQueueDelegator)
+Attribute IExpediter_QueueMgrRef.VB_Description = "Sets the QueueDelegator object that the Expediter uses to receive Service Request results from the AEQueueMgr."
+    '-------------------------------------------------------------------------
+    'Purpose:   Called by the the QueueMgr to pass a reference of itself to
+    '           the Expediter
+    'In:        [oQueueMgr]
+    '               A valid reference to a QueueMgr class object
+    'Effects:   [goQueueDelegator]
+    '               Sets the global object variable equal to the passed reference
+    '-------------------------------------------------------------------------
+    Set goQueueDelegator = oQueueMgr
+    
+End Property
+
+Public Property Let IExpediter_Show(ByVal bShow As Boolean)
+Attribute IExpediter_Show.VB_Description = "Determines whether the Expediter shows a form."
+    '-------------------------------------------------------------------------
+    'Purpose:   Show property determines whether or not a form
+    '           is displayed while expediter is loaded
+    'Effects:   [gbShow] becomes value of parameter
+    '           If parameter is true frmExpediter is show, else form
+    '           is hidden.  Form is never unloaded because the timer is needed
+    '-------------------------------------------------------------------------
+    
+    If Not gbShow = bShow Then
+        gbShow = bShow
+        If bShow = True Then
+            frmExpediter.Show
+            'Update U/I values
+            With frmExpediter
+                .lblBacklog.Caption = glBacklog
+                .lblPeak = glPeakBacklog
+                .lblBacklog.Refresh
+                .lblPeak.Refresh
+            End With
+        Else
+            'Never Unload form because it has a timer
+            frmExpediter.Hide
+        End If
+    End If
+    
+End Property
+
+Public Property Get IExpediter_Show() As Boolean
+    IExpediter_Show = gbShow
+End Property
+
+Public Property Let IExpediter_Log(ByVal bLog As Boolean)
+Attribute IExpediter_Log.VB_Description = " Determines if the Expediter 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
+    '-------------------------------------------------------------------------
+    
+    If Not gbLog = bLog Then
+        gbLog = bLog
+        If bLog = True Then
+            Set goLogger = CreateObject("AELogger.Logger")
+        Else
+            Set goLogger = Nothing
+        End If
+     End If
+End Property
+
+Public Property Get IExpediter_Log() As Boolean
+    IExpediter_Log = gbLog
+End Property
+
+'*****************
+'Public Methods
+'*****************
+
+Public Sub IExpediter_SetProperties(ByVal bShow As Boolean, Optional ByVal bLog As Variant)
+Attribute IExpediter_SetProperties.VB_Description = "Sets properties in one method call."
+    '-------------------------------------------------------------------------
+    'Purpose:   To set the Logger properties in one method call
+    'Effects:   Sets the following properties to parameter values
+    '           Show, Log
+    '-------------------------------------------------------------------------
+    With Me
+        .IExpediter_Show = bShow
+        If Not IsMissing(bLog) Then .IExpediter_Log = bLog
+    End With
+End Sub
+
+Public Sub IExpediter_StopTest()
+Attribute IExpediter_StopTest.VB_Description = "Causes the Expediter to stop processing Service Request results and to empty its queue."
+    '-------------------------------------------------------------------------
+    'Purpose:   Call this to halt the Expediter and have its
+    '           collection of Service requests and their
+    '           respective CallBack objects removed
+    'Effects:
+    '           DestroyReferences may be called
+    '       [gbStopTest]
+    '           becomes true
+    '-------------------------------------------------------------------------
+    
+    gbStopTest = True
+    If Not gbBusy Then DestroyReferences
+End Sub
+
+Public Sub IExpediter_StartTest()
+Attribute IExpediter_StartTest.VB_Description = "Prepares the Expediter to process Service Request results after StopTest has been called."
+    '-------------------------------------------------------------------------
+    'Purpose:   Call this to allow processing of Services
+    '           after calling StopTest
+    'Effects:
+    '           Reinitialize values on U/I
+    '       [gcCallback]
+    '           Make sure it is a zero count collection
+    '       [gbStopTest]
+    '           becomes false
+    '       [frmExpediter.tmrExpediter]
+    '           becomes enabled
+    '-------------------------------------------------------------------------
+    glPeakBacklog = 0
+    glBacklog = 0
+    glTotalCallBacks = 0
+    With frmExpediter
+        .lblPeak = 0
+        .lblCount = 0
+        .lblBacklog = 0
+        .lblPeak.Refresh
+        .lblCount.Refresh
+        .lblBacklog.Refresh
+    End With
+    gbStopTest = False
+    DisplayStatus ""
+    Set gcCallBack = Nothing
+    Set gcCallBack = New Collection
+    If Not goQueueDelegator Is Nothing Then frmExpediter.tmrExpediter.Interval = giTIMER_INTERVAL
+End Sub
+
+Public Function IExpediter_GetEventObject() As Object
+    Set IExpediter_GetEventObject = New EventReturn
+End Function
+
+'********************
+'Private Procedures
+'********************
+
+Private Sub Class_Initialize()
+    '-------------------------------------------------------------------------
+    'Purpose:   If this is the first instance, initialize the whole application
+    '           Set defaults and create needed objects
+    'Effects:
+    '       [glInstances]
+    '           iterated once to count instances
+    '-------------------------------------------------------------------------
+    'Count how many times this class is instanced
+    'to react to the first instance or the release
+    'of the last instance.
+    On Error GoTo Class_InitializeError
+    glInstances = glInstances + 1
+    If glInstances = 1 Then
+        App.OleServerBusyRaiseError = True
+        App.OleServerBusyTimeout = 10000
+        gbUnloading = False
+        'Set default property values
+        'Create Logger class object if gbLog is true
+        If gbLog Then Set goLogger = CreateObject("AELogger.Logger")
+        gbShow = gbSHOW_FORM_DEFAULT
+        gbLog = gbLOG_DEFAULT
+        'Create gcCallBack collection
+        Set gcCallBack = New Collection
+        'Load frmExpediter because it has a timer
+        Load frmExpediter
+        'Only show the form if gbShow is true
+        If gbShow Then frmExpediter.Show
+    End If
+    Exit Sub
+Class_InitializeError:
+    LogError Err, 0
+    Resume Next
+End Sub
+
+Private Sub Class_Terminate()
+    '-------------------------------------------------------------------------
+    'Purpose:   If this is the last termination unload form and destroy objects
+    'Effects:
+    '       [glInstances]
+    '           decrease once to count instances
+    '-------------------------------------------------------------------------
+    'Count how many times this class is instanced
+    'so subtract one every terminate event
+    'If the last terminate event is occuring
+    'make sure forms are unloaded and objects
+    'are released
+    On Error GoTo Class_TerminateError
+    glInstances = glInstances - 1
+    If glInstances = 0 Then
+        gbUnloading = True
+        IExpediter_StopTest
+    End If
+    Exit Sub
+Class_TerminateError:
+    LogError Err, 0
+    Resume Next
+End Sub
+
+
+

build-env/VisualStudio6/Common/Tools/APE/Source/Aeexpdtr/FRMEXPDT.FRM

@@ -0,0 +1,254 @@
+VERSION 5.00
+Begin VB.Form frmExpediter 
+   BorderStyle     =   1  'Fixed Single
+   Caption         =   "Expediter"
+   ClientHeight    =   2175
+   ClientLeft      =   10575
+   ClientTop       =   4875
+   ClientWidth     =   3915
+   ClipControls    =   0   'False
+   Icon            =   "frmexpdt.frx":0000
+   LinkTopic       =   "Form1"
+   MaxButton       =   0   'False
+   ScaleHeight     =   2175
+   ScaleWidth      =   3915
+   StartUpPosition =   3  'Windows Default
+   Begin VB.ListBox lstLog 
+      Height          =   525
+      IntegralHeight  =   0   'False
+      Left            =   2880
+      TabIndex        =   0
+      Top             =   1350
+      Visible         =   0   'False
+      Width           =   525
+   End
+   Begin VB.Timer tmrExpediter 
+      Left            =   3420
+      Top             =   1620
+   End
+   Begin VB.Label lblCaption 
+      BackStyle       =   0  'Transparent
+      Caption         =   "Current Backlog"
+      BeginProperty Font 
+         Name            =   "MS Sans Serif"
+         Size            =   12
+         Charset         =   0
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   300
+      Index           =   0
+      Left            =   200
+      TabIndex        =   7
+      Top             =   120
+      Width           =   2535
+   End
+   Begin VB.Label lblCaption 
+      BackStyle       =   0  'Transparent
+      Caption         =   "Peak Backlog"
+      BeginProperty Font 
+         Name            =   "MS Sans Serif"
+         Size            =   12
+         Charset         =   0
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   300
+      Index           =   1
+      Left            =   200
+      TabIndex        =   6
+      Top             =   480
+      Width           =   2535
+   End
+   Begin VB.Label lblCaption 
+      BackStyle       =   0  'Transparent
+      Caption         =   "Total Callbacks"
+      BeginProperty Font 
+         Name            =   "MS Sans Serif"
+         Size            =   12
+         Charset         =   0
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   300
+      Index           =   2
+      Left            =   200
+      TabIndex        =   5
+      Top             =   840
+      Width           =   2535
+   End
+   Begin VB.Label lblBacklog 
+      BackStyle       =   0  'Transparent
+      BeginProperty Font 
+         Name            =   "MS Sans Serif"
+         Size            =   12
+         Charset         =   0
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   300
+      Left            =   2760
+      TabIndex        =   4
+      Top             =   120
+      Width           =   1095
+   End
+   Begin VB.Label lblPeak 
+      BackStyle       =   0  'Transparent
+      BeginProperty Font 
+         Name            =   "MS Sans Serif"
+         Size            =   12
+         Charset         =   0
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   300
+      Left            =   2760
+      TabIndex        =   3
+      Top             =   480
+      Width           =   1095
+   End
+   Begin VB.Label lblCount 
+      BackStyle       =   0  'Transparent
+      BeginProperty Font 
+         Name            =   "MS Sans Serif"
+         Size            =   12
+         Charset         =   0
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   300
+      Left            =   2760
+      TabIndex        =   2
+      Top             =   840
+      Width           =   1095
+   End
+   Begin VB.Label lblStatus 
+      BackStyle       =   0  'Transparent
+      BeginProperty Font 
+         Name            =   "MS Sans Serif"
+         Size            =   9.75
+         Charset         =   0
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   800
+      Left            =   200
+      TabIndex        =   1
+      Top             =   1200
+      Width           =   3450
+      WordWrap        =   -1  'True
+   End
+End
+Attribute VB_Name = "frmExpediter"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+
+Private Sub Form_Load()
+    '-------------------------------------------------------------------------
+    'Effects:
+    '       Position form and load captions from string resource
+    '-------------------------------------------------------------------------
+    'Use clsPositionForm object to move
+    'Form to settings saved in registry
+    Dim oPosition As clsPositionForm
+    Set oPosition = New clsPositionForm
+    
+    'Set the U/I values
+    ApplyFontToForm Me
+    Caption = LoadResString(giFORM_CAPTION)
+    lblCaption(0).Caption = LoadResString(giCURRENT_BACKLOG_CAPTION)
+    lblCaption(1).Caption = LoadResString(giPEAK_BACKLOG_CAPTION)
+    lblCaption(2).Caption = LoadResString(giTOTAL_CALLBACK_CAPTION)
+    
+    'Condition compile toggles between a debug
+    'mode that displays a list box with displaying
+    'all loggable events.
+    #If ccShowList Then
+        oPosition.Move Me, True
+        lstLog.Visible = True
+        lblStatus.Visible = False
+        lblBacklog.Visible = False
+        lblPeak.Visible = False
+        lblCount.Visible = False
+    #Else
+        oPosition.Move Me, False
+        Width = giDEFAULT_FORM_WIDTH
+        Height = giDEFAULT_FORM_HEIGHT
+    #End If
+End Sub
+
+Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
+    'If user unloads form cancel unload
+    Dim oPosition As clsPositionForm
+    'Use clsPositionForm object to save
+    'forms position in registry
+    Set oPosition = New clsPositionForm
+    If Me.Visible Then oPosition.Save Me
+    If UnloadMode = vbFormControlMenu And glInstances <> 0 Then
+        Cancel = True
+    End If
+
+End Sub
+
+Private Sub Form_Resize()
+    #If ccShowList Then
+        Dim lX As Long
+        Dim lY As Long
+        If Me.ScaleHeight >= 2 * glFORM_MARGIN Then lY = (Me.ScaleHeight - (2 * glFORM_MARGIN)) Else lY = (2 * glFORM_MARGIN) - Me.ScaleHeight
+        If Me.ScaleWidth >= 2 * glFORM_MARGIN Then lX = (Me.ScaleWidth - (2 * glFORM_MARGIN)) Else lX = (2 * glFORM_MARGIN) - Me.ScaleWidth
+        lstLog.Move glFORM_MARGIN, glFORM_MARGIN, lX, lY
+    #End If
+End Sub
+
+Private Sub tmrExpediter_Timer()
+    '-------------------------------------------------------------------------
+    'Effects:
+    '       Polls the QueueMgr for Service Results.  If any are received the
+    '       Expediter will attempt to call all the callbacks and deliver the
+    '       the results
+    '
+    '       If gbStopTest became true during this process DestroyReferences
+    '       will be called at end of procedure
+    '   [gbBusy]
+    '       Is true during procedure
+    '-------------------------------------------------------------------------
+    On Error GoTo tmrExpediter_Timer
+    'Exit if already entered this procedure
+    If gbBusy Or gbStopTest Then Exit Sub
+    gbBusy = True
+    If PollQueue Then
+        tmrExpediter.Interval = 0
+        DeliverResults
+    End If
+    If gbStopTest Then
+        'References to Expediter may have
+        'been destroyed while PollQueue or DeliverResults
+        'was busy.  If gbBusy was true when Expediter's references
+        'were destoyed, DestroyReferences needs called again to
+        'make sure logger and form is destroyed
+        DestroyReferences
+    End If
+    gbBusy = False
+    Exit Sub
+tmrExpediter_Timer:
+    LogError Err, 0
+    Exit Sub
+End Sub

build-env/VisualStudio6/Common/Tools/APE/Source/Aeexpdtr/MODEXPDT.BAS

@@ -0,0 +1,452 @@
+Attribute VB_Name = "modExpediter"
+Option Explicit
+'-------------------------------------------------------------------------
+'The project is the Expediter component of the Application Performance Explorer
+'The Expediter is a multi-use server that is instanced by the QueueMgr.
+'The Expediter pulls Service Results data and Callbacks objects from
+'the QueueMgr and then sends the Service Results using the Callback objects
+'
+'Key Files:
+'   frmExpdt.frm    Only form in this project
+'   CallbkRf.cls    Class used to store callback object and related
+'                   Service request data
+'   clsPosFm.cls    Class used to store Form position in registry
+'   Expeditr.cls    Multi-use creatable class provides OLE interface to app
+'-------------------------------------------------------------------------
+
+'Declares
+Declare Function GetTickCount Lib "Kernel32" () As Long
+
+'U/I captions resource string keys
+Public Const giFORM_CAPTION As Integer = 101
+Public Const giCURRENT_BACKLOG_CAPTION As Integer = 102
+Public Const giPEAK_BACKLOG_CAPTION As Integer = 103
+Public Const giTOTAL_CALLBACK_CAPTION As Integer = 104
+
+'Constants
+Public Const gbSHOW_FORM_DEFAULT As Boolean = False
+Public Const gbLOG_DEFAULT As Boolean = False
+Public Const glMAX_COUNT As Long = 2147483647        'max size of long data type
+Public Const giMAX_ALLOWED_RETRIES As Integer = 500  'maximum number of times one object can be
+                                                     'called with call rejection before giving up
+Public Const giRETRIES_ALLOWED_BEFORE_MOVING_ON = 10 'Number of retries made on a callback before
+                                                     'it is skipped to try again later
+Public Const giRETRY_WAIT_MIN As Integer = 500       'Retry Wait is measure in DoEvent cyles
+Public Const giRETRY_WAIT_MAX As Integer = 2500
+Public Const giTIMER_INTERVAL As Integer = 1000
+
+'Message Constants, resourse string
+Public Const giCALLBACK_CALLED As Integer = 4
+Public Const giEXPEDITER_NAME As Integer = 5
+Public Const giCALLING_CALLBACK As Integer = 7
+Public Const giSTOP_TEST_RECEIVED As Integer = 8
+Public Const giCALL_REJECTED_RETRIES_EXHAUSTED As Integer = 9
+Public Const giRETRY_CALLBACK As Integer = 10
+Public Const giGETRESULTS_CALLED_WITH_RETURN = 11
+Public Const giCOULD_NOT_FIND_SYNC_OBJECT = 12
+Public Const giERROR_PREFIX = 13
+Public Const giFONT_CHARSET_INDEX As Integer = 30
+Public Const giFONT_NAME_INDEX As Integer = 31
+Public Const giFONT_SIZE_INDEX  As Integer = 32
+
+'Public Variables
+
+Public gbShow As Boolean                    'If true show form
+Public glInstances As Long                  'Count of created instances of Expediter Class
+Public gcCallBack As Collection             'Collection of CallBackRef class
+Public gbLog As Boolean                     'If true log Service
+Public goLogger As APEInterfaces.ILogger          'Logger class object
+Public goQueueDelegator As APEInterfaces.IQueueDelegator 'QueueMgr object
+Public gbStopTest As Boolean                'Flag used to stop processing
+Public glBacklog As Long                    'The current number of Callbacks ready to be called
+Public glPeakBacklog As Long                'The largest that of Callbacks that were ready to be
+                                            'called has been as once
+Public glTotalCallBacks As Long             'The total number of Callbacks made
+Public gbBusy As Boolean                    'If true in frmExpediter.tmrExpediter.Timer event
+Public gbUnloading As Boolean               'If true Class_Terminate of Expediter has been entered
+
+Sub Main()
+End Sub
+
+Public Function PollQueue() As Boolean
+    '-------------------------------------------------------------------------
+    'Purpose:   Get Service Results and corresponding Callback objects from the
+    '           QueueMgr
+    'Return:    True if one or more Service Result was received from the QueueMgr
+    'Assumes:
+    '   [goQueueDelegator]
+    '           is a valid AEQueueMgr.QueueDelegator object
+    '   [gcCallback]
+    '           is a valid collection object
+    'Effects:
+    '   [gcCallback]
+    '           A CallBkRf object will be added for every Service Result received
+    '           from the QueueMgr.
+    '-------------------------------------------------------------------------
+    Dim vaResults As Variant    'Variant array that will be received from call
+                                'to the QueueMgr.  Two dimensions: first dimension
+                                'is fixed each index representing a Service Result
+                                'element; the second dimension each index represents
+                                'one Service result.  See index constants in
+                                'modAEConstants
+    Dim lCount As Long          'Counter used to loop through indexes of the
+                                'arrays second dimension
+    Dim oCallBkRef As CallBackRef   'Object to store service results in and add
+                                    'to gcCallback
+    Dim bReturn As Boolean          'Value to be returned by this function
+    Dim lUB As Long             'Ubound
+    
+    On Error GoTo PollQueueError
+    bReturn = False
+    
+    'Call the QueueMgr
+    vaResults = goQueueDelegator.GetServiceResults
+    
+    'Check to see if results were returned
+    If VarType(vaResults) = vbArray + vbVariant Then
+        'Results were returned
+        bReturn = True
+        LogEvent giGETRESULTS_CALLED_WITH_RETURN, 0
+        'Put each service result in a CallBackRef object
+        'and at it to the gcCallback collection
+        lUB = UBound(vaResults, 2)
+        For lCount = 0 To lUB
+            Set oCallBkRef = New CallBackRef
+            With oCallBkRef
+                .ServiceID = vaResults(giRESULT_ID_ELEMENT, lCount)
+                If vaResults(giRESULT_CALLBACK_TYPE_ELEMENT, lCount) = giRETURN_BY_SYNC_EVENT Then
+                    .UseSyncEvent = True
+                    Set .SyncObject = vaResults(giRESULT_CALLBACK_ELEMENT, lCount)
+                Else
+                    .UseSyncEvent = False
+                    Set .Object = vaResults(giRESULT_CALLBACK_ELEMENT, lCount)
+                End If
+                .Error = vaResults(giRESULT_ERROR_ELEMENT, lCount)
+                'Check what data type the data element is
+                'in order to determine how to handle it
+                Select Case VarType(vaResults(giRESULT_DATA_ELEMENT, lCount))
+                    Case vbEmpty, vbNull
+                        .Result = Null
+                    Case vbObject, vbError, vbDataObject
+                        Set .Result = vaResults(giRESULT_DATA_ELEMENT, lCount)
+                    Case Else
+                        .Result = vaResults(giRESULT_DATA_ELEMENT, lCount)
+                End Select
+            End With
+            gcCallBack.Add oCallBkRef
+            Set oCallBkRef = Nothing
+        Next
+        'Update Expediter U/I
+        glBacklog = glBacklog + lUB + 1
+        If glBacklog > glPeakBacklog Then
+            glPeakBacklog = glBacklog
+        End If
+        If gbShow Then
+            With frmExpediter
+                .lblBacklog.Caption = glBacklog
+                .lblPeak = glPeakBacklog
+                .lblBacklog.Refresh
+                .lblPeak.Refresh
+            End With
+        End If
+    End If
+    PollQueue = bReturn
+    Exit Function
+PollQueueError:
+    Dim iRetry As Integer
+    Dim il As Integer
+    Dim ir As Integer
+    Select Case Err.Number
+        Case RPC_E_CALL_REJECTED
+            'Collision error, the OLE server is busy
+            'First check for stop test
+            If gbStopTest Then Exit Function
+            If iRetry < giRETRIES_ALLOWED_BEFORE_MOVING_ON Then
+                iRetry = iRetry + 1
+                ir = Int((giRETRY_WAIT_MAX - giRETRY_WAIT_MIN + 1) * Rnd + giRETRY_WAIT_MIN)
+                For il = 0 To ir
+                    DoEvents
+                    If gbStopTest Then Exit For
+                Next il
+                'Stop test may have been called during doevents loop
+                If gbStopTest Then Exit Function Else Resume
+            End If
+        Case Else
+            LogError Err, 0
+    End Select
+    PollQueue = bReturn
+End Function
+
+Public Sub DeliverResults()
+    '-------------------------------------------------------------------------
+    'Purpose:   Try to make calls to Callback objects, to deliver Service Results
+    '           to the corresponding Callback objects.  After all callback are
+    '           at least attempted to be called, call PollQueue to get more
+    '           Service Results.  Try to make calls to all the new Callback
+    '           objects.  Continue cycle until the QueueMgr does not return
+    '           new Service Results.  If the cycle is broken because the QueueMgr
+    '           did not return Service Results, start the timer so that it
+    '           will poll the QueueMgr until ServiceResults are obtained
+    'Assumes:
+    '   [gcCallback]
+    '           is a valid collection object
+    '   [oCallBkRf.Object]
+    '           has a valid Callback method
+    'Effects:
+    '   [gcCallback]
+    '           Is decreased by one CallBkRf object every time a callback is
+    '           successfully made.
+    '           After polling the QueueMgr the count will increment for every
+    '           received Service Result.
+    '-------------------------------------------------------------------------
+    Dim oCallBkRf As CallBackRef    'Object for storing Service Result data and
+                                    'its callback
+    Dim lCurrentIndex As Long       'Index of oCallBkRf in gcCallBack currently
+                                    'being processed
+    Dim sCurrentID As String         'Current Service ID being processed
+                                    'used for reporting and logging errors
+    Dim bResult As Boolean          'Result from Calling PollQueue
+    Dim iRetry As Integer           'Number of retries made to call a specific
+                                    'object using a resume statement
+    On Error GoTo DeliverResultsError
+    lCurrentIndex = 1
+    
+TryNextCallback:
+    Do While lCurrentIndex <= gcCallBack.Count And Not gbStopTest
+        Set oCallBkRf = gcCallBack.Item(lCurrentIndex)
+        sCurrentID = oCallBkRf.ServiceID
+        'Call Callback object
+        LogEvent giCALLING_CALLBACK, sCurrentID
+        iRetry = 0
+        If oCallBkRf.UseSyncEvent Then
+            oCallBkRf.SyncObject.RaiseServiceResult sCurrentID, oCallBkRf.Result, oCallBkRf.Error
+        Else
+            oCallBkRf.Object.CallBack sCurrentID, oCallBkRf.Result, oCallBkRf.Error
+        End If
+        LogEvent giCALLBACK_CALLED, sCurrentID
+        'Explicitely set callback object to nothing
+        Set oCallBkRf.Object = Nothing
+        Set gcCallBack.Item(lCurrentIndex).Object = Nothing
+        gcCallBack.Remove lCurrentIndex
+        
+        'Update Expediter U/I
+        glBacklog = glBacklog - 1
+        glTotalCallBacks = glTotalCallBacks + 1
+        If gbShow Then
+            With frmExpediter
+                .lblBacklog.Caption = glBacklog
+                .lblCount.Caption = glTotalCallBacks
+                .lblBacklog.Refresh
+                .lblCount.Refresh
+            End With
+        End If
+            
+        'Loop without iterating lCurrentIndex because the lCurrentIndex item
+        'will be replaced by one above it after it is removed.
+        'lCurrentIndex is only iterated by Error Handling, which will move
+        'the process on to another callback after a few retries.
+    Loop
+    
+    'After going through the whole gcCallBack collection
+    'Poll the queuemgr trying to get more ServiceResults
+    'Go back to the top of the Loop using index 1 if
+    'there are items in gcCallBack after Polling the QueueMgr
+    bResult = PollQueue
+    lCurrentIndex = 1
+    'Got to top of loop if there are any items in gcCallBack
+    'Do not use the result of the PollQueue function because
+    'even if the QueueMgr did not return results there may
+    'be items in gcCallBack representing exhausted Callbacks
+    'that need to be tried again.
+    If gcCallBack.Count > 0 And Not gbStopTest Then GoTo TryNextCallback
+    
+    'Before exiting the function start the timer
+    'so that the Expediter will keep polling the QueueMgr
+    frmExpediter.tmrExpediter.Interval = giTIMER_INTERVAL
+    Exit Sub
+
+DeliverResultsError:
+    Dim il As Integer
+    Dim ir As Integer
+    Select Case Err.Number
+        Case RPC_E_CALL_REJECTED
+               'Collision error, the OLE server is busy
+               'First check for stop test
+               If gbStopTest Then Exit Sub
+               If iRetry < giRETRIES_ALLOWED_BEFORE_MOVING_ON Then
+                   'Iterate the object's retry count
+                   oCallBkRf.CallAttempts = oCallBkRf.CallAttempts + 1
+                   'Iterate the number of try's make with Resume
+                   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 giRETRY_CALLBACK, sCurrentID
+                   Resume
+               Else
+                    'We reached our max retries either move on
+                    'to the next object in the collection leaving this
+                    'object to be tried again later or remove the object
+                    'because this object was had too many callattempts on
+                    'it specifically.
+                    If oCallBkRf.CallAttempts >= giMAX_ALLOWED_RETRIES Then
+                        'Give up trying to call this particulary object
+                        'it will be removed at the end of Select Case block
+                        'Since it is being removed do not iterate the lCurrenIndex
+                        LogEvent giCALL_REJECTED_RETRIES_EXHAUSTED, sCurrentID
+                        DisplayStatus LoadResString(giCALL_REJECTED_RETRIES_EXHAUSTED)
+                    Else
+                        'Iterate the lCurrentIndex and do not remove this
+                        'object.  It will be reattempted later
+                        lCurrentIndex = lCurrentIndex + 1
+                        Resume TryNextCallback
+                    End If
+               End If
+        Case ERR_OVER_FLOW
+            glTotalCallBacks = 0
+            LogError Err, sCurrentID
+            Resume Next
+        Case ERR_CALL_FAILED_DIDNOT_EXECUTE
+            LogError Err, sCurrentID
+        Case Else
+            LogError Err, sCurrentID
+    End Select
+    On Error Resume Next
+    'Explicitely set callback object to nothing
+    Set oCallBkRf.Object = Nothing
+    Set gcCallBack.Item(lCurrentIndex).Object = Nothing
+    gcCallBack.Remove lCurrentIndex
+    Exit Sub
+End Sub
+
+Public Sub LogEvent(intMessage As Integer, sServiceID As String)
+    '-------------------------------------------------------------------------
+    'Purpose:   Receives Message key which is used to look
+    '           up a resource string.  The logrecord is sent to the
+    '           Logger object if gbLog is true
+    'In:        [intMessage]
+    '               A valid Resource string key for the message to be logged
+    '           [sServiceID]
+    '               Service Request ID to be logged
+    'Assumption:
+    '           If gbLog is true then goLogger is a valid reference to
+    '           AELogger.Logger class object
+    '-------------------------------------------------------------------------
+    
+    On Error GoTo LogEventError
+    If gbLog And Not gbStopTest Then
+        goLogger.Record LoadResString(giEXPEDITER_NAME), sServiceID, LoadResString(intMessage), GetTickCount()
+    End If
+    'If the form is visible display log on form
+    #If ccShowList Then
+        DisplayString sServiceID & gsSEPERATOR & LoadResString(intMessage)
+    #End If
+    Exit Sub
+LogEventError:
+    Select Case Err.Number
+        Case RPC_E_CALL_REJECTED
+               'Collision error, the OLE server is busy
+               Dim iRetry As Integer
+               Dim il As Integer
+               Dim ir As Integer
+               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
+                   Resume
+               Else
+                   'We reached our max retries
+                   'This would occur when clients are sending
+                   'there logs
+                   LogError Err, sServiceID
+                   Exit Sub
+               End If
+        Case Else
+            LogError Err, sServiceID
+            Exit Sub
+    End Select
+    Exit Sub
+End Sub
+
+Public Sub LogError(ByVal oErr As ErrObject, sServiceID As String)
+    '-------------------------------------------------------------------------
+    'Purpose:   Display error description on forms Status box if the form is
+    '           visible; log error if logging is on
+    'In:        [oErr]
+    '               Valid error object
+    '           [sServiceID]
+    '               Service Request ID logged with the error message
+    'Assumption:
+    '           If gbShow is true the form is loaded and visible
+    '           If gbLog is true the goLogger is a valid AELogger.Logger class
+    '               object
+    '-------------------------------------------------------------------------
+    
+    Dim s As String
+    s = LoadResString(giERROR_PREFIX) & Str$(oErr.Number) & gsSEPERATOR & oErr.Source & gsSEPERATOR & oErr.Description
+    #If ccShowList Then
+        If Not gbShow Then
+            frmExpediter.Show
+            gbShow = True
+        End If
+        DisplayString s
+    #Else
+        If Err.Number <> 0 Then DisplayStatus oErr.Description
+    #End If
+    If gbLog And glInstances <> 0 Then
+        goLogger.Record LoadResString(giEXPEDITER_NAME), sServiceID, s, GetTickCount()
+    End If
+    Exit Sub
+End Sub
+
+Sub DisplayStatus(s As String)
+    '-------------------------------------------------------------------------
+    'Purpose:   If gbShow is true, displays passed string on forms status box
+    'Assumes:   If gbShow is true, form is loaded and visible
+    '-------------------------------------------------------------------------
+    If gbShow Then AlignTextToBottom frmExpediter.lblStatus, s
+End Sub
+
+Sub DisplayString(sText As String)
+    '-------------------------------------------------------------------------
+    'Purpose:   Adds the passed text to to the list box.  Only used if conditional
+    '           compile ccShowList is true.
+    'Assumes:   If gbShow is true, form is visible
+    '           If ccShowList is true, lstLog is visible and positioned
+    '-------------------------------------------------------------------------
+    'Controls the length of the list box
+    'and adds items to the top
+    #If ccShowList Then
+        Dim lstLog As ListBox
+        If gbShow Then
+            Set lstLog = frmExpediter.lstLog
+            If lstLog.ListCount = glLIST_BOX_MAX Then lstLog.Clear
+            lstLog.AddItem sText, 0
+            DoEvents
+        End If
+    #End If
+End Sub
+
+Sub DestroyReferences()
+    '-------------------------------------------------------------------------
+    'Purpose:   Called by in the event of a StopTest call
+    '           to destroy callback objects
+    '-------------------------------------------------------------------------
+    
+    Dim oCallback As CallBackRef
+    LogEvent giSTOP_TEST_RECEIVED, 0
+    frmExpediter.tmrExpediter.Interval = 0
+    For Each oCallback In gcCallBack
+        Set oCallback.Object = Nothing
+    Next
+    Set gcCallBack = Nothing
+    Set gcCallBack = New Collection
+    Set goQueueDelegator = Nothing
+    If gbUnloading Then
+        If gbLog Then Set goLogger = Nothing
+        Unload frmExpediter
+    End If
+End Sub

build-env/VisualStudio6/Common/Tools/APE/Source/Aeexpdtr/SYNCRTRN.CLS

@@ -0,0 +1,28 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0   'False
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+END
+Attribute VB_Name = "EventReturn"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True
+Attribute VB_Description = "APE Expediter Event Return Interface"
+Option Explicit
+
+'******************
+'Events
+'******************
+Public Event ServiceResult(ByVal sServiceID As String, ByVal vServiceReturn As Variant, ByVal sServiceError As String)
+Attribute ServiceResult.VB_Description = "Returns a Service Request result"
+
+'*******************
+'Friend methods
+'*******************
+Friend Sub RaiseServiceResult(sServiceID As String, vServiceReturn As Variant, sServiceError As String)
+    RaiseEvent ServiceResult(sServiceID, vServiceReturn, sServiceError)
+End Sub
+

build-env/VisualStudio6/Common/Tools/APE/Source/Aeinclud/CLSPOSFM.CLS

@@ -0,0 +1,231 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0   'False
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+END
+Attribute VB_Name = "clsPositionForm"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+'-------------------------------------------------------------------------
+'This class must be used with modPositionForm which supplys
+'declarations, and types
+'This class is intended to be used with any Automation Explorer application
+'for saving form positions in the registry
+'and moving forms back to that position when loaded again
+'If more than one form of the same name is loaded, cascading
+'will occur only in relationship with each other.
+'Use Move method on form_load event
+'Use Save method on form_unload event
+'To use this class with a application that is not
+'apart of the Automation Explorer project change the
+'constant msPROJECT_NAME
+'-------------------------------------------------------------------------
+
+#If UNICODE Then
+    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameW" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
+    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextW" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
+#Else
+    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
+    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
+#End If
+Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
+Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
+Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
+
+'Types
+Private Type RECT
+        Left As Long
+        Top As Long
+        Right As Long
+        Bottom As Long
+End Type
+
+'Public Constants
+Private Const GW_HWNDNEXT As Integer = 2
+Private Const GW_HWNDFIRST As Integer = 0
+Private Const SM_CYBORDER As Integer = 6
+Private Const SM_CYCAPTION As Integer = 4
+Private Const msSECTION_NAME As String = "Form Positions"
+
+Public Sub Move(frmNew As Form, bSize As Boolean, Optional sComparableCharacters As String = "", Optional sngDefaultWidth As Single = 0, Optional sngDefaultHeight As Single = 0)
+    '-------------------------------------------------------------------------
+    'Purpose:   This method moves the passed form to the position saved
+    '           in the registry.  It also cascades the forms position from
+    '           the first form it finds with the same caption or that contains
+    '           vComparableCharachters at the beginning of the caption.
+    'IN:
+    '   [frmNew]
+    '           Form to position
+    '   [bSize] If true also size the passed form
+    '   [sComparableCharacters]
+    '           String to compare to other form captions for cascading instead
+    '           of passed forms captions.  If "Client" was passed, forms with
+    '           captions "Client - 1", "Client - 2", "Client - N" would be compared
+    '-------------------------------------------------------------------------
+    Dim sWinName As String  'Window caption
+    Dim sWinClass As String 'Window class
+    Dim sDefault As String  'Default position of form in string format
+    Dim sReturn As String   'Saved positon of form in string format
+    Dim lResult As Long
+    Dim lHwnd As Long, hWndNew As Long
+    Dim tRect As RECT
+    Dim lFactor As Long     'Factor for cascading form
+    Dim iPos1 As Integer    'Position one in string
+    Dim iPos2 As Integer    'Position two in string
+    Dim lState As Long      'Window state
+    Dim sngLeft As Single
+    Dim sngTop As Single
+    Dim sngWidth As Single
+    Dim sngHeight As Single
+    Dim lDefaultX As Long
+    Dim lDefaultY As Long
+    Dim sngScreenWidth As Single
+    
+    On Error Resume Next
+    If sComparableCharacters = "" Then sComparableCharacters = frmNew.Caption
+    'Create the default string
+    If Not (sngDefaultWidth = 0) Then lDefaultX = sngDefaultWidth Else lDefaultX = giDEFAULT_FORM_WIDTH
+    If Not (sngDefaultHeight = 0) Then lDefaultY = sngDefaultHeight Else lDefaultY = giDEFAULT_FORM_HEIGHT
+    sDefault = CStr(-1) & "," & CStr(-1) & "," & CStr(lDefaultX) & "," & CStr(lDefaultY) & "," & CStr(vbNormal) & ",1"
+    sReturn = GetRegSetting(gsREGISTRY_KEY, msSECTION_NAME, frmNew.Name, sDefault)
+    'Parse values from returned string "left, top, width, height, state"
+    iPos1 = InStr(sReturn, ",")
+    sngLeft = CSng(Left$(sReturn, (iPos1 - 1)))
+    iPos2 = InStr((iPos1 + 1), sReturn, ",")
+    sngTop = CSng(Mid$(sReturn, (iPos1 + 1), (iPos2 - 1 - iPos1)))
+    iPos1 = iPos2
+    iPos2 = InStr((iPos1 + 1), sReturn, ",")
+    sngWidth = CSng(Mid$(sReturn, (iPos1 + 1), (iPos2 - 1 - iPos1)))
+    iPos1 = iPos2
+    iPos2 = InStr((iPos1 + 1), sReturn, ",")
+    sngHeight = CSng(Mid$(sReturn, (iPos1 + 1), (iPos2 - 1 - iPos1)))
+    iPos1 = iPos2
+    iPos2 = InStr((iPos1 + 1), sReturn, ",")
+    lState = CSng(Mid$(sReturn, (iPos1 + 1), (iPos2 - 1 - iPos1)))
+    sngScreenWidth = CLng(Right$(sReturn, Len(sReturn) - iPos2))
+    'If this is not the first instance or if more than one form
+    'is loaded find a handle to the next window
+    'in the z-order with the same class name and window text
+    'move the change the coordinates to one's that represent
+    'a cascaded position in relation
+    'ship to the next window
+    sWinName = frmNew.Caption
+    hWndNew = frmNew.hWnd
+    sWinClass = Space$(255)
+    lResult = GetClassName(hWndNew, sWinClass, 255)
+    sWinClass = Left$(sWinClass, lResult)
+    'Perform a loop checking previous windows in z-order
+    'until window with same title and class name is found
+    'or hwnd = 0
+    lHwnd = GetWindow(hWndNew, GW_HWNDFIRST)
+    Do Until lHwnd = 0
+        If lHwnd <> hWndNew Then
+            'check the window's class name
+            sReturn = Space$(255)
+            lResult = GetClassName(lHwnd, sReturn, 255)
+            sReturn = Left$(sReturn, lResult)
+            If sReturn = sWinClass Then
+                'check the window's title
+                sReturn = Space$(255)
+                lResult = GetWindowText(lHwnd, sReturn, 255)
+                sReturn = Left$(sReturn, lResult)
+                If Left$(sReturn, Len(sComparableCharacters)) = Left$(sWinName, Len(sComparableCharacters)) Then
+                    'Get the windows position and calculate
+                    'the position for the new window
+                    lResult = GetWindowRect(lHwnd, tRect)
+                    'Get the system size of title bar and border
+                    lFactor = GetSystemMetrics(SM_CYBORDER) + GetSystemMetrics(SM_CYCAPTION)
+                    'If cascaded position will not put the form
+                    'off the screen change the left and top position
+                    'to represent a cascaded position
+                    'else leave the coordinates equal to what
+                    'was retrieved from the registry
+                    If Not ((tRect.Left + lFactor) * Screen.TwipsPerPixelX) + sngWidth > Screen.Width Then sngLeft = (tRect.Left + lFactor) * Screen.TwipsPerPixelX
+                    If Not ((tRect.Top + lFactor) * Screen.TwipsPerPixelY) + sngHeight > Screen.Height Then sngTop = (tRect.Top + lFactor) * Screen.TwipsPerPixelY
+                    Exit Do
+                End If
+            End If
+        End If
+        ' Get the next window in the z-order for the next loop
+        lHwnd = GetWindow(lHwnd, GW_HWNDNEXT)
+    Loop
+    'If the screen width is less than
+    'when form position was saved, do not
+    'position form according to saved position,
+    'because the saved position and size may be off
+    'the screen.  Instead, let form be positioned to windows
+    'default.
+    If sngScreenWidth <= Screen.Width Then
+        'If the passed bSize flag is true
+        'size and move, else just move
+        If sngTop <> -1 Then frmNew.Top = sngTop
+        If sngLeft <> -1 Then frmNew.Left = sngLeft
+        If bSize Then
+            frmNew.Width = sngWidth
+            frmNew.Height = sngHeight
+        End If
+    Else
+        'Apply default width and height
+        If bSize Then
+            If sngDefaultWidth <> 0 Then frmNew.Width = sngDefaultWidth
+            If sngDefaultHeight <> 0 Then frmNew.Height = sngDefaultHeight
+        End If
+    End If
+    frmNew.WindowState = lState
+End Sub
+
+
+Public Sub Save(frmSave As Form)
+    '-------------------------------------------------------------------------
+    'Purpose:   This method saves the forms size and position in the registry
+    '           using the form name as the label and string format
+    '           "left, top, width, height
+    'IN:
+    '   [frmSave]
+    '           Form to save position of
+    'Effects:   The Forms position is saved to the registry
+    '-------------------------------------------------------------------------
+    Dim iPos1 As Integer    'Position one in string
+    Dim iPos2 As Integer    'Position two in string
+    Dim sngLeft As Single
+    Dim sngTop As Single
+    Dim sngWidth As Single
+    Dim sngHeight As Single
+    Dim sDefault As String  'Default position of form in string format
+    Dim sReturn As String   'Saved positon of form in string format
+    Dim lState As Long
+    Dim sngScreenWidth As Single
+    If frmSave.WindowState = vbNormal Then
+        sReturn = CStr(frmSave.Left) & "," & CStr(frmSave.Top) & "," & CStr(frmSave.Width) & "," & CStr(frmSave.Height) & "," & CStr(frmSave.WindowState) & "," & CStr(Screen.Width)
+    Else
+        'Read the current settings and then only change the Widowstate value
+        'and the screen width
+        'Create the default string
+        sDefault = CStr(-1) & "," & CStr(-1) & "," & CStr(giDEFAULT_FORM_WIDTH) & "," & CStr(giDEFAULT_FORM_HEIGHT) & "," & CStr(vbNormal) & ",1"
+        sReturn = GetRegSetting(gsREGISTRY_KEY, msSECTION_NAME, frmSave.Name, sDefault)
+        'Parse values from returned string "left, top, width, height, state"
+        iPos1 = InStr(sReturn, ",")
+        sngLeft = CSng(Left$(sReturn, (iPos1 - 1)))
+        iPos2 = InStr((iPos1 + 1), sReturn, ",")
+        sngTop = CSng(Mid$(sReturn, (iPos1 + 1), (iPos2 - 1 - iPos1)))
+        iPos1 = iPos2
+        iPos2 = InStr((iPos1 + 1), sReturn, ",")
+        sngWidth = CSng(Mid$(sReturn, (iPos1 + 1), (iPos2 - 1 - iPos1)))
+        iPos1 = iPos2
+        iPos2 = InStr((iPos1 + 1), sReturn, ",")
+        sngHeight = CSng(Mid$(sReturn, (iPos1 + 1), (iPos2 - 1 - iPos1)))
+        iPos1 = iPos2
+        iPos2 = InStr((iPos1 + 1), sReturn, ",")
+        lState = CSng(Mid$(sReturn, (iPos1 + 1), (iPos2 - 1 - iPos1)))
+        sngScreenWidth = CLng(Right$(sReturn, Len(sReturn) - iPos2))
+        sReturn = CStr(sngLeft) & "," & CStr(sngTop) & "," & CStr(sngWidth) & "," & CStr(sngHeight) & "," & CStr(frmSave.WindowState) & "," & CStr(sngScreenWidth)
+    End If
+    SaveRegSetting gsREGISTRY_KEY, msSECTION_NAME, frmSave.Name, sReturn
+    
+End Sub
+

build-env/VisualStudio6/Common/Tools/APE/Source/Aeinclud/CLSWKMAC.CLS

@@ -0,0 +1,29 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0   'False
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+END
+Attribute VB_Name = "clsWorkerMachines"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+'-------------------------------------------------------------------------
+'This class is used for storing related data
+'that will be added to a collection
+'Stores a Machine name that Workers are instanciated on
+'-------------------------------------------------------------------------
+Public MachineName As String        'Machine name
+Public WorkerProvider As APEInterfaces.IWorkerProvider    'Server that can be instanciated on remote
+                                    'machines to provide Worker objects
+Public Remote As Boolean            'If true, this represents a remote machine
+                                    'rather that the local machine.
+Public WorkerKeys As Collection     'Collection of longs, representing the keys
+                                    'of Workers stored in the gcWorkers collection
+                                    'that are on the machine represented by this
+                                    'object
+Private Sub Class_Initialize()
+    Set WorkerKeys = New Collection
+End Sub

build-env/VisualStudio6/Common/Tools/APE/Source/Aeinclud/CLSWORKR.CLS

@@ -0,0 +1,27 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0   'False
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+END
+Attribute VB_Name = "clsWorker"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+'-------------------------------------------------------------------------
+'This class is used for storing related data
+'that will be added to a collection
+'Stores a Worker object and data related to managing that Worker object
+'-------------------------------------------------------------------------
+Public ID As Long               'ID of the Worker, it should be the same
+                                'as the Workers ID property and the same
+                                'as the key an object of this class is stored
+                                'in gcWorkers collection with
+Public Busy As Boolean          'Worker is processing a Service Request
+Public Worker As APEInterfaces.IWorker    'A valid Worker class object
+Public RemoveMe As Boolean      'If true the Worker is marked for removal
+                                'from the PoolMgr's or QueueMgr's
+                                'collection of Workers

build-env/VisualStudio6/Common/Tools/APE/Source/Aeinclud/ENUMS.CLS

@@ -0,0 +1,155 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0   'False
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+END
+Attribute VB_Name = "Enums"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = True
+Option Explicit
+
+' APE Component Types
+Public Enum ape_ComponentTypes
+    ape_ctManager
+    ape_ctClient
+    ape_ctWorker
+    ape_ctService
+    ape_ctMTSService
+    ape_ctQueueManager
+    ape_ctPoolManager
+    ape_ctLogger
+    ape_ctServerManager
+End Enum
+
+'ClientOptions Dialog
+Public Enum ape_CliTestDurationOptions
+    ape_ictdUntilStopped = 0
+    ape_ictdNumCalls = 1
+    ape_ictdNumMinutes = 2
+End Enum
+
+Public Enum ape_CliLocalComponentOptions
+    ape_iclrLocalActiveX = 0
+    ape_iclrLocalJava = 1
+End Enum
+
+Public Enum ape_CliClientTypeOptions
+    ape_icatWinClient = 0
+    ape_icatWebClient = 1
+End Enum
+
+Public Enum ape_CliDataOptions
+    ape_icdtActiveResultSet = 0
+    ape_icdtUdtArray = 1
+    ape_icdtVarArray = 2
+    ape_icdtVarCollection = 3
+End Enum
+
+Public Enum ape_CliCallbackOptions
+    ape_icctOnlyOnce = 0
+    ape_icctEveryRequest = 1
+    ape_icctUseEventSinking = 2
+End Enum
+
+'Service Connection Options Dialog
+Public Enum ape_SvcConnOptions
+    ape_iscDCOM = 0
+    ape_iscASP = 1
+    ape_iscRA = 2
+End Enum
+
+Public Enum ape_SvcRaConnOptions
+    ape_iscrNetBIOS_TCP = 0
+    ape_iscrNetBIOS_SPX = 1
+    ape_iscrNetBIOS_NetBEUI = 2
+    ape_iscrTCPIP = 3
+    ape_iscrSPX = 4
+    ape_iscrNamedPipes = 5
+    ape_iscrDECnetTransport = 6
+    ape_iscrDatagram_UDP = 7
+    ape_iscrDatagram_IPX = 8
+End Enum
+
+'ServiceOptions Dialog
+Public Enum ape_SvcDbTaskOptions
+    ape_isdtMTS = 0
+    ape_isdtOLAP = 1
+    ape_isdtQuery = 2
+End Enum
+
+Public Enum ape_SvcPoolResOptions
+    ape_isprJobMngr = 0
+    ape_isprPoolMngr = 1
+End Enum
+
+Public Enum ape_SvcLanguageOptions
+    ape_islLangVB = 0
+    ape_islLangVC = 1
+    ape_islLangVJ = 2
+End Enum
+
+'Database Connection Options Dialog
+Public Enum ape_DbConnectionOptions
+    ape_idcADO = 0
+    ape_idcRDO = 1
+    ape_idcDAO = 2
+    ape_idcODBC = 3
+    ape_idcOracle = 4
+End Enum
+
+'DatabaseServerOptions Dialog
+Public Enum ape_DbServerOptions
+    ape_idsJet = 0
+    ape_idsSqlServer = 1
+    ape_idsOracle = 2
+    ape_idsOther = 3
+End Enum
+
+'AdminOptions Dialog
+Public Enum ape_AdmWhenToWriteLogOptions
+    ape_iawlEndOfTest = 0
+    ape_iawlLogSizeLimit = 1
+End Enum
+
+Public Enum ape_UpdateDisplayOptions
+    ape_udoAll = 0
+    ape_udoClient = 1
+    ape_udoServiceConnection = 2
+    ape_udoService = 3
+    ape_udoDatabaseConnection = 4
+    ape_udoDatabase = 5
+End Enum
+
+Public Enum ape_CallResultCodes
+    ape_retSuccess = 0
+    ape_retFailure
+    ape_retBadSendDataValues
+    ape_retBadReturnDataValues
+    ape_retInvalidParameter
+    ape_retPrevTestInProgress
+    ape_retInvalidCallbackObject
+End Enum
+
+' Error Codes
+Public Enum MTSSvcErrors
+    errAccountCreateFailed = vbObjectError + 1
+    errAccountTransactionFailed
+    errInsufficientFunds
+    errInvalidAccount
+    errDatabaseOperationFailed
+End Enum
+
+'Service component configuration
+Public Enum ServiceConfigurationInfomation
+    FirstMember
+    ape_conConnectionString
+    ape_conConnectionOption
+    ape_conLogMTSTransactions
+    ape_conShowMTSTransactions
+    ape_conLogDatabaseEvents
+    LastMember
+End Enum

build-env/VisualStudio6/Common/Tools/APE/Source/Aeinclud/LOCALIZE.BAS

@@ -0,0 +1,129 @@
+Attribute VB_Name = "Localize"
+Option Explicit
+'------------------------------------------------------------
+'- Localization Declares...
+'------------------------------------------------------------
+Private Declare Function GetSystemDefaultLCID Lib "Kernel32" () As Long
+
+'------------------------------------------------------------
+'- Localization Fonts Charicter sets...
+'------------------------------------------------------------
+Public Const CHARSET_DEFAULT = 1
+Public Const CHARSET_SHIFTJIS = 128
+Public Const CHARSET_HANGEUL = 129
+Public Const CHARSET_CHINESESIMPLIFIED = 134
+Public Const CHARSET_CHINESEBIG5 = 136
+Public Const CHARSET_HEBREW = 177
+Public Const CHARSET_ARABIC = 178
+
+'------------------------------------------------------------
+'  Primary language IDs.
+'------------------------------------------------------------
+Public Const LANG_ARABIC = &H1              ' added 10-14-97
+Public Const LANG_CHINESE = &H4
+Public Const LANG_HEBREW = &HD              ' added 10-14-97
+Public Const LANG_JAPANESE = &H11
+Public Const LANG_KOREAN = &H12
+
+'------------------------------------------------------------
+'  Sublanguage IDs.
+'------------------------------------------------------------
+'  The name immediately following SUBLANG_ dictates which primary
+'  language ID that sublanguage ID can be combined with to form a
+'  valid language ID.
+'------------------------------------------------------------
+Public Const SUBLANG_CHINESE_TRADITIONAL = &H1           ' Chinese (Taiwan)
+Public Const SUBLANG_CHINESE_SIMPLIFIED = &H2            ' Chinese (PR China)
+Public Const SUBLANG_KOREAN = &H1                        ' Korean (Extended Wansung) ' added 10-14-97
+Public Const SUBLANG_KOREAN_JOHAB = &H2                  ' Korean (Johab)            ' added 10-14-97
+
+Public Sub ApplyFontToForm(frmForm As Form)
+' Applies the appropriate font for the locale to all the controls of the specified form.
+    Dim ctl As Control
+    Dim sFont As String
+    Dim nFont As Integer, nCharset As Integer
+    
+    On Error Resume Next
+    GetFontInfo sFont, nFont, nCharset
+    For Each ctl In frmForm.Controls
+        ' If the control does not have Font property,
+        ' this line will be skipped.
+        With ctl.Font
+            .Name = sFont
+            .Size = nFont
+            .Charset = nCharset
+        End With
+    Next
+    With frmForm.Font
+        .Name = sFont
+        .Size = nFont
+        .Charset = nCharset
+    End With
+End Sub
+
+'-------------------------------------------------------
+Public Sub GetFontInfo(sFont As String, nFont As Integer, nCharset As Integer)
+'-------------------------------------------------------
+    Static ssFont As String                   ' the cached name of the font
+    Static snFont As Integer                  ' the cached size of the font
+    Static snCharset As Integer               ' the cached charset of the font
+
+    ' if font is set, used the cached values
+    If ssFont <> "" Then
+        sFont = ssFont
+        nFont = snFont
+        nCharset = snCharset
+        Exit Sub
+    End If
+'-------------------------------------------------------
+    Dim LCID    As Integer
+    Dim PLangId As Integer
+    Dim sLangId As Integer
+'-------------------------------------------------------
+    LCID = GetSystemDefaultLCID                 ' get current system LCID
+    PLangId = (LCID And &H3FF)               ' LCID's Primary language id
+    sLangId = (LCID / (2 ^ 10))                   ' LCID's Sub language id
+    
+    Select Case PLangId                         ' determine primary language id
+    Case LANG_CHINESE
+        If (sLangId = SUBLANG_CHINESE_TRADITIONAL) Then
+            sFont = ChrW$(&H65B0) & ChrW$(&H7D30) & ChrW$(&H660E) & ChrW$(&H9AD4)   ' New Ming-Li
+            nFont = 9
+            nCharset = CHARSET_CHINESEBIG5
+        ElseIf (sLangId = SUBLANG_CHINESE_SIMPLIFIED) Then
+            sFont = ChrW$(&H5B8B) & ChrW$(&H4F53)
+            nFont = 9
+            nCharset = CHARSET_CHINESESIMPLIFIED
+        End If
+    Case LANG_JAPANESE
+        sFont = ChrW$(&HFF2D) & ChrW$(&HFF33) & ChrW$(&H20) & ChrW$(&HFF30) & _
+                ChrW$(&H30B4) & ChrW$(&H30B7) & ChrW$(&H30C3) & ChrW$(&H30AF)
+        nFont = 9
+        nCharset = CHARSET_SHIFTJIS
+    Case LANG_KOREAN
+        If (sLangId = SUBLANG_KOREAN) Then
+            sFont = ChrW$(&HAD74) & ChrW$(&HB9BC)
+        ElseIf (sLangId = SUBLANG_KOREAN_JOHAB) Then
+            sFont = ChrW$(&HAD74) & ChrW$(&HB9BC)
+        End If
+        nFont = 9
+        nCharset = CHARSET_HANGEUL
+    Case LANG_ARABIC
+        sFont = "Tahoma"
+        nFont = 8
+        nCharset = CHARSET_ARABIC
+    Case LANG_HEBREW
+        sFont = "Tahoma"
+        nFont = 8
+        nCharset = CHARSET_HEBREW
+    Case Else
+        sFont = "Tahoma"
+        nFont = 8
+        nCharset = CHARSET_DEFAULT
+    End Select
+    ssFont = sFont
+    snFont = nFont
+    snCharset = nCharset
+'-------------------------------------------------------
+End Sub
+'-------------------------------------------------------

build-env/VisualStudio6/Common/Tools/APE/Source/Aeinclud/MODAECON.BAS

@@ -0,0 +1,144 @@
+Attribute VB_Name = "modAEConstants"
+Option Explicit
+'-------------------------------------------------------------------------
+'This Module provides constants shared by multiple APE Components
+'-------------------------------------------------------------------------
+
+Public Const giDEFAULT_FORM_WIDTH  As Integer = 4000
+Public Const giDEFAULT_FORM_HEIGHT  As Integer = 2500
+Public Const giFORM_MARGIN As Integer = 75      'Used to size and position
+                                                'controls in a sizable form and keep
+                                                'consitency between forms
+Public Const giLIST_BOX_MAX As Integer = 1000   'Used to control the length of a list box
+
+Public Const gsLOG_FILE_EXTENSION As String = ".LOG"
+'Service command constants
+Public Const gsSERVICE_USE_PROCESSOR As String = "UseProcessor"
+Public Const gsSERVICE_DONT_USE_PROCESSOR As String = "DontUseProcessor"
+Public Const gsSERVICE_READ_DATA As String = "ReadData"
+Public Const gsSERVICE_WRITE_DATA As String = "WriteData"
+Public Const gsSERVICE_READWRITE_DATA As String = "ReadWriteData"
+Public Const gsSERVICE_WRITE_MTS_TRANSACTIONS As String = "WriteMTSTransactions"
+
+Public Const gsSERVICE_LIB_CLASS As String = "AEService.Service"
+Public Const glSERVICE_MAX_DURATION As Long = 60000             'The longest an Service is allowed to take
+Public Const giLOG_RECORD_KILOBYTES As Integer = 3  'Estimated number of log records in a KB
+
+'Record Constants
+Public Const giRECORD_NUMROWS As Integer = 0
+Public Const giRECORD_ROWSIZE As Integer = 1
+Public Const giRECORD_TASK_DURATION As Integer = 2
+Public Const giRECORD_SLEEP_PERIOD As Integer = 3
+Public Const giRECORD_CONTAINER_TYPE As Integer = 4
+Public Const giRECORD_DATABASE_QUERY As Integer = 5
+Public Const giRECORD_SERVICE_CONFIGURATION As Integer = 6
+Public Const giRECORD_DATA_BEGIN As Integer = 7
+
+'Return Container Constants
+Public Const giCONTAINER_TYPE_NULL As Integer = 0
+Public Const giCONTAINER_TYPE_VARRAY As Integer = 1
+Public Const giCONTAINER_TYPE_VCOLLECTION As Integer = 2
+Public Const giCONTAINER_TYPE_RECORDSET As Integer = 3
+
+Public Const gsSEPERATOR As String = " - "
+
+Public Const giMODEL_QUEUE As Integer = 0
+Public Const giMODEL_POOL As Integer = 1
+Public Const giMODEL_DIRECT As Integer = 2
+
+'Service Task Option bit field mask values
+Public Const giMASK_USE_DB_TASK As Integer = 2 ^ 0
+Public Const giMASK_WRITE_MTS_TRANSACTION As Integer = 2 ^ 1    ' Toggle bit - 0 => Perform database query
+Public Const giMASK_USE_CPU_TASK As Integer = 2 ^ 2
+
+'Test Duration mode constants
+Public Const giTEST_DURATION_CONTINUE As Integer = 0        'Continue the test until interupted by StopTest
+Public Const giTEST_DURATION_CALLS As Integer = 1           'Continue the test for specified number of calls
+Public Const giTEST_DURATION_TICKS As Integer = 2           'Continue the test for specified number of milliseconds
+
+'Return value of clsQueueDelegator.GetServiceRequest method that instructs Worker to
+'Close.  This is returned instead of Service Request Data
+Public Const giCLOSE_WORKER_NOW As Integer = -1
+
+'Log Record array elements
+'Represents the element definition of the first dimension
+'of a two dimensional array passed to the AEManager.clsExplorer
+'by clients and the logger
+Public Const giCOMPONENT_ELEMENT As Integer = 0
+Public Const giSERVICE_ELEMENT  As Integer = 1
+Public Const giCOMMENT_ELEMENT As Integer = 2
+Public Const giMILLI_SECONDS_ELEMENT As Integer = 3
+Public Const giLOG_ARRAY_DIMENSION_ONE As Integer = 3
+
+'Worker Property array elements
+'For passing properties from
+'ServerMgr to Manager
+Public Const giLOG_WORKER_ELEMENT As Integer = 0
+Public Const giEARLYBIND_SERVICES_ELEMENT As Integer = 1
+Public Const giPERSISTENT_SERVICES_ELEMENT As Integer = 2
+Public Const giPRELOAD_SERVICES_ELEMENT  As Integer = 3
+
+'Service Request Data array elements
+'For passing Service data from
+'QueueMgr to worker
+Public Const giSERVICE_ID_ELEMENT  As Integer = 0
+Public Const giCOMMAND_ELEMENT  As Integer = 1
+Public Const giSERVICE_DATA_ELEMENT As Integer = 2
+Public Const giDATA_PRESENT_ELEMENT As Integer = 3
+
+'Service Results Data array elements
+'For passing Service data from the
+'QueueMgr to the Expediter
+Public Const giRESULT_ID_ELEMENT As Integer = 0
+Public Const giRESULT_CALLBACK_ELEMENT As Integer = 1
+Public Const giRESULT_DATA_ELEMENT As Integer = 2
+Public Const giRESULT_ERROR_ELEMENT As Integer = 3
+Public Const giRESULT_CALLBACK_TYPE_ELEMENT As Integer = 4
+Public Const giRESULT_DIMENSION_ONE As Integer = 4
+
+'Performance Statistics array elements
+'Array returned by GetStatistics method
+'of AEClient.Client. Called by AEManager
+Public Const giNUM_CALLS_ELEMENT As Integer = 0
+Public Const giBEGIN_TICKS_ELEMENT  As Integer = 1
+Public Const giEND_TICKS_ELEMENT  As Integer = 2
+Public Const giSTAT_ARRAY_DIMENSION  As Integer = 2
+
+'RacReg GetAutoServerSettings array elements
+Public Const giREMOTE_ELEMENT As Integer = 1
+Public Const giADDRESS_ELEMENT  As Integer = 2
+Public Const giPROTOCOL_ELEMENT  As Integer = 3
+Public Const giAUTHENTICATION_ELEMENT  As Integer = 4
+Public Const giNET_OLE_ELEMENT As Integer = 5
+Public Const giFIRST_RACREG_ELEMENT  As Integer = 1
+Public Const giLAST_RACREG_ELEMENT  As Integer = 5
+
+'Callback mode keys
+Public Const giNO_CALLBACK As Integer = 0
+Public Const giUSE_PASSED_CALLBACK As Integer = 1
+Public Const giUSE_DEFAULT_CALLBACK As Integer = 2
+Public Const giRETURN_BY_SYNC_EVENT As Integer = 3
+
+'Resource String replacement tokens
+Public Const gsNUMBER_TOKEN As String = "<NUMBER>"
+Public Const gsNAME_TOKEN As String = "<NAME>"
+
+'Automation errors
+Public Const E_INVALIDARG = &H80070057
+Public Const E_NOTIMPL = &H80004001
+Public Const E_UNEXPECTED = &H8000FFFF
+
+' Miscellaneous constants
+Public Const gsODBC_INI_REG_KEY = "Software\ODBC\ODBC.INI"      ' Registry path to DSNs
+Public Const gsREGISTRY_KEY As String = "Software\Microsoft\VSEE\APE"
+Public Const gsNULL_SERVICE_ID As String = "-"      ' Null Service ID
+
+'MRU server name constants
+Public Const giMAX_MRU_SIZE As Integer = 8
+Public Const giMAX_REG_DATA_LENGTH As Integer = 200   ' Maximum length of registry data string
+Public Const glMAX_NAME_LENGTH As Long = 250   ' Max length for a server name
+Public Const CB_LIMITTEXT = &H141
+
+' Shared custom error constants
+Public Const giRPC_ERROR_ACCESSING_COLLECTION As Integer = 32740
+

build-env/VisualStudio6/Common/Tools/APE/Source/Aeinclud/MODAEGLB.BAS

@@ -0,0 +1,136 @@
+Attribute VB_Name = "modAEGlobals"
+Option Explicit
+
+'==================================================
+' Routine: ReplaceString
+'
+' Purpose: Replaces specified string in a target
+'          string with a new string
+' Arguments:
+'   sTarget: string to work on
+'   sSearch: string to replace in sTarget
+'   sNew: value to replace sSearch with
+' Outputs:
+'   Revised version of sTarget (Note: sTarget is
+'   NOT modified.)
+'==================================================
+Function ReplaceString(ByVal sTarget As String, sSearch As String, sNew As String) As String
+    Dim p As Integer
+    Do
+        p = InStr(sTarget, sSearch)
+        If p Then
+            sTarget = Left(sTarget, p - 1) + sNew + Mid(sTarget, p + Len(sSearch))
+        End If
+    Loop While p
+    ReplaceString = sTarget
+End Function
+
+'==================================================
+' Routine: Round
+'
+' Purpose: Converts the passed Single value to the
+'          nearest integer value
+'          In contrast to CInt or Clng which convert
+'          single values to the nearest even integer
+'==================================================
+Public Function Round(sngIn As Single) As Long
+    If (sngIn Mod 1) < 0.5 Then
+        Round = Fix(sngIn)
+    Else
+        Round = Fix(sngIn) + 1
+    End If
+End Function
+
+Public Function FormatPath(sPath As String) As String
+    '-------------------------------------------------------------------------
+    'Purpose:   Assures that the passed path has a "\" at the end of it
+    'IN:
+    '   [sPath]
+    '           a valid path name
+    'Return:    the same path with a "\" on the end if it did not already
+    '           have one.
+    '-------------------------------------------------------------------------
+    If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
+    FormatPath = sPath
+End Function
+
+Public Function GetArrayFromDelimited(sDelimited As String, sa() As String, Optional sDelimiter As String = ",") As Boolean
+    '-------------------------------------------------------------------------
+    'Purpose:   Fills the passed a single dimension string array with the
+    '           values in the specified delimited string.  Leading and trailing spaces are trimmed
+    '           from each substring before adding them to the array.
+    'IN:
+    '   [sDelimited]
+    '           Delimited string
+    '   [sDelimiter]
+    '           Delimiter
+    'Out:
+    '   [sa()]  Single dimension array that will be erased and redimensioned to
+    '           add values from delimited string
+    'Return:    True if any items were added to array, False if array was
+    '           left empty
+    '-------------------------------------------------------------------------
+    Dim l As Long, lCount As Long, lStart As Long, lEnd As Long, lDelimiterLength As Long
+    
+    lDelimiterLength = Len(sDelimiter)
+    If sDelimited = "" Then
+        Erase sa
+        GetArrayFromDelimited = False
+    Else
+        lCount = 0
+        lStart = 1 - lDelimiterLength
+        Do
+            lCount = lCount + 1
+            lStart = InStr(lStart + lDelimiterLength, sDelimited, sDelimiter)
+        Loop While lStart > 0
+        ReDim sa(0 To lCount - 1)
+        lStart = 1
+        For l = LBound(sa) To UBound(sa) - 1        ' Process all but the last item in the list
+            lEnd = InStr(lStart, sDelimited, sDelimiter)
+            Debug.Assert lEnd <> 0
+            sa(l) = Trim(Mid(sDelimited, lStart, lEnd - lStart))
+            lStart = lEnd + lDelimiterLength
+        Next
+        sa(l) = Trim(Mid(sDelimited, lStart))     ' Final string in the list
+        GetArrayFromDelimited = True
+    End If
+End Function
+
+Public Function GetDelimitedFromArray(sa() As String, Optional sDelimiter As String = ",") As String
+    '-------------------------------------------------------------------------
+    'Purpose:   Reads all the strings in the passed array and
+    '           creates a delimited string
+    'IN:
+    '   [sa()]
+    '           A single dimension string array
+    '   [sDelimiter]
+    '           Delimiter
+    'Returns:   a delimited string
+    '-------------------------------------------------------------------------
+    
+    Dim sString As String
+    Dim l As Long
+    
+    If Not ArrayHasElements(sa) Then
+        GetDelimitedFromArray = ""
+    Else
+        sString = ""
+        For l = LBound(sa) To UBound(sa)
+            sString = sString & sDelimiter & sa(l)      ' Always prepend delimiter (even to the first element)
+        Next
+        GetDelimitedFromArray = Mid(sString, Len(sDelimiter) + 1)   ' Drop the leading delimiter
+    End If
+End Function
+
+Public Function ArrayHasElements(ByVal v As Variant) As Boolean
+' Returns True if the specified variant contains an array that contains any elements, else returns False.
+    If Not IsArray(v) Then
+        ArrayHasElements = False
+    Else
+        Dim l As Long
+        On Error Resume Next
+        l = LBound(v)
+        ArrayHasElements = (Err.Number <> ERR_SUBSCRIPT_OUT_OF_RANGE)
+    End If
+End Function
+

build-env/VisualStudio6/Common/Tools/APE/Source/Aeinclud/MODVBERR.BAS

@@ -0,0 +1,66 @@
+Attribute VB_Name = "modVBErrors"
+Option Explicit
+'-------------------------------------------------------------------------
+'This Module provides VB4 Error constants
+'-------------------------------------------------------------------------
+
+'VB4 Errors
+Public Const ERR_RETURN_WITHOUT_GOSUB As Integer = 3                'Return without GoSub
+Public Const ERR_INVALID_PROCEDURE_CALL  As Integer = 5             'Invalid procedure call
+Public Const ERR_OVER_FLOW  As Integer = 6                          'Overflow
+Public Const ERR_OUT_OF_MEMORY  As Integer = 7                      'Out of memory
+Public Const ERR_SUBSCRIPT_OUT_OF_RANGE  As Integer = 9             'Subscript out of range
+Public Const ERR_ARRAY_FIXED_OR_LOCKED  As Integer = 10             'This array is fixed or temporarily locked
+Public Const ERR_DIVISION_BY_ZERO  As Integer = 11                  'Division by zero
+Public Const ERR_TYPE_MISMATCH  As Integer = 13                     'Type mismatch
+Public Const ERR_OUT_OF_STRING_SPACE  As Integer = 14               'Out of string space
+Public Const ERR_EXPRESSION_TOO_COMPLEX As Integer = 16             'Expression Too Complex
+Public Const ERR_CANT_PERFORM_OPERATION As Integer = 17             'Can 't perform requested operation
+Public Const ERR_USER_INTERRUPT  As Integer = 18                    'User interrupt occurred
+Public Const ERR_RESUME_WITHOUT_ERROR  As Integer = 20              'Resume without error
+Public Const ERR_OUT_OF_STACK_SPACE  As Integer = 28                'Out of stack space
+Public Const ERR_PROCEDURE_NOT_DEFINED  As Integer = 35             'Sub, Function, or Property not defined
+Public Const ERR_TOO_MANY_DLL_CLIENTS As Integer = 47               'Too many DLL application clients
+Public Const ERR_ERROR_LOADING_DLL As Integer = 48                  'Error in loading DLL
+Public Const ERR_BAD_DLL_CALL  As Integer = 49                      'Bad DLL calling convention
+Public Const ERR_INTERNAL_ERROR  As Integer = 51                    'Internal Error
+Public Const ERR_BAD_FILE_NAME  As Integer = 52                     'Bad file name or number
+Public Const ERR_FILE_NOT_FOUND  As Integer = 53                    'File Not found
+Public Const ERR_BAD_FILE_MODE  As Integer = 54                     'Bad file mode
+Public Const ERR_FILE_ALREADY_OPEN  As Integer = 55                 'File already open
+Public Const ERR_DEVICE_IO_ERROR  As Integer = 57                   'Device I/O error
+Public Const ERR_FILE_ALREADY_EXISTS  As Integer = 58               'File already exists
+Public Const ERR_BAD_RECORD_LENGTH  As Integer = 59                 'Bad record length
+Public Const ERR_DISK_FULL  As Integer = 61                         'Disk full
+Public Const ERR_IPUT_PAST_EOF  As Integer = 62                     'Input past end of file
+Public Const ERR_BAD_RECORD_NUMBER  As Integer = 63                 'Bad record number
+Public Const ERR_TOO_MANY_FILES  As Integer = 67                    'Too many files
+Public Const ERR_DEVICE_UNAVAILABLE  As Integer = 68                'Device unavailable
+Public Const ERR_PERMISSION_DENIED  As Integer = 70                 'Permission denied
+Public Const ERR_DISK_NOT_READY  As Integer = 71                    'Disk Not ready
+Public Const ERR_CANT_RENAME_WITH_DIFFERENT_DRIVE  As Integer = 74  'Can 't rename with different drive
+Public Const ERR_PATH_OR_FILE_ACCESS_ERROR  As Integer = 75         'Path/File access error
+Public Const ERR_PATH_NOT_FOUND  As Integer = 76                    'Path Not found
+Public Const ERR_OBJECT_VARIABLE_NOT_SET  As Integer = 91           'Object variable or With block variable not set
+Public Const ERR_FOR_LOOP_NOT_INITIALIZED As Integer = 92           'For loop not initialized
+Public Const ERR_INVALID_PATTERN_STRING As Integer = 93             'Invalid pattern string
+Public Const ERR_INVALID_USE_OF_NULL  As Integer = 94               'Invalid use of Null
+Public Const ERR_CONTROL_ARRAY_ELEMENT_DOESNOT_EXIST = 340
+Public Const ERR_INVALID_PROPERTY_VALUE  As Integer = 380           'Invalid property value
+Public Const ERR_INVALID_PROPERTY_ARRAY_INDEX  As Integer = 381
+Public Const ERR_PROPERTY_IS_READ_ONLY  As Integer = 383
+Public Const ERR_CANT_CREATE_OBJECT  As Integer = 429               'OLE Automation server can't create object
+Public Const ERR_METHOD_NOT_APPLICABLE  As Integer = 444            'Method not applicable in this context
+Public Const ERR_INVALID_ORDINAL As Integer = 452                   'Invalid ordinal
+Public Const ERR_DLL_FUNCITON_NOT_FOUND  As Integer = 453           'Specified DLL function not found
+Public Const ERR_DUPLICATE_KEY  As Integer = 457                    'Duplicate Key
+Public Const ERR_INVALID_CLIPBOARD_FORMAT  As Integer = 460         'Invalid Clipboard format
+Public Const ERR_FORMAT_DOESNT_MATCH_DATA As Integer = 461          'Specified format doesn't match format of data
+Public Const ERR_CANT_CREATE_AUTOREDRAW  As Integer = 480           'Can 't create AutoRedraw image
+Public Const ERR_INVALID_PICTURE  As Integer = 481                  'Invalid Picture
+Public Const ERR_PRINTER_ERROR  As Integer = 482                    'Printer Error
+Public Const ERR_PRINTER_DRIVE_RPROPERTY_INVALID  As Integer = 483  'Printer driver does not support specified property
+Public Const ERR_PRINTER_SYSTEM_INFO_PROBLEM  As Integer = 484      'Problem getting printer information from the system. Make sure the printer is set up correctly
+Public Const ERR_INVALID_PICTURE_TYPE  As Integer = 485             'Invalid picture type
+Public Const ERR_CANT_EMPTY_CLIPBOARD As Integer = 520              'Can 't empty Clipboard
+Public Const ERR_CANT_OPEN_CLIPBOARD  As Integer = 521              'Can 't open Clipboard

build-env/VisualStudio6/Common/Tools/APE/Source/Aeinclud/MODWINER.BAS

@@ -0,0 +1,21 @@
+Attribute VB_Name = "modWin32Errors"
+Option Explicit
+'-------------------------------------------------------------------------
+'This Module provides Windows Error constants
+'-------------------------------------------------------------------------
+
+Public Const ERR_ACCESS_DENIED As Integer = 5
+Public Const RPC_E_CALL_REJECTED = &H80010001
+Public Const RPC_E_SERVER_DIED_DNE = &H80010012
+Public Const RPC_S_INVALID_RPC_PROTSEQ As Integer = 1704
+Public Const RPC_S_PROTSEQ_NOT_SUPPORTED As Integer = 1703
+Public Const ERR_CANT_FIND_KEY_IN_REGISTRY = &H80040152     'Occurs when a client app tries to Create an object
+                                                            'that was previously created while registered remotely
+                                                            'then registered locally
+Public Const ERR_CALL_FAILED_DIDNOT_EXECUTE = &H80010012
+Public Const ERR_NO_MORE_ENDPOINTS = &H800706D9             'There are no more endpoints available from the endpoint mapper.
+Public Const RPC_S_UNKNOWN_AUTHN_TYPE = &H800706CD          'Error occurs when trying to connect using an authentication type
+                                                            'not supported by the server
+Public Const REGDB_E_IIDNOTREG = &H80040155                 'Interface not registered
+Public Const RPC_PROTOCOL_SEQUENCE_NOT_FOUND = &H800706D0             'The RPC protocol sequence was not found
+

build-env/VisualStudio6/Common/Tools/APE/Source/Aeinclud/ODBCAPI.BAS

@@ -0,0 +1,109 @@
+Attribute VB_Name = "ODBCAPI"
+Option Explicit
+
+Public Declare Function SQLAllocHandle Lib "odbc32.dll" (ByVal iHandleType As Integer, ByVal lInputHandle As Long, lOutputHandlePtr As Long) As Integer
+Public Declare Function SQLFreeHandle Lib "odbc32.dll" (ByVal iHandleType As Integer, ByVal lHandle As Long) As Integer
+
+Public Declare Function SQLDriverConnect Lib "odbc32.dll" (ByVal hConnection As Long, ByVal hWnd As Long, ByVal sInConnectionString As String, ByVal iStringLength1 As Integer, ByVal sOutConnectionString As String, ByVal iBufferLength As Integer, iStringLength2Ptr As Integer, ByVal iDriverCompletion As Integer) As Integer
+Public Declare Function SQLDisconnect Lib "odbc32.dll" (ByVal hdbc As Long) As Integer
+
+Public Declare Function SQLSetEnvAttr Lib "odbc32.dll" (ByVal hEnv As Long, ByVal lAttribute As Long, ByVal sValuePtr As String, ByVal lStringLength As Long) As Integer
+Public Declare Function SQLSetEnvAttrLong Lib "odbc32.dll" Alias "SQLSetEnvAttr" (ByVal hEnv As Long, ByVal lAttribute As Long, ByVal lValue As Long, ByVal lStringLength As Long) As Integer
+Public Declare Function SQLExecDirect Lib "odbc32.dll" (ByVal hstmt As Long, ByVal szSqlStr As String, ByVal cbSqlStr As Long) As Integer
+Public Declare Function SQLEndTran Lib "odbc32.dll" (ByVal iHandleType As Integer, ByVal hConnection As Long, ByVal iCompletionType As Integer) As Integer
+Public Declare Function SQLFetch Lib "odbc32.dll" (ByVal hstmt As Long) As Integer
+Public Declare Function SQLFetchScroll Lib "odbc32.dll" (ByVal hStatement As Long, ByVal iFetchOrientation As Integer, ByVal FetchOffset As Long) As Integer
+Public Declare Function SQLSetStmtAttrLong Lib "odbc32.dll" Alias "SQLSetStmtAttr" (ByVal hStatement As Long, ByVal lAttribute As Long, ByVal lValue As Long, ByVal lStringLength As Long) As Integer
+Public Declare Function SQLCloseCursor Lib "odbc32.dll" (ByVal hStatement As Long) As Integer
+Public Declare Function SQLGetDataLong Lib "odbc32.dll" Alias "SQLGetData" (ByVal hStatement As Long, ByVal iColumn As Integer, ByVal iTargetType As Integer, lValue As Long, ByVal lValueLength As Long, lActualLen As Long) As Integer
+Public Declare Function SQLGetDiagRec Lib "odbc32.dll" (ByVal iHandleType As Integer, ByVal hHandle As Long, ByVal iRecNumber As Integer, ByVal sSQLState As String, lNativeErrorPtr As Long, ByVal sMessageText As String, ByVal iBufferLength As Integer, iTextLengthPtr As Integer) As Integer
+
+' Options for SQLAllocHandle
+Public Const SQL_HANDLE_ENV = 1
+Public Const SQL_HANDLE_DBC = 2
+Public Const SQL_HANDLE_STMT = 3
+Public Const SQL_HANDLE_DESC = 4
+Public Const SQL_NULL_HANDLE = 0&
+
+Public Const SQL_ATTR_ODBC_VERSION = 200
+Public Const SQL_OV_ODBC3 = 3&
+
+' Options for SQLDriverConnect
+Public Const SQL_DRIVER_NOPROMPT As Long = 0
+Public Const SQL_DRIVER_COMPLETE As Long = 1
+Public Const SQL_DRIVER_PROMPT As Long = 2
+Public Const SQL_DRIVER_COMPLETE_REQUIRED As Long = 3
+
+' Options for SQLEndTran
+Public Const SQL_COMMIT = 0
+Public Const SQL_ROLLBACK = 1
+
+' Options for SQLFetchScroll
+Public Const SQL_FETCH_NEXT = 1
+Public Const SQL_FETCH_FIRST = 2
+Public Const SQL_FETCH_LAST = 3
+Public Const SQL_FETCH_PRIOR = 4
+Public Const SQL_FETCH_ABSOLUTE = 5
+Public Const SQL_FETCH_RELATIVE = 6
+
+'  RETCODEs
+Public Const SQL_SUCCESS As Long = 0
+Public Const SQL_SUCCESS_WITH_INFO As Long = 1
+Public Const SQL_ERROR As Long = -1
+Public Const SQL_INVALID_HANDLE As Long = -2
+Public Const SQL_NO_DATA  As Long = 100
+
+' Statement attributes
+Public Const SQL_ATTR_CURSOR_SCROLLABLE = -1
+Public Const SQL_ATTR_CURSOR_SENSITIVITY = -2
+Public Const SQL_CURSOR_TYPE = 6
+
+' SQL_ATTR_CURSOR_SCROLLABLE values
+Public Const SQL_NONSCROLLABLE = 0
+Public Const SQL_SCROLLABLE = 1
+
+' SQL_CURSOR_TYPE options
+Public Const SQL_CURSOR_FORWARD_ONLY = 0
+Public Const SQL_CURSOR_KEYSET_DRIVEN = 1
+Public Const SQL_CURSOR_DYNAMIC = 2
+Public Const SQL_CURSOR_STATIC = 3
+Public Const SQL_CURSOR_TYPE_DEFAULT = SQL_CURSOR_FORWARD_ONLY          ' Default value
+
+' SQL data type codes
+Public Const SQL_UNKNOWN_TYPE = 0
+Public Const SQL_CHAR = 1
+Public Const SQL_NUMERIC = 2
+Public Const SQL_DECIMAL = 3
+Public Const SQL_INTEGER = 4
+Public Const SQL_SMALLINT = 5
+Public Const SQL_FLOAT = 6
+Public Const SQL_REAL = 7
+Public Const SQL_DOUBLE = 8
+Public Const SQL_DATETIME = 9
+Public Const SQL_VARCHAR = 12
+
+' Error numbers raised when a call fails - These are also resource IDs for the corresponding error description.
+Public Enum ODBCAPIErrors
+    ErrorAllocateHandle = 20000
+    ErrorSetAttribute = 20001
+    ErrorConnectDriver = 20002
+    ErrorExecuteQuery = 20003
+    ErrorFetchRecord = 20004
+    ErrorCloseCursor = 20005
+    ErrorFreeHandle = 20006
+    ErrorDisconnectDriver = 20007
+    ErrorGetData = 20008
+    ErrorEndTransaction = 20009
+    ErrorResourceDeadlock = 20010
+End Enum
+
+Public Function ODBCAPICallSuccessful(lReturnCode As Long) As Boolean
+' Returns True if the specified return code from an ODBC API call indicates that the operation was successful, else
+' returns False
+    Select Case lReturnCode
+        Case SQL_SUCCESS, SQL_SUCCESS_WITH_INFO
+            ODBCAPICallSuccessful = True
+        Case Else
+            ODBCAPICallSuccessful = False
+    End Select
+End Function

build-env/VisualStudio6/Common/Tools/APE/Source/Aeinclud/ODBCAPI.RC

@@ -0,0 +1,14 @@
+STRINGTABLE DISCARDABLE 
+BEGIN
+	20000	"Error allocating handle"
+	20001	"Error setting attribute"
+	20002	"Error connecting driver"
+	20003	"Error executing query"
+	20004	"Error fetching record"
+	20005	"Error closing cursor"
+	20006	"Error freeing handle"
+	20007	"Error disconnecting driver"
+	20008	"Error getting data"
+	20009	"Error ending transaction"
+	20010	"Resource deadlock error"
+END

build-env/VisualStudio6/Common/Tools/APE/Source/Aeinclud/RC.BAT

@@ -0,0 +1,2 @@
+rc.exe /foODBCAPI.res ODBCAPI.rc
+pause

build-env/VisualStudio6/Common/Tools/APE/Source/Aeinclud/UTILITY.BAS

@@ -0,0 +1,483 @@
+Attribute VB_Name = "Utility"
+Option Explicit
+
+' Registry access API
+Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
+Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
+Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
+Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, ByVal lpftLastWriteTime As Long) As Long
+Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
+Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
+Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
+Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
+
+Declare Function GetTempPath Lib "Kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
+Declare Function GetTempFileNameAPI Lib "Kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
+Public Const MAX_PATH = 260
+
+' Registry constants
+Public Const ERROR_SUCCESS = 0
+Public Const HKEY_CURRENT_USER = &H80000001
+Public Const HKEY_LOCAL_MACHINE = &H80000002
+Public Const REG_OPTION_NON_VOLATILE = 0
+Public Const KEY_ALL_ACCESS = &HF003F     ' ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
+Public Const REG_SZ = 1
+
+Public Function AddItemToList(ctrControl As Control, ByVal sItem As String) As Boolean
+' Adds an item to the control's list if it is not a duplicate
+' Returns true if the item was added
+    Dim i As Integer
+    Dim bAddItem As Boolean
+    
+    sItem = Trim(sItem)
+    With ctrControl
+        bAddItem = True
+        For i = 0 To .ListCount - 1
+            If StrComp(sItem, .List(i), vbTextCompare) = 0 Then
+                bAddItem = False
+                Exit For
+            End If
+        Next
+        If bAddItem Then
+            .AddItem sItem
+        End If
+        AddItemToList = bAddItem
+    End With
+End Function
+
+Sub AlignTextToBottom(ctlControl As Control, sText As String)
+' Sets the default property of the specified control to the specified text such that the text is aligned to
+' to the bottom of the control.  Wordwrap must be set to True.
+' Currently, only Label controls are supported.
+    Debug.Assert TypeName(ctlControl) = "Label"
+    Dim iMaxLines As Integer     ' The max number of lines the control can handle
+    Dim iNumLines As Integer    ' The number of lines in the current message
+    With ctlControl
+        iMaxLines = Int(.Height / .Parent.TextHeight("A"))
+        iNumLines = Int(.Parent.TextWidth(sText) / .Width) + 1    ' Leave an additional line for wordwrap overflow
+        If iNumLines < iMaxLines Then
+            ctlControl = String(iMaxLines - iNumLines, vbCrLf) & sText    ' Pad with blank lines
+        Else
+            ctlControl = sText
+        End If
+        .Refresh
+    End With
+End Sub
+
+Sub LoadResStrings(frm As Form)
+    On Error Resume Next
+
+    Dim ctl As Control
+    Dim Obj As Object
+    Dim iResID As Integer, i As Integer
+    
+    'set the form's caption
+    If IsNumeric(frm.Tag) Then
+        frm.Caption = LoadResString(CInt(frm.Tag))
+    End If
+
+    'set the controls' captions using the caption
+    'property for menu items and the Tag property
+    'for all other controls
+    For Each ctl In frm.Controls
+        Err.Clear
+        Select Case TypeName(ctl)
+            Case "Menu":
+                iResID = CInt(Left$(ctl.Caption, 5))      ' Upto first 5 characters for res id, pad with spaces
+                If Err = 0 Then
+                    ctl.Caption = LoadResString(iResID)
+                End If
+            Case "SSTab":
+                For i = 0 To ctl.Tabs - 1
+                    iResID = CInt(Left$(ctl.TabCaption(i), 5))      ' Upto first 5 characters for res id, pad with spaces
+                    If Err = 0 Then
+                        ctl.TabCaption(i) = LoadResString(iResID)
+                    End If
+                Next
+            Case "TabStrip":
+                For Each Obj In ctl.Tabs
+                    Err.Clear
+                    If IsNumeric(Obj.Tag) Then
+                        Obj.Caption = LoadResString(CInt(Obj.Tag))
+                    End If
+                    'check for a tooltip
+                    If IsNumeric(Obj.ToolTipText) Then
+                        If Err = 0 Then
+                            Obj.ToolTipText = LoadResString(CInt(Obj.ToolTipText))
+                        End If
+                    End If
+                Next
+            Case "Toolbar":
+                For Each Obj In ctl.Buttons
+                    Err.Clear
+                    If IsNumeric(Obj.Tag) Then
+                        Obj.ToolTipText = LoadResString(CInt(Obj.Tag))
+                    End If
+                Next
+            Case "ListView":
+                For Each Obj In ctl.ColumnHeaders
+                    Err.Clear
+                    If IsNumeric(Obj.Tag) Then
+                        Obj.Text = LoadResString(CInt(Obj.Tag))
+                    End If
+                Next
+            Case Else
+                If IsNumeric(ctl.Tag) Then
+                    If Err = 0 Then
+                        ctl.Caption = LoadResString(CInt(ctl.Tag))
+                    End If
+                End If
+                'check for a tooltip
+                If IsNumeric(ctl.ToolTipText) Then
+                    If Err = 0 Then
+                        ctl.ToolTipText = LoadResString(CInt(ctl.ToolTipText))
+                    End If
+                End If
+        End Select
+    Next
+End Sub
+
+Public Function RegKeyExists(hRootKey As Long, sKey As String) As Boolean
+' Returns True if the specified key exists under the specified root key, else returns False
+    Dim hKey As Long
+    If RegOpenKeyEx(hRootKey, sKey, 0, KEY_ALL_ACCESS, hKey) = ERROR_SUCCESS Then
+        RegCloseKey hKey
+        RegKeyExists = True
+    Else
+        RegKeyExists = False
+    End If
+End Function
+
+Public Function SaveRegSetting(strMainKey As String, strSubKey As String, strValueName As String, _
+        strValue As String) As Boolean
+' Saves the specified value in the registry under the key composed of the specified key and subkey.
+' Only string values supported for now.
+' Returns true if successful
+    Dim hKey As Long, cbData As Long
+    Dim strKey As String
+    
+    On Error GoTo SaveRegSettingError
+    
+    If strSubKey = "" Then
+        strKey = strMainKey
+    Else
+        strKey = strMainKey & "\" & strSubKey
+    End If
+    If (RegCreateKeyEx(HKEY_LOCAL_MACHINE, strKey, 0, vbNullString, _
+            REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0, hKey, 0)) = ERROR_SUCCESS Then
+        cbData = LenB(StrConv(strValue, vbFromUnicode))
+        If RegSetValueEx(hKey, strValueName, 0, REG_SZ, ByVal strValue, cbData) <> ERROR_SUCCESS Then
+            RegCloseKey hKey
+            Err.Raise E_UNEXPECTED
+        End If
+        RegCloseKey hKey
+        SaveRegSetting = True
+    Else
+        Err.Raise E_UNEXPECTED
+    End If
+    
+SaveRegSettingResume:
+    Exit Function
+    
+SaveRegSettingError:
+    SaveRegSetting = False
+    Resume SaveRegSettingResume
+End Function
+
+Public Sub SelectListItem(ctlList As Control, strValue As String)
+'   Selects the item that matches strValue in ctlList (ListBox or Combo)
+
+    Dim i As Integer, iNewIndex As Integer
+    
+    Debug.Assert TypeName(ctlList) = "ComboBox" Or TypeName(ctlList) = "ListBox"
+    
+    With ctlList
+        iNewIndex = -1
+        For i = 0 To .ListCount - 1
+            If .List(i) = strValue Then iNewIndex = i
+        Next
+        .ListIndex = iNewIndex
+    End With
+End Sub
+
+Public Function GetRegSetting(strMainKey As String, strSubKey As String, strValueName As String, _
+        Optional strDefault As String = "", Optional hRootKey As Long = HKEY_LOCAL_MACHINE) As String
+' Gets the specified value from the registry key composed of the specified key and subkey.
+' Only string values supported for now.
+    Dim hKey As Long, cbData As Long, lType As Long
+    Dim strKey As String, strData As String * glMAX_NAME_LENGTH
+    
+    If strSubKey = "" Then
+        strKey = strMainKey
+    Else
+        strKey = strMainKey & "\" & strSubKey
+    End If
+    
+    If RegOpenKeyEx(hRootKey, strKey, 0, KEY_ALL_ACCESS, hKey) = ERROR_SUCCESS Then
+        cbData = LenB(StrConv(strData, vbFromUnicode))
+        Dim lReserved As Long
+        If RegQueryValueEx(hKey, strValueName, 0, lType, ByVal strData, cbData) = ERROR_SUCCESS Then
+            GetRegSetting = TruncateAtNull(strData)
+        Else
+            GetRegSetting = strDefault
+        End If
+        RegCloseKey hKey
+    Else
+        GetRegSetting = strDefault
+    End If
+End Function
+
+Public Function GetTempDir() As String
+' Returns the temp directory path
+    Dim TmpDirLen As Long
+    Dim TmpDir As String
+    Dim TmpDirLenActual As Long
+    
+    TmpDirLen = GetTempPath(0, TmpDir)  ' Get the length needed for the temp directory
+    TmpDir = Space(TmpDirLen)           ' Create enough space for it then get it
+    TmpDirLenActual = GetTempPath(TmpDirLen, TmpDir)
+    ' Strip off any extra stuff
+    If TmpDirLen > TmpDirLenActual Then
+        GetTempDir = Left(TmpDir, TmpDirLenActual)
+    Else
+        GetTempDir = App.Path & "\"   ' This code should never get executed - but, just in case
+    End If
+End Function
+
+Public Function GetTempFileName() As String
+' Returns a unique filename.
+    Dim sTempDir As String, sFileName As String
+            
+    sTempDir = GetTempDir
+    sFileName = Space$(MAX_PATH)
+    If GetTempFileNameAPI(sTempDir, "ape", 0, sFileName) <> 0 Then
+        GetTempFileName = TruncateAtNull(sFileName)
+    Else
+        GetTempFileName = ""
+    End If
+End Function
+
+Function Substitute(sString As String, sFind As String, sReplace As String) As String
+' Substitutes string sReplace in place of string sFind in sString
+    Dim lStart As Long, lEnd As Long, lFindLength As Long
+    Dim sNewString As String
+    
+    sNewString = ""
+    lFindLength = Len(sFind)
+    lStart = 1
+    lEnd = InStr(lStart, sString, sFind)
+    Do While lEnd > 0
+        sNewString = sNewString & Mid(sString, lStart, lEnd - lStart) & sReplace
+        lStart = lEnd + lFindLength
+        lEnd = InStr(lStart, sString, sFind)
+    Loop
+    Substitute = sNewString & Mid(sString, lStart)
+End Function
+
+Public Function RemoveAmpersands(strString As String) As String
+' Removes the ampersands in the specified string.
+    RemoveAmpersands = Substitute(strString, "&", "")
+End Function
+
+Public Function DSNExists(sDSN As String) As Boolean
+' Returns True if the specified DSN exists, else returns False.
+    If sDSN = "" Then
+        DSNExists = False
+    Else
+        DSNExists = RegKeyExists(HKEY_CURRENT_USER, gsODBC_INI_REG_KEY & "\" & sDSN)
+    End If
+End Function
+
+Public Function GetDSNValue(sDSN As String, sValueName As String) As String
+' Returns the specified value (sValueName) of the specified DSN (sDSN)
+    GetDSNValue = GetRegSetting(gsODBC_INI_REG_KEY, sDSN, sValueName, "", HKEY_CURRENT_USER)
+End Function
+
+Public Function GetAllRegSettings(strMainKey As String, strSubKey As String) As Variant
+' Returns an array of all values under the registry key composed of the specified key and subkey.
+' Only string values supported for now.
+    Dim hKey As Long, cbData As Long, cbValueName As Long, lType As Long
+    Dim strKey As String, strData As String * giMAX_REG_DATA_LENGTH, strValueName As String * glMAX_NAME_LENGTH
+    Dim aValues() As String
+    
+    If strSubKey = "" Then
+        strKey = strMainKey
+    Else
+        strKey = strMainKey & "\" & strSubKey
+    End If
+    If (RegCreateKeyEx(HKEY_LOCAL_MACHINE, strKey, 0, vbNullString, _
+            REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0, hKey, 0)) = ERROR_SUCCESS Then
+        ' Iterate over all the values in this key
+        Dim strClass As String * glMAX_NAME_LENGTH
+        Dim cbClass As Long, cSubKeys As Long, cbMaxSubKeyLen As Long, cbMaxClassLen As Long, lReserved As Long
+        Dim cValues As Long, cbMaxValueNameLen As Long, cbMaxValueLen As Long, cbSecurityDescriptor As Long
+        
+        cbClass = LenB(StrConv(strClass, vbFromUnicode))
+        If RegQueryInfoKey(hKey, strClass, cbClass, lReserved, cSubKeys, cbMaxSubKeyLen, cbMaxClassLen, cValues, cbMaxValueNameLen, _
+                cbMaxValueLen, cbSecurityDescriptor, 0) = ERROR_SUCCESS Then
+            If cValues > 0 Then
+                ReDim aValues(0 To cValues - 1, 0 To 1)
+                Dim i As Long
+                For i = 0 To cValues - 1
+                    cbValueName = LenB(StrConv(strValueName, vbFromUnicode))
+                    cbData = LenB(StrConv(strData, vbFromUnicode))
+                    If RegEnumValue(hKey, i, strValueName, cbValueName, 0, lType, strData, cbData) = ERROR_SUCCESS Then
+                        aValues(i, 0) = TruncateAtNull(strValueName)
+                        aValues(i, 1) = TruncateAtNull(strData)
+                    End If
+                Next
+                GetAllRegSettings = aValues
+            End If
+        End If
+        RegCloseKey hKey
+    End If
+End Function
+
+Public Function DeleteRegSettings(strMainKey As String, strSubKey As String) As Boolean
+' Deletes the specified key and all its sub keys
+' Returns true is successful
+    Dim strKey As String
+    
+    If strSubKey = "" Then
+        strKey = strMainKey
+    Else
+        strKey = strMainKey & "\" & strSubKey
+    End If
+    DeleteRegSettings = (RegDeleteKey(HKEY_LOCAL_MACHINE, strKey) = ERROR_SUCCESS)
+End Function
+
+Public Function Min(a, b)
+    If a < b Then
+        Min = a
+    Else
+        Min = b
+    End If
+End Function
+
+Public Function Max(a, b)
+    If b > a Then
+        Max = b
+    Else
+        Max = a
+    End If
+End Function
+
+Public Function TruncateAtNull(ByVal strText As String) As String
+' Returns the specified string truncated at the first null character
+    Dim lLen As Long
+    
+    lLen = InStr(strText, Chr(0))
+    If lLen < 1 Then
+        TruncateAtNull = strText
+    Else
+        TruncateAtNull = Left(strText, lLen - 1)
+    End If
+End Function
+
+Public Function TruncateFile(sFileName As String, dSize As Double)
+' Truncates the specified file to lSize bytes.  Truncation occurs at the beginning of the file.
+    Const CHUNK_SIZE = 65535        ' Size of chunk for copying file contents
+    
+    Dim dOverflow As Double
+    dOverflow = CDbl(FileLen(sFileName)) - dSize
+    If dOverflow > 0 Then
+        Dim sTempFile As String, baChunk(CHUNK_SIZE) As Byte
+        Dim lFileNum As Long, lTempFileNum As Long
+        sTempFile = GetTempFileName
+        lFileNum = FreeFile
+        Open sFileName For Binary Access Read As lFileNum
+        lTempFileNum = FreeFile
+        Open sTempFile For Binary Access Write As lTempFileNum
+        Seek lFileNum, dOverflow + 1
+        ' Start copying file from first complete line - fill the very first (incomplete) line with "." characters.
+        Get lFileNum, , baChunk
+        Dim l As Long
+        For l = LBound(baChunk) To UBound(baChunk)
+            If baChunk(l) <> 13 Then         ' = vbCr
+                baChunk(l) = 46      ' = Asc(".")
+            Else
+                Put lTempFileNum, , baChunk
+                Exit For
+            End If
+        Next
+        Do While Not EOF(lFileNum)
+            Get lFileNum, , baChunk
+            Put lTempFileNum, , baChunk
+        Loop
+        Close lFileNum
+        Close lTempFileNum
+        FileCopy sTempFile, sFileName
+        Kill sTempFile
+    End If
+End Function
+
+Public Function StripPath(strFileName As String, Optional bStripExtension As Boolean = False) As String
+' Strips the path off the specified fully qualified filename.  If bStripExtension is True, the file extension is stripped as well.
+    Dim iStart As Integer, iNext As Integer, iActualStart As Integer
+    
+    ' First, find the beginning of the actual filename
+    iStart = 0
+    Do
+        iNext = InStr(iStart + 1, strFileName, "\")
+        If iNext = 0 Then
+            Exit Do
+        End If
+        iStart = iNext
+    Loop
+    iActualStart = iStart + 1     ' Point to beginning of actual filename
+    ' Next, find the beginning of the extension (which immediately follows the last period in the filename)
+    If bStripExtension Then
+        Do
+            iNext = InStr(iStart + 1, strFileName, ".")
+            If iNext = 0 Then
+                Exit Do
+            End If
+            iStart = iNext
+        Loop
+    End If
+    If iStart = iActualStart - 1 Then   ' If no extension
+        StripPath = Mid(strFileName, iActualStart)
+    Else
+        StripPath = Mid(strFileName, iActualStart, iStart - iActualStart)
+    End If
+End Function
+
+Public Sub SizeToFit(ctl As Control)
+' Resizes the control to fit the displayed text
+    With ctl
+        Select Case TypeName(ctl)
+            Case "CheckBox", "OptionButton"
+                .Width = .Parent.TextWidth(.Caption) + .Height      ' Compensate for non-text area
+            Case Else
+                Debug.Assert False
+        End Select
+    End With
+End Sub
+
+Public Function SubstituteParams(bstrString As String, ParamArray aParams()) As String
+' Substitutes the parameters in the paramarray for placeholders in the string.  The placeholders are of the format
+' '%n' where 'n' represents the index of the parameter in the paramarray.
+' A maximum of 10 parameters (0 - 9) are supported.
+
+    Dim iStart As Integer, iPtr As Integer, iParamNum As Integer
+    Dim cChar As String * 1
+    Dim bstrReturn As String
+    
+    iStart = 1
+    iPtr = InStr(bstrString, "%")
+    Do While iPtr > 0 And iPtr < Len(bstrString)
+        bstrReturn = bstrReturn & Mid$(bstrString, iStart, iPtr - iStart)
+        cChar = Mid(bstrString, iPtr + 1, 1)
+        If IsNumeric(cChar) Then
+            iParamNum = Val(cChar)
+            If iParamNum <= UBound(aParams) Then
+                bstrReturn = bstrReturn & aParams(iParamNum)
+            End If
+        End If
+        iStart = iPtr + 2
+        iPtr = InStr(iStart, bstrString, "%")
+    Loop
+    SubstituteParams = bstrReturn & Mid(bstrString, iStart)
+End Function
+
+

build-env/VisualStudio6/Common/Tools/APE/Source/Aeinstnr/AEINSTNR.VBP

@@ -0,0 +1,40 @@
+Type=OleExe
+Reference=*\G{C93809A0-684C-11D1-9D3E-0020781039AF}#1.0#9#..\AEIntrfc\AEIntrfc.TLB#Application Performance Explorer 2.0 Interfaces
+Class=Instancer; instncer.cls
+Module=modInstancer; modinstr.bas
+Startup="Sub Main"
+HelpFile=""
+Title="APE Instancer"
+ExeName32="AEInstnr.exe"
+Path32="..\..\Retail"
+Command32=""
+Name="AEInstancer"
+HelpContextID="0"
+Description="Application Performance Explorer Instancer"
+CompatibleMode="1"
+CompatibleEXE32="..\AECompat\AEInstnr.cmp"
+MajorVer=2
+MinorVer=0
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+VersionCompanyName="Microsoft Corporation"
+VersionFileDescription="Application Performance Explorer Instancer"
+VersionLegalCopyright="Copyright © 1996-1998 Microsoft Corp."
+VersionLegalTrademarks="Microsoft® is a registered trademark of Microsoft Corporation. Windows(TM) is a trademark of Microsoft Corporation"
+VersionProductName="Application Performance Explorer Instancer"
+CompilationType=0
+OptimizationType=0
+FavorPentiumPro(tm)=0
+CodeViewDebugInfo=0
+NoAliasing=0
+BoundsCheck=0
+OverflowCheck=0
+FlPointCheck=0
+FDIVCheck=0
+UnroundedFP=0
+StartMode=1
+Unattended=0
+ThreadPerObject=0
+MaxNumberOfThreads=1
+DebugStartupOption=0

build-env/VisualStudio6/Common/Tools/APE/Source/Aeinstnr/INSTNCER.CLS

@@ -0,0 +1,38 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0   'False
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+END
+Attribute VB_Name = "Instancer"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = True
+Attribute VB_Description = "APE Instance Manager"
+Option Explicit
+
+Implements APEInterfaces.IInstancer
+
+Private Function IInstancer_Object(ByVal sProgID As String) As Object
+    '-------------------------------------------------------------------------
+    'Purpose:
+    '   This public class is a work around for error
+    '   -2147221166 (80040152) 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 restart.  Therefore,
+    '   it works to call another process to create the
+    '   local instance and pass it back.
+    'In:
+    '   [sProgID]
+    '       ProgID of needed object
+    'Return:
+    '   Object created using the passed progId
+    '-------------------------------------------------------------------------
+    Set IInstancer_Object = CreateObject(sProgID)
+End Function

build-env/VisualStudio6/Common/Tools/APE/Source/Aeinstnr/MODINSTR.BAS

@@ -0,0 +1,9 @@
+Attribute VB_Name = "modInstancer"
+Option Explicit
+'-------------------------------------------------------------------------
+'See comments in Instancer class module
+'-------------------------------------------------------------------------
+
+Sub Main()
+
+End Sub

build-env/VisualStudio6/Common/Tools/APE/Source/Aeintrfc/BUILD.BAT

@@ -0,0 +1,4 @@
+@echo off
+midl /nologo /no_warn AEIntrfc.IDL /tlb AEIntrfc.TLB
+midl /nologo /no_warn AEExpdtr.IDL /tlb AEExpdtr.TLB
+pause

build-env/VisualStudio6/Common/Tools/APE/Source/Aelogger/AELOGGER.RC

@@ -0,0 +1,15 @@
+STRINGTABLE DISCARDABLE 
+BEGIN
+	1	"*** Do *NOT* Localize any string that starts with '***'.  They are comments to be used by localizers to identify sections.  They also mark the beginning of a new 'section' within the String Table."
+	//Logging strings
+	2	"Logger"	//Component name
+	//Display string
+	3	"Disk full, logging turned off."
+	4	"Writing Temporary log file."
+	//U/I strings
+	5	"Logger"	//Form Caption
+	29	"*** Font information for all forms.  Index 30 is the Character set, Index 31 is Font name, Index 32 is Font Size"
+	30	"0"
+	31	"Tahoma"
+	32	"10"
+END

build-env/VisualStudio6/Common/Tools/APE/Source/Aelogger/AELOGGER.VBP

@@ -0,0 +1,49 @@
+Type=OleExe
+Reference=*\G{C93809A0-684C-11D1-9D3E-0020781039AF}#1.0#9#..\AEIntrfc\AEIntrfc.TLB#Application Performance Explorer 2.0 Interfaces
+Module=modLogger; modloggr.bas
+Module=modAEConstants; ..\AEInclud\modaecon.bas
+Module=modVBErrors; ..\AEInclud\modvberr.bas
+Class=clsPositionForm; ..\AEInclud\clsposfm.cls
+Form=frmloggr.frm
+Class=Logger; logger.cls
+Module=modAEGlobals; ..\AEInclud\modAEGlb.bas
+Module=Utility; ..\AEInclud\Utility.bas
+Module=Localize; ..\AEInclud\Localize.bas
+ResFile32="aelogger.res"
+IconForm="frmLogger"
+Startup="Sub Main"
+HelpFile=""
+Title="APE Logger"
+ExeName32="AELogger.exe"
+Path32="..\..\Retail"
+Command32=""
+Name="AELogger"
+HelpContextID="0"
+Description="Application Performance Explorer Logger"
+CompatibleMode="1"
+CompatibleEXE32="..\AECompat\AELogger.cmp"
+MajorVer=2
+MinorVer=0
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+VersionCompanyName="Microsoft Corporation"
+VersionFileDescription="Application Performance Explorer Logger"
+VersionLegalCopyright="Copyright © 1996-1998 Microsoft Corp."
+VersionLegalTrademarks="Microsoft® is a registered trademark of Microsoft Corporation. Windows(TM) is a trademark of Microsoft Corporation"
+VersionProductName="Application Performance Explorer Logger"
+CompilationType=0
+OptimizationType=0
+FavorPentiumPro(tm)=0
+CodeViewDebugInfo=0
+NoAliasing=0
+BoundsCheck=0
+OverflowCheck=0
+FlPointCheck=0
+FDIVCheck=0
+UnroundedFP=0
+StartMode=1
+Unattended=0
+ThreadPerObject=0
+MaxNumberOfThreads=1
+DebugStartupOption=0

build-env/VisualStudio6/Common/Tools/APE/Source/Aelogger/FRMLOGGR.FRM

@@ -0,0 +1,66 @@
+VERSION 5.00
+Begin VB.Form frmLogger 
+   BorderStyle     =   1  'Fixed Single
+   Caption         =   "Logger"
+   ClientHeight    =   2100
+   ClientLeft      =   1380
+   ClientTop       =   1980
+   ClientWidth     =   4200
+   ClipControls    =   0   'False
+   Icon            =   "frmloggr.frx":0000
+   LinkTopic       =   "Form1"
+   MaxButton       =   0   'False
+   ScaleHeight     =   2100
+   ScaleWidth      =   4200
+   StartUpPosition =   3  'Windows Default
+   Begin VB.Label lblStatus 
+      BackStyle       =   0  'Transparent
+      BeginProperty Font 
+         Name            =   "MS Sans Serif"
+         Size            =   9.75
+         Charset         =   0
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   1170
+      Left            =   70
+      TabIndex        =   0
+      Top             =   900
+      Width           =   3835
+      WordWrap        =   -1  'True
+   End
+End
+Attribute VB_Name = "frmLogger"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Private Sub Form_Load()
+    'Use clsPositionForm object to move
+    'Form to settings saved in registry
+    Dim oPosition As clsPositionForm
+    Set oPosition = New clsPositionForm
+    oPosition.Move Me, False
+    Width = giDEFAULT_FORM_WIDTH
+    Height = giDEFAULT_FORM_HEIGHT
+    'Set Form Caption
+    ApplyFontToForm Me
+    Caption = LoadResString(giFORM_CAPTION)
+
+End Sub
+
+Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
+    'Don't unload unless called from code.
+    If UnloadMode = vbFormControlMenu Then Cancel = False
+End Sub
+
+Private Sub Form_Unload(Cancel As Integer)
+    'Use clsPositionForm object to save
+    'forms position in registry
+    Dim oPosition As clsPositionForm
+    Set oPosition = New clsPositionForm
+    oPosition.Save Me
+    gbShowForm = False
+End Sub

build-env/VisualStudio6/Common/Tools/APE/Source/Aelogger/LOGGER.CLS

@@ -0,0 +1,202 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0   'False
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+END
+Attribute VB_Name = "Logger"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = True
+Attribute VB_Description = "APE Logger"
+Option Explicit
+'-------------------------------------------------------------------------
+'This is the only public class in this application.  See modLogger for
+'purpose.
+' This class implements the ILogger interface.
+'-------------------------------------------------------------------------
+
+Implements APEInterfaces.ILogger
+
+Public Property Let ILogger_Show(ByVal bShow As Boolean)
+Attribute ILogger_Show.VB_Description = "Determines whether the Logger shows a form."
+    '-------------------------------------------------------------------------
+    'Purpose:   Show property determines whether or not a form is displayed
+    '           while the logger is loaded.
+    '
+    'Effects:   [gbShowForm]
+    '               Becomes equal to the passed parameter
+    '           [frmLogger]
+    '               Becomes loaded and visible if parameter is true, but is
+    '               unloaded if parameter is false
+    '-------------------------------------------------------------------------
+    If Not gbShowForm = bShow Then
+        gbShowForm = bShow
+        If bShow = True Then
+            frmLogger.Show
+        Else
+            Unload frmLogger
+        End If
+    End If
+End Property
+
+Public Property Get ILogger_Show() As Boolean
+    ILogger_Show = gbShowForm
+End Property
+
+Public Property Let ILogger_AutomaticWrite(ByVal bWrite As Boolean)
+Attribute ILogger_AutomaticWrite.VB_Description = "Determines whether log records are written to a file and purged from memory when the log threshold is reached."
+    '-------------------------------------------------------------------------
+    'Purpose:   AutomaticWrite property determines if the Logger should
+    '           automatically write to a file when a record threshold is met.
+    'Effects:   [gbWriteRecords]
+    '               Becomes equal to the passed parameter
+    '-------------------------------------------------------------------------
+    gbWriteRecords = bWrite
+End Property
+
+Public Property Get ILogger_AutomaticWrite() As Boolean
+    ILogger_AutomaticWrite = gbWriteRecords
+End Property
+
+Public Property Let ILogger_Threshold(ByVal lThreshold As Long)
+Attribute ILogger_Threshold.VB_Description = "Sets the log threshold in kilobytes that determines when log records are written to a file and purged from memory."
+    '-------------------------------------------------------------------------
+    'Purpose:   If AutomaticWrite property is true, logger uses the
+    '           Threshold property to determine how many kilobytes should
+    '           be held in memory before writing to a file and emptying
+    '           log record array.
+    'Effects:   [glThreshold]
+    '               Becomes equal to the passed parameter
+    '           [glThresholdRecs]
+    '               Becomes an estimated number of records equivalent
+    '-------------------------------------------------------------------------
+    On Error Resume Next
+    glThreshold = lThreshold
+    glThresholdRecs = lThreshold * giLOG_RECORD_KILOBYTES
+End Property
+
+Public Property Get ILogger_Threshold() As Long
+    ILogger_Threshold = glThreshold
+End Property
+
+'************************
+'Public Methods
+'************************
+
+Public Sub ILogger_SetProperties(ByVal bShow As Boolean, Optional ByVal bAutomaticWrite As Variant, Optional ByVal lThreshold As Variant)
+Attribute ILogger_SetProperties.VB_Description = "Sets all Logger properties in one method call."
+    '-------------------------------------------------------------------------
+    'Purpose:   Provided so that properties can be set by one method call
+    'Effects:   Sets the following properties:
+    '           Show, AutomaticWrite, Threshold
+    '-------------------------------------------------------------------------
+    Me.ILogger_Show = bShow
+    If Not IsMissing(bAutomaticWrite) Then gbWriteRecords = bAutomaticWrite
+    If Not IsMissing(lThreshold) Then Me.ILogger_Threshold = lThreshold
+End Sub
+
+Public Sub ILogger_Record(ByVal sComponent As String, ByVal sServiceID As String, ByVal sComment As String, ByVal lMilliseconds As Long)
+Attribute ILogger_Record.VB_Description = "Adds a log record."
+    '-------------------------------------------------------------------------
+    'Purpose:   Provided for any app to call to add one log record
+    'Effects:   Calls AddLogRecord
+    '           Calls WriteRecords when the Threshold is reached
+    '-------------------------------------------------------------------------
+    AddLogRecord sComponent, sServiceID, sComment, lMilliseconds
+    If gbWriteRecords Then
+        If glLastAddedRecord >= glThresholdRecs And glThresholdRecs > 0 Then
+            WriteRecords
+        End If
+    End If
+End Sub
+
+Public Function ILogger_GetRecords() As Variant
+Attribute ILogger_GetRecords.VB_Description = "Returns a variant array containing log records.  Must be called multiple times until until Null is returned."
+    '-------------------------------------------------------------------------
+    'Purpose:   Use to retrieve all of the log records passed to the Logger
+    '           Keep calling until, it returns does not return a variant array
+    'Return:    Returns a two dimension array in which
+    '           the first four elements of the first dimension
+    '           are Component(string), ServiceID(Long),Comment(string),
+    '           and Milliseconds(long) respectively
+    '           the second dimension represents the number of log records
+    '           User Defined Types can not be returned from public
+    '           procedures of public classes
+    'Effects:   [gaRecords]
+    '               Redimensioned after calling GetRecords to not have empty
+    '               records at the end
+    '           [glLastAddedRecord]
+    '               becomes equal to giNO_RECORDS
+    '-------------------------------------------------------------------------
+    
+    GetWrittenLog
+    'Trim the array to only send the filled elements
+    If glLastAddedRecord >= 0 Then
+        If UBound(gaRecords, 2) <> glLastAddedRecord Then ReDim Preserve gaRecords(giLOG_ARRAY_DIMENSION_ONE, glLastAddedRecord)
+        ILogger_GetRecords = gaRecords()
+        'Changing the glLastAddedRecord flag to giNO_RECORDS causes
+        'WriteRecords to ignore records at next call
+        glLastAddedRecord = giNO_RECORDS
+    Else
+        ILogger_GetRecords = Null
+    End If
+End Function
+
+'*******************
+'Private Procedures
+'*******************
+
+Private Sub Class_Initialize()
+    '-------------------------------------------------------------------------
+    'Purpose:   Set the initial state of the logger when the first logger
+    '           class object is initialized
+    'Effects:   [glInstances]
+    '               Iterates it once
+    '-------------------------------------------------------------------------
+    'Count how many times this class is instanced
+    'to react to the first instance or the release
+    'of the last instance.
+    glInstances = glInstances + 1
+    If glInstances = 1 Then
+       'Set default property values
+       gbShowForm = gbSHOW_FORM_DEFAULT
+       gbWriteRecords = gbWRITE_RECORDS_DEFAULT
+       Me.ILogger_Threshold = gbTHRESHOLD_DEFAULT
+       gsFileName = GetTempFile
+       glLastAddedRecord = giNO_RECORDS
+       'Load frmLogger if gbShowForm is True
+       If gbShowForm Then frmLogger.Show
+    End If
+End Sub
+
+Private Sub Class_Terminate()
+    '-------------------------------------------------------------------------
+    'Purpose:   Closes the form and destroys the tempfile when the last
+    '           instance is terminated
+    'Effects:   [glInstances]
+    '               decreases by one
+    '-------------------------------------------------------------------------
+    'Count how many times this class is instanced
+    'so subtract one every terminate event
+    'If the last terminate event is occuring
+    'make sure forms are unloaded and write records
+    On Error GoTo Class_TerminateError
+    glInstances = glInstances - 1
+    If glInstances = 0 Then
+        Unload frmLogger
+        Close   'Close here incase getting logs got canceled
+        Kill gsFileName
+    End If
+    Exit Sub
+Class_TerminateError:
+    Select Case Err.Number
+        Case ERR_FILE_NOT_FOUND
+            'There is no file to kill
+            Resume Next
+        Case Else
+            Resume Next
+    End Select
+End Sub

build-env/VisualStudio6/Common/Tools/APE/Source/Aelogger/MODLOGGR.BAS

@@ -0,0 +1,305 @@
+Attribute VB_Name = "modLogger"
+Option Explicit
+'-------------------------------------------------------------------------
+'The project is the Logger component of the Application Performance Explorer
+'The Logger is a multiuse server that objects can call to pass log records
+'The logger will store the records, either in memory or in a temp file.
+'The logger will then return the records the the Manager when it calls GetRecords
+'
+'Key Files:
+'   frmLoggr.frm    Only form in app
+'   clsPosFm.cls    Tool used to save form position in registry
+'   Logger.cls      Multi-Use public class providing only OLE interface
+'-------------------------------------------------------------------------
+
+'API Declares
+#If UNICODE Then
+    Declare Function GetTempFileName Lib "Kernel32" Alias "GetTempFileNameW" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
+    Declare Function GetTempPath Lib "Kernel32" Alias "GetTempPathW" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
+#Else
+    Declare Function GetTempFileName Lib "Kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
+    Declare Function GetTempPath Lib "Kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
+#End If
+Declare Function GetTickCount Lib "Kernel32" () As Long
+
+'Public Constants
+Public Const glROWS_RETURNED_PER_GET_RECORDS As Long = 500  'Max number of records returned for
+                                                        'each call of GetRecords
+'Property Defaults
+Public Const gbSHOW_FORM_DEFAULT As Boolean = False
+Public Const gbWRITE_RECORDS_DEFAULT As Boolean = False
+Public Const gbTHRESHOLD_DEFAULT As Long = 2000
+Public Const glREDIM_CHUNK_SIZE As Long = 100
+Public Const giNO_RECORDS As Integer = -1
+
+'Resource string constants
+Public Const giLOGGER_NAME As Integer = 2
+Public Const giDISK_FULL As Integer = 3
+Public Const giWRITING_TEMP_FILE As Integer = 4
+Public Const giFORM_CAPTION As Integer = 5
+Public Const giFONT_CHARSET_INDEX As Integer = 30
+Public Const giFONT_NAME_INDEX As Integer = 31
+Public Const giFONT_SIZE_INDEX  As Integer = 32
+
+'Global Variables
+Public gbShowForm As Boolean        'If true show form
+Public gbWriteRecords As Boolean    'If true write records to file when Record
+                                    'Threshold is reached.
+Public glThreshold As Long          'Record threshold in kilobytes
+Public glThresholdRecs As Long      'Record threshold in number of records
+Public gsFileName As String         'FileName to write records to
+Public gaRecords() As Variant       'Array used to store log records before they are written
+Public glInstances As Long          'Counter of how many instances of Logger are instanciated
+Public glLastAddedRecord As Long    'Last index of gaRecords that a record was added to
+Public gbWritingFile As Boolean     'If true we are in WriteRecords procedure
+Public gbDiskFull As Boolean        'If true Disk Full error occured
+Public gbGetWrittenLogCalled As Boolean 'Get Written Log has been called by Manager
+                                        'Now logger is expecting GetWrittenLog to be called
+                                        'until all records are received.  The next time a record
+                                        'is written the temp file will be deleated assuming that all
+                                        'records were received.
+
+
+Sub Main()
+End Sub
+
+Public Sub WriteRecords()
+    '-------------------------------------------------------------------------
+    'Purpose:   WriterRecords procedure writes all the log records currently
+    '           in the global array
+    'Effects:
+    '           [gbGetWrittenLogCalled] becomes false
+    '           The temp file is deleted if gbGetWrittenLogCalled is true
+    '           [glLastAddedRecord] is set to giNO_RECORDS
+    '           [gaRecords]is redimensioned to glREDIM_CHUNK_SIZE
+    'Assumption:
+    '           gsFileName is a valid temporary file name
+    '           If gbGetWrittenLogCalled is true then all the records in
+    '               the temp file have been retrieved by the manager through
+    '               the GetRecords method
+    '-------------------------------------------------------------------------
+    
+    Dim iFile As Integer        'File number
+    Dim l As Long               'For...Next counter
+    Dim sComponent As String    'APE Component name being written
+    Dim sServiceID As String      'Service ID (Task request ID) being written
+    Dim sComment As String      'Comment being written
+    Dim lMilliseconds As Long   'Milliseconds being written
+    
+    On Error GoTo WriteRecordsError
+    
+    'Check to see if the contents of the temp file
+    'need deleted first, the reason it is not delete
+    'when the flag is flipped is to give one the chance
+    'of rescueing it if the Manager fails to retreive
+    'the records from it
+    If gbGetWrittenLogCalled Then
+        Close   'Close in case Getting log was cancelled
+        Kill gsFileName
+        gbGetWrittenLogCalled = False
+    End If
+    
+    If glLastAddedRecord > giNO_RECORDS Then
+        AddLogRecord LoadResString(giLOGGER_NAME), 0, LoadResString(giWRITING_TEMP_FILE), GetTickCount
+        iFile = FreeFile
+        Open gsFileName For Append As iFile
+        'Iterate through array writing record and
+        For l = 0 To glLastAddedRecord
+            sComponent = gaRecords(giCOMPONENT_ELEMENT, l)
+            sServiceID = gaRecords(giSERVICE_ELEMENT, l)
+            sComment = gaRecords(giCOMMENT_ELEMENT, l)
+            lMilliseconds = gaRecords(giMILLI_SECONDS_ELEMENT, l)
+            Write #iFile, sComponent, sServiceID, sComment, lMilliseconds
+            'Reset logrecord counter no after writing the first record
+            'so that records are not added after the count that is being
+            'written and therefore, lost.  This also protects from
+            'Addlogrecord trying to write a record greater than
+            'giRedimChunkSize write after gaRecords is redimensioned
+            If l = 0 Then glLastAddedRecord = giNO_RECORDS
+        Next
+        Close iFile
+        'Redimension array
+        'Preserve is used because there is a potential
+        'for a log record to be added after the above line
+        'but before the following one
+        ReDim Preserve gaRecords(giLOG_ARRAY_DIMENSION_ONE, glREDIM_CHUNK_SIZE)
+    End If
+    
+    Exit Sub
+WriteRecordsError:
+    Select Case Err.Number
+        Case ERR_DISK_FULL
+            'Turn off logging erase array
+            'leave present file for later retrieval
+            DisplayStatus LoadResString(giDISK_FULL)
+            Close iFile
+            Erase gaRecords
+            gbDiskFull = True
+            Exit Sub
+        Case ERR_FILE_NOT_FOUND
+            'There is no temp file to kill
+            Resume Next
+        Case Else
+            Close iFile
+            Err.Raise Err.Number, Err.Source, Err.Description
+            Exit Sub
+    End Select
+End Sub
+
+Public Sub GetWrittenLog()
+    '-------------------------------------------------------------------------
+    'Purpose:   Checks to see if there is log records written to a temp file
+    '           If there are it inputs it and adds it to the gaRecords array
+    '           If it reaches the chunk size for passing log records it will
+    '           exit the loop, leaving the file open. It is necessary to keep
+    '           calling this function until no records or added.  Do not call
+    '           this function more than once until the array that was filled
+    '           was erased.  The external process that is calling a method that
+    '           calls this procedure should be responsible for calling until
+    '           all records have been attained.
+    'Effects:
+    '           [gbGetWrittenLogCalled] becomes true
+    '           Temp file may be left open if all records are not read
+    '           AddlogRecord is called for each record read
+    'Assumption:
+    '           If gbGetWrittenLogCalled is true then the temp file is already
+    '           open, ready for the next record to be read.
+    '           If the EOF is not reached before the glROWS_RETURNED_PER_GET_RECORDS
+    '           is reached then the external process that called Logger.GetRecords
+    '           will call it again, to get the rest of the records
+    '-------------------------------------------------------------------------
+    
+    Static stlFile As Long      'File number of file that may be left open between calls
+    Dim sComponent As String    'APE Component name that will be read from file
+    Dim sServiceID As String      'Service ID that will be read from file
+    Dim sComment As String      'Comment that will be read from file
+    Dim lMilliseconds As Long   'Milliseconds that will be read from file
+    Dim lAddedCount As Long     'Used to count how many records have been read and
+                                'added to global array
+    
+    On Error GoTo GetWrittenLogError
+    'Open file if not open yet
+    If Not gbGetWrittenLogCalled Then
+        'Write records in memory first to order the records
+        'with any records that may have already been written
+        WriteRecords
+        gbGetWrittenLogCalled = True
+        stlFile = FreeFile
+        Open gsFileName For Input As stlFile
+    End If
+    
+    
+    Do Until EOF(stlFile)
+        Input #stlFile, sComponent, sServiceID, sComment, lMilliseconds
+        AddLogRecord sComponent, sServiceID, sComment, lMilliseconds
+        lAddedCount = lAddedCount + 1
+        'Exit here if max record size was reached
+        If lAddedCount = glROWS_RETURNED_PER_GET_RECORDS Then Exit Sub
+    Loop
+    Close
+    Exit Sub
+GetWrittenLogError:
+    Select Case Err.Number
+        Case ERR_FILE_NOT_FOUND
+            'There are no written records so exit without calling gSendLog
+            Exit Sub
+        Case ERR_BAD_FILE_NAME
+            'We have already reached the end of the file
+            'and it has been closed
+            Exit Sub
+        Case ERR_IPUT_PAST_EOF
+            'This could occur if a temp file was artificially made that
+            'had an invalid format
+            Close stlFile
+            Exit Sub
+        Case Else
+            Close stlFile
+            Err.Raise Err.Number, Err.Source, Err.Description
+            Exit Sub
+    End Select
+End Sub
+
+Public Sub AddLogRecord(sComponent As String, sServiceID As String, sComment As String, lMilliseconds As Long)
+    '-------------------------------------------------------------------------
+    'Purpose:   Called to add a record to the gaRecords.
+    'In:        [sComponent]    APE component name that will be added
+    '           [sServiceID]    Service ID that will be added
+    '           [sComment]      Comment that will be added
+    '           [lMilliseconds] Milliseconds that will be added
+    'Effects:   [gaRecords]     May be redimensioned (preserve) to increase
+    '                           its size
+    '           [glLastAddedRecord]
+    '                           will be increased by one
+    '-------------------------------------------------------------------------
+    Dim lU As Long      'The UBound of the the 2nd dimension of gaRecords
+    On Error GoTo AddLogRecordError
+AddLogRecordTop:
+    'If diskfull error occured immediately exit
+    If gbDiskFull Then Exit Sub
+    
+    If glLastAddedRecord = giNO_RECORDS Then
+        ReDim gaRecords(giLOG_ARRAY_DIMENSION_ONE, glREDIM_CHUNK_SIZE)
+        glLastAddedRecord = 0
+    Else
+        lU = UBound(gaRecords, 2)
+        glLastAddedRecord = glLastAddedRecord + 1
+        If glLastAddedRecord > lU Then
+            'Redim gaRecords to increase size
+            lU = lU + glREDIM_CHUNK_SIZE
+            ReDim Preserve gaRecords(giLOG_ARRAY_DIMENSION_ONE, lU)
+        End If
+    End If
+    gaRecords(giCOMPONENT_ELEMENT, glLastAddedRecord) = sComponent
+    gaRecords(giSERVICE_ELEMENT, glLastAddedRecord) = sServiceID
+    gaRecords(giCOMMENT_ELEMENT, glLastAddedRecord) = sComment
+    gaRecords(giMILLI_SECONDS_ELEMENT, glLastAddedRecord) = lMilliseconds
+    Exit Sub
+AddLogRecordError:
+    Select Case Err.Number
+        Case ERR_SUBSCRIPT_OUT_OF_RANGE
+            'Synchronicity issues caused this
+            'Got the glLastAddedRecord write before it got changed
+            'but tried to put record in array right after it got redim'ed
+            Dim bTried
+            'If already tried raise error
+            If bTried Then Err.Raise Err.Number, Err.Source, Err.Description
+            bTried = True
+            'Try the at the top again, getting a new glLastAddedRecord
+            GoTo AddLogRecordTop
+        Case Else
+            Err.Raise Err.Number, Err.Source, Err.Description
+    End Select
+End Sub
+
+'Puts a message in the status label
+Public Sub DisplayStatus(s As String)
+    '-------------------------------------------------------------------------
+    'Purpose:   Displays passed string in the Logger form's status box if
+    '           the form is visible.
+    'Assumtions:
+    '           If gbShowForm is true the form is loaded and visible
+    '-------------------------------------------------------------------------
+    If gbShowForm Then AlignTextToBottom frmLogger.lblStatus, s
+End Sub
+
+Public Function GetTempFile() As String
+    '-------------------------------------------------------------------------
+    'Purpose:   Gets a temp file name from the system
+    'Return:    a valid temporary file name
+    '-------------------------------------------------------------------------
+    Dim lSize As Long
+    Dim sPath As String
+    Dim sName As String
+    Dim lResult As Long
+    
+    sPath = Space(255)
+    lResult = GetTempPath(255, sPath)
+    sPath = Left$(sPath, lResult)
+    sName = Space(255)
+    lResult = GetTempFileName(sPath, "AEL", 0, sName)
+    lResult = InStr(sName, vbNullChar)
+    sName = Left$(sName, lResult - 1)
+    
+    GetTempFile = sName
+End Function
+

build-env/VisualStudio6/Common/Tools/APE/Source/Aemtssvc/ACCOUNT.CLS

@@ -0,0 +1,297 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "Account"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = True
+Attribute VB_Description = "APE MTS Transaction Service (Account)"
+Option Explicit
+
+Implements APEInterfaces.IMTSAccount
+
+Private Const E_NOTIMPL = &H80004001
+Private Const mlSTARTINGBALANCE = 1000000     ' Starting
+
+Public Sub Post(sConnect As String, eConnectOptions As ape_DbConnectionOptions, lAccountNo As Long, lAmount As Long)
+    '-------------------------------------------------------------------------
+    'Purpose:
+    '   Provides an interface for late binding.  Late binding is only provided
+    '   for test comparison.  Other custom services should only use the implemented
+    '   interface.
+    '-------------------------------------------------------------------------
+    IMTSAccount_Post sConnect, eConnectOptions, lAccountNo, lAmount
+End Sub
+
+Private Sub IMTSAccount_Post(sConnect As String, eConnectOptions As APEInterfaces.ape_DbConnectionOptions, lAccountNo As Long, lAmount As Long)
+    Dim lBalance As Long
+    Dim sSQLUpdate As String
+    Dim sSQLBalance As String
+    
+    ' Get our object context
+    Dim ctxObject As ObjectContext
+    Set ctxObject = GetObjectContext()
+    
+    sSQLUpdate = "UPDATE Account SET Balance = Balance + " + Str$(lAmount) + " WHERE AccountNo = " + Str$(lAccountNo)
+    sSQLBalance = "SELECT Balance FROM Account WHERE AccountNo = " + Str$(lAccountNo)
+    On Error GoTo PostError
+    
+    Select Case eConnectOptions
+        Case ape_DbConnectionOptions.ape_idcADO
+            If lAmount < 0 Then     ' If debit, then get balance
+                PostADO sConnect, sSQLUpdate, sSQLBalance, lBalance
+            Else
+                PostADO sConnect, sSQLUpdate, sSQLBalance
+            End If
+        Case ape_DbConnectionOptions.ape_idcRDO
+            If lAmount < 0 Then     ' If debit, then get balance
+                PostRDO sConnect, sSQLUpdate, sSQLBalance, lBalance
+            Else
+                PostRDO sConnect, sSQLUpdate, sSQLBalance
+            End If
+        Case ape_DbConnectionOptions.ape_idcDAO
+            If lAmount < 0 Then     ' If debit, then get balance
+                PostDAO sConnect, sSQLUpdate, sSQLBalance, lBalance
+            Else
+                PostDAO sConnect, sSQLUpdate, sSQLBalance
+            End If
+        Case ape_DbConnectionOptions.ape_idcODBC
+            If lAmount < 0 Then     ' If debit, then get balance
+                PostODBCAPI sConnect, sSQLUpdate, sSQLBalance, lBalance
+            Else
+                PostODBCAPI sConnect, sSQLUpdate, sSQLBalance
+            End If
+        Case Else
+            Err.Raise E_NOTIMPL
+    End Select
+    If lAmount < 0 And lBalance < 0 Then   ' If a debit and acount is overdrawn
+        IMTSAccount_Post sConnect, eConnectOptions, lAccountNo, mlSTARTINGBALANCE         ' Give a new starting balance
+    End If
+
+    ctxObject.SetComplete          ' Transaction completed
+    Exit Sub
+
+PostError:
+    Dim lErrorNumber As Long
+    Dim sErrorDescription As String
+    sErrorDescription = Err.Description
+    lErrorNumber = Err.Number
+    ctxObject.SetAbort              ' Transaction aborted
+    ' Need to explicitly set the error source to AEMTSSvc
+    Err.Raise lErrorNumber, "AEMTSSvc", LoadResString(ERROR_POSTING_TO_ACCOUNT) & " (" & sErrorDescription & ")"
+End Sub
+
+Private Sub PostADO(sConnect As String, sSQLUpdate As String, sSQLBalance As String, Optional lBalance As Long)
+    ' If adoConnection throws an exception
+    On Error GoTo PostadoError
+    
+    ' Obtain the ADO connection
+    Dim adoConn As New ADODB.Connection
+    adoConn.Open sConnect
+    
+    ' Update the balance
+    adoConn.Execute sSQLUpdate
+    If Not IsMissing(lBalance) Then
+        ' Get resulting balance which may have been further updated via triggers
+        Dim adoRS As ADODB.Recordset
+        Set adoRS = adoConn.Execute(sSQLBalance)
+        If Not adoRS.EOF Then
+            lBalance = adoRS.Fields("Balance").Value
+        Else
+            Err.Raise errInvalidAccount
+        End If
+        adoRS.Close
+    End If
+    
+    adoConn.Close
+    Exit Sub
+
+PostadoError:
+    Dim lErrorNumber As Long
+    Dim sErrorDescription As String
+    sErrorDescription = Err.Description
+    lErrorNumber = Err.Number
+    If Not adoRS Is Nothing Then
+        adoRS.Close
+    End If
+    If Not adoConn Is Nothing Then
+        adoConn.Close
+    End If
+    If lErrorNumber <> 0 Then
+        Err.Raise lErrorNumber, , sErrorDescription
+    End If
+End Sub
+
+Private Sub PostRDO(sConnect As String, sSQLUpdate As String, sSQLBalance As String, Optional lBalance As Long)
+    ' If rdoConnection throws an exception
+    On Error GoTo PostRDOError
+    
+    ' Obtain the RDO environment and connection
+    Dim rdoConn As rdoConnection
+    Set rdoConn = rdoEngine.rdoEnvironments(0).OpenConnection("", rdDriverNoPrompt, False, sConnect)
+
+    ' Update the balance
+    rdoConn.Execute sSQLUpdate
+  
+    If Not IsMissing(lBalance) Then
+        ' Get resulting balance which may have been further updated via triggers
+        Dim rdoRS As rdoResultset
+        Set rdoRS = rdoConn.OpenResultset(sSQLBalance)
+        If Not rdoRS.EOF Then
+            lBalance = rdoRS.rdoColumns("Balance")
+        Else
+            Err.Raise errInvalidAccount
+        End If
+        rdoRS.Close
+    End If
+    
+    rdoConn.Close
+    Exit Sub
+
+PostRDOError:
+    Dim lErrorNumber As Long
+    Dim sErrorDescription As String
+    sErrorDescription = Err.Description
+    lErrorNumber = Err.Number
+    If Not rdoRS Is Nothing Then
+        rdoRS.Close
+    End If
+    If Not rdoConn Is Nothing Then
+        rdoConn.Close
+    End If
+    If lErrorNumber <> 0 Then
+        Err.Raise lErrorNumber, , sErrorDescription
+    End If
+End Sub
+
+Private Sub PostDAO(sConnect As String, sSQLUpdate As String, sSQLBalance As String, Optional lBalance As Long)
+    ' If daoConnection throws an exception
+    On Error GoTo PostDAOError
+    
+    ' Obtain the DAO workspace and connection
+    Dim daoWorkspace As Workspace
+    Dim daoConn As Connection
+    Set daoWorkspace = CreateWorkspace("", "", "", dbUseODBC)
+    Set daoConn = daoWorkspace.OpenConnection("", dbDriverNoPrompt, False, "ODBC;" & sConnect)
+
+    ' Update the balance
+    daoConn.Execute sSQLUpdate
+  
+    If Not IsMissing(lBalance) Then
+        ' Get resulting balance which may have been further updated via triggers
+        Dim daoRS As Recordset
+        Set daoRS = daoConn.OpenRecordset(sSQLBalance)
+        If Not daoRS.EOF Then
+            lBalance = daoRS.Fields("Balance").Value
+        Else
+            Err.Raise errInvalidAccount
+        End If
+        daoRS.Close
+    End If
+    
+    daoConn.Close
+    Exit Sub
+
+PostDAOError:
+    Dim lErrorNumber As Long
+    Dim sErrorDescription As String
+    sErrorDescription = Err.Description
+    lErrorNumber = Err.Number
+    If Not daoRS Is Nothing Then
+        daoRS.Close
+    End If
+    If Not daoConn Is Nothing Then
+        daoConn.Close
+    End If
+    If lErrorNumber <> 0 Then
+        Err.Raise lErrorNumber, , sErrorDescription
+    End If
+End Sub
+
+Private Sub PostODBCAPI(sConnect As String, sSQLUpdate As String, sSQLBalance As String, Optional lBalance As Long)
+    ' Handles for the ODBC API calls
+    Dim hEnvironment As Long
+    Dim hConnection As Long
+    Dim hStatement As Long
+    Dim iConnectLength As Integer
+
+    On Error GoTo PostODBCAPIError
+    If Not ODBCAPICallSuccessful(SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, hEnvironment)) Then
+         Err.Raise ErrorAllocateHandle, , LoadResString(ErrorAllocateHandle)
+    End If
+    If Not ODBCAPICallSuccessful(SQLSetEnvAttrLong(hEnvironment, SQL_ATTR_ODBC_VERSION, SQL_OV_ODBC3, 0)) Then
+        Err.Raise ErrorSetAttribute, , LoadResString(ErrorSetAttribute)
+    End If
+    If Not ODBCAPICallSuccessful(SQLAllocHandle(SQL_HANDLE_DBC, hEnvironment, hConnection)) Then
+        Err.Raise ErrorAllocateHandle, , LoadResString(ErrorAllocateHandle)
+    End If
+
+    If Not ODBCAPICallSuccessful(SQLDriverConnect(hConnection, 0, sConnect, _
+            LenB(sConnect), vbNullString, 0, iConnectLength, SQL_DRIVER_NOPROMPT)) Then
+        Err.Raise ErrorConnectDriver, , LoadResString(ErrorConnectDriver)
+    End If
+    If Not ODBCAPICallSuccessful(SQLAllocHandle(SQL_HANDLE_STMT, hConnection, hStatement)) Then
+        Err.Raise ErrorAllocateHandle, , LoadResString(ErrorAllocateHandle)
+    End If
+    If Not ODBCAPICallSuccessful(SQLSetStmtAttrLong(hStatement, SQL_CURSOR_TYPE, SQL_CURSOR_STATIC, 0)) Then
+        Err.Raise ErrorSetAttribute, , LoadResString(ErrorSetAttribute)
+    End If
+    
+    If Not ODBCAPICallSuccessful(SQLExecDirect(hStatement, sSQLUpdate, Len(sSQLUpdate))) Then
+        ' See if the error is due to a resource deadlock
+        Dim iRecNum As Integer, iTextLen As Integer
+        Dim sSQLState As String * 5, sMsgText As String * 1
+        Dim lNativeErrorPtr As Long
+        iRecNum = 1
+        Do While ODBCAPICallSuccessful(SQLGetDiagRec(SQL_HANDLE_STMT, hStatement, iRecNum, sSQLState, lNativeErrorPtr, _
+                sMsgText, 0, iTextLen))
+            If sSQLState = "40001" Then
+                Err.Raise ErrorResourceDeadlock, , LoadResString(ErrorResourceDeadlock)
+            End If
+            iRecNum = iRecNum + 1
+        Loop
+        ' Else, raise generic error
+        Err.Raise ErrorExecuteQuery, , LoadResString(ErrorExecuteQuery)
+    End If
+    
+    If Not IsMissing(lBalance) Then
+        ' Get resulting balance
+        If Not ODBCAPICallSuccessful(SQLExecDirect(hStatement, sSQLBalance, Len(sSQLBalance))) Then
+             Err.Raise ErrorExecuteQuery, , LoadResString(ErrorExecuteQuery)
+        End If
+        
+        Select Case SQLFetchScroll(hStatement, SQL_FETCH_FIRST, 0)
+            Case SQL_NO_DATA
+                Err.Raise ErrorFetchRecord, , LoadResString(ErrorFetchRecord)
+            Case SQL_SUCCESS, SQL_SUCCESS_WITH_INFO
+                ' Do nothing
+            Case Else
+                 Err.Raise ErrorFetchRecord, , LoadResString(ErrorFetchRecord)
+        End Select
+
+        Dim lBalanceLength As Long
+        If Not ODBCAPICallSuccessful(SQLGetDataLong(hStatement, 1, SQL_INTEGER, lBalance, 0, lBalanceLength)) Then
+             Err.Raise ErrorGetData, , LoadResString(ErrorGetData)
+        End If
+    End If
+        
+PostODBCAPIError:
+    Dim lErrorNumber As Long
+    Dim sErrorDescription As String
+    sErrorDescription = Err.Description
+    lErrorNumber = Err.Number
+    SQLCloseCursor hStatement
+    SQLFreeHandle SQL_HANDLE_STMT, hStatement
+    SQLDisconnect hConnection
+    SQLFreeHandle SQL_HANDLE_DBC, hConnection
+    SQLFreeHandle SQL_HANDLE_ENV, hEnvironment
+    If lErrorNumber <> 0 Then
+        Err.Raise lErrorNumber, , sErrorDescription
+    End If
+End Sub

build-env/VisualStudio6/Common/Tools/APE/Source/Aemtssvc/AEMTSSVC.RC

@@ -0,0 +1,6 @@
+#include "..\AEInclud\ODBCAPI.rc"
+STRINGTABLE DISCARDABLE 
+BEGIN
+	1000	"Could not create account object"
+	1001	"Error posting to account"
+END

build-env/VisualStudio6/Common/Tools/APE/Source/Aemtssvc/AEMTSSVC.VBP

@@ -0,0 +1,54 @@
+Type=OleDll
+Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\STDOLE2.TLB#Standard OLE Types
+Reference=*\G{74C08640-CEDB-11CF-8B49-00AA00B8A790}#1.0#0#..\..\EXTERNAL\mtxas.tlb#Microsoft Transaction Server 1.0 Type Library
+Reference=*\G{EE008642-64A8-11CE-920F-08002B369A33}#2.0#0#C:\WINNT\system32\MSRDO20.DLL#Microsoft Remote Data Object 2.0
+Reference=*\G{00025E01-0000-0000-C000-000000000046}#4.0#0#C:\PROGRA~1\COMMON~1\MICROS~1\DAO\dao350.dll#Microsoft DAO 3.5 Object Library
+Reference=*\G{00000200-0000-0010-8000-00AA006D2EA4}#2.0#0#C:\Program Files\common files\system\ado\msado15C:\P#Microsoft ActiveX Data Objects 2.0 Library
+Reference=*\G{C93809A0-684C-11D1-9D3E-0020781039AF}#1.0#9#..\AEINTRFC\AEIntrfc.tlb#Application Performance Explorer 2.0 Interfaces
+Class=Account; Account.cls
+Class=MoveMoney; MoveMony.cls
+Module=ODBCAPI; ..\AEInclud\ODBCAPI.bas
+RelatedDoc=AEMTSSvc.rc
+Module=modMTSSvc; MTSSvc.bas
+ResFile32="AEMTSSvc.res"
+Startup="(None)"
+HelpFile=""
+Title="APE MTS Service"
+ExeName32="AEMTSSvc.dll"
+Path32="..\..\Retail"
+Command32=""
+Name="AEMTSSvc"
+HelpContextID="0"
+Description="Application Performance Explorer MTS Service"
+CompatibleMode="2"
+CompatibleEXE32="..\AECompat\AEMTSSvc.cmp"
+VersionCompatible32="1"
+MajorVer=2
+MinorVer=0
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+VersionCompanyName="Microsoft Corporation"
+VersionFileDescription="Application Performance Explorer MTS Service"
+VersionLegalCopyright="Copyright © 1996-1998 Microsoft Corp."
+VersionLegalTrademarks="Microsoft® is a registered trademark of Microsoft Corporation. Windows(TM) is a trademark of Microsoft Corporation"
+VersionProductName="Application Performance Explorer MTS Service"
+CompilationType=0
+OptimizationType=0
+FavorPentiumPro(tm)=0
+CodeViewDebugInfo=0
+NoAliasing=0
+BoundsCheck=0
+OverflowCheck=0
+FlPointCheck=0
+FDIVCheck=0
+UnroundedFP=0
+StartMode=1
+Unattended=-1
+Retained=0
+ThreadPerObject=0
+MaxNumberOfThreads=1
+DebugStartupOption=0
+
+[MS Transaction Server]
+AutoRefresh=1

build-env/VisualStudio6/Common/Tools/APE/Source/Aemtssvc/MOVEMONY.CLS

@@ -0,0 +1,58 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0   'False
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+END
+Attribute VB_Name = "MoveMoney"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = True
+Attribute VB_Description = "APE MTS Transaction Service (MoveMoney)"
+Option Explicit
+
+Implements APEInterfaces.IMTSMoveMoney
+
+Public Sub Transfer(sConnect As String, eConnectOptions As ape_DbConnectionOptions, lFromAccount As Long, lToAccount As Long, lAmount As Long)
+    '-------------------------------------------------------------------------
+    'Purpose:
+    '   Provides an interface for late binding.  Late binding is only provided
+    '   for test comparison.  Other custom services should only use the implemented
+    '   interface.
+    '-------------------------------------------------------------------------
+    IMTSMoveMoney_Transfer sConnect, eConnectOptions, lFromAccount, lToAccount, lAmount
+End Sub
+
+Private Sub IMTSMoveMoney_Transfer(sConnect As String, eConnectOptions As APEInterfaces.ape_DbConnectionOptions, lFromAccount As Long, lToAccount As Long, lAmount As Long)
+    ' get our object context
+    Dim ctxObject As ObjectContext
+    Set ctxObject = GetObjectContext()
+ 
+    On Error GoTo TransferError
+ 
+    ' create the account object using our context
+    Dim objAccount As APEInterfaces.IMTSAccount
+    Set objAccount = ctxObject.CreateInstance("AEMTSSvc.Account")
+    
+    If objAccount Is Nothing Then
+        Err.Raise errAccountCreateFailed, , LoadResString(ERROR_COULD_NOT_CREATE_ACCOUNT_OBJECT)
+    End If
+    
+    ' do the credit
+    objAccount.Post sConnect, eConnectOptions, lToAccount, lAmount
+    ' then do the debit
+    objAccount.Post sConnect, eConnectOptions, lFromAccount, -lAmount
+    ctxObject.SetComplete
+    Exit Sub
+ 
+TransferError:
+    Dim lErrorNumber As Long
+    Dim sErrorDescription As String
+    sErrorDescription = Err.Description
+    lErrorNumber = Err.Number
+    ctxObject.SetAbort
+    Err.Raise lErrorNumber, , sErrorDescription
+End Sub
+

build-env/VisualStudio6/Common/Tools/APE/Source/Aemtssvc/MTSSVC.BAS

@@ -0,0 +1,3 @@
+Attribute VB_Name = "modMTSSvc"
+Public Const ERROR_COULD_NOT_CREATE_ACCOUNT_OBJECT As Integer = 1000
+Public Const ERROR_POSTING_TO_ACCOUNT As Integer = 1001

build-env/VisualStudio6/Common/Tools/APE/Source/Aemtssvc/RC.BAT

@@ -0,0 +1,2 @@
+rc.exe /foAEMTSSvc.res AEMTSSvc.rc
+pause

build-env/VisualStudio6/Common/Tools/APE/Source/Aepool/AEPOOL.RC

@@ -0,0 +1,43 @@
+STRINGTABLE DISCARDABLE 
+BEGIN
+	1	"*** Do *NOT* Localize any string that starts with '***'.  They are comments to be used by localizers to identify sections.  They also mark the beginning of a new 'section' within the String Table."
+	2	"Pool Manager"
+	3	"GetWorker Method received"
+	4	"ReleaseWorker Method received"
+	11	"Call rejected retry"
+	12	"Because the specified authentication level is not supported on the remote machine, Worker will be created with no authentication on the machine, <NAME>."
+	13	"Only <NUMBER> workers were created and configured, because available machines were lacking."	
+	//Remote Worker creation error message
+	14	"Could not create or configure a worker on machine, <NAME>."	
+	//No errors creating remote workers message
+	15	"All requested workers were successfully created."
+	16	"Could not create or configure local worker object."
+	17	"Error: "
+
+	29	"*** Font information for all forms.  Index 30 is the Character set, Index 31 is Font name, Index 32 is Font Size"
+	30	"0"
+	31	"Tahoma"
+	32	"10"
+
+	49	"*** Form U/I captions"
+	50	"Requests Satisfied"
+	51	"Requests Rejected"	
+	52	"Number of Workers"
+	53	"Pool Manager"
+
+	200	"*** Racreg32 error codes with 200 added for offset"
+	201	"Unknown run time error occurred"
+	202	"No protocol was specified"
+	203	"No server machine name was specified"
+	204	"An error occurred reading from the registry"
+	205	"An error occurred writing to the registry"
+	206	"Both the ProgID and CLSID parameters were missing"
+	207	"There is no local server (either in-process or cross-process, 16-bit or 32-bit)"
+	208	"There was an error looking for the Proxy DLLs, check that they were installed properly"
+
+	32700	"*** Error Descriptions"
+	32750	"An error occurred changing server connection settings: <NAME>."
+
+	32765	"Invalid Parameter"
+	32764	"No Workers could be created."
+END

build-env/VisualStudio6/Common/Tools/APE/Source/Aepool/AEPOOL.VBP

@@ -0,0 +1,55 @@
+Type=OleExe
+Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\STDOLE2.TLB#OLE Automation
+Reference=*\G{244D13BD-AFDB-11CE-85D1-00AA00695286}#1.1#0#..\..\EXTERNAL\racreg32.dll#RacReg
+Reference=*\G{C93809A0-684C-11D1-9D3E-0020781039AF}#1.0#9#..\AEIntrfc\AEIntrfc.TLB#Application Performance Explorer 2.0 Interfaces
+Module=modPoolMgr; modpool.bas
+Form=frmpool.frm
+Class=Pool; pool.cls
+Class=PoolMgr; poolmgr.cls
+Module=modAEConstants; ..\AEInclud\modaecon.bas
+Class=clsPositionForm; ..\AEInclud\clsposfm.cls
+Class=clsWorker; ..\AEInclud\clsworkr.cls
+Module=modWin32Errors; ..\AEInclud\modwiner.bas
+Class=clsWorkerMachines; ..\AEInclud\clswkmac.cls
+Module=modVBErrors; ..\AEInclud\modvberr.bas
+Module=modAEGlobals; ..\AEInclud\modAEGlb.bas
+Module=Utility; ..\AEInclud\Utility.bas
+Module=Localize; ..\AEInclud\Localize.bas
+ResFile32="aepool.res"
+IconForm="frmPoolMgr"
+Startup="Sub Main"
+HelpFile=""
+Title="APE Pool Manager"
+ExeName32="AEPool.exe"
+Path32="..\..\Retail"
+Command32=""
+Name="AEPoolMgr"
+HelpContextID="0"
+Description="Application Performance Explorer Pool Manager"
+CompatibleMode="1"
+CompatibleEXE32="..\AECompat\AEPool.cmp"
+MajorVer=2
+MinorVer=0
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+VersionCompanyName="Microsoft Corporation"
+VersionFileDescription="Application Performance Explorer Pool Manager"
+VersionLegalCopyright="Copyright © 1996-1998 Microsoft Corp."
+VersionLegalTrademarks="Microsoft® is a registered trademark of Microsoft Corporation. Windows(TM) is a trademark of Microsoft Corporation"
+VersionProductName="Application Performance Explorer Pool Manager"
+CompilationType=0
+OptimizationType=0
+FavorPentiumPro(tm)=0
+CodeViewDebugInfo=0
+NoAliasing=0
+BoundsCheck=0
+OverflowCheck=0
+FlPointCheck=0
+FDIVCheck=0
+UnroundedFP=0
+StartMode=1
+Unattended=0
+ThreadPerObject=0
+MaxNumberOfThreads=1
+DebugStartupOption=0