Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "TSAPIv4p2Migration"
Option Explicit

Private Const CURRENT_TSAPI_VERSION_NUMBER As String = "5.0"
Private Const TSAPI_CUSTOM_PROPERTY_NAME As String = "Bloomberg Trading System API Version"
Private Const TSAPI_V4p2_QUERY_DATA As String = "TSAPIX"
Private Const TSAPI_V4p2_QUERY_FORMULA_NAME As String = "PutShowType"
Private Const TSAPI_V4p2_FIELD_FORMULA_NAME As String = "PutFieldHeader"
Public Const TSAPI_V4p2_SESSION_NAME As String = "TSXAPIX"

' indexes for parameters in the array.
Private Const PARM_INDEX_FOR_CURRENCY As Integer = 0
Private Const PARM_INDEX_FOR_SECURITYNAMEFORMAT As Integer = 1
Private Const PARM_INDEX_FOR_SECURITYFILTER As Integer = 2
Private Const PARM_INDEX_FOR_REQUESTTYPE As Integer = 3
Private Const PARM_INDEX_FOR_REPORTVALUETYPE As Integer = 4
Private Const PARM_INDEX_FOR_POSITIONINTHOUSANDS As Integer = 5
Private Const PARM_INDEX_FOR_SECONDRISK As Integer = 6
Private Const PARM_INDEX_FOR_MULTICURRENCY As Integer = 7
Private Const PARM_INDEX_FOR_USERLOGINID As Integer = 8
Private Const PARM_INDEX_FOR_BOOKNAME As Integer = 9
Private Const PARM_INDEX_FOR_POLLINGFREQUENCY As Integer = 10


Private Function GetCustomDocumentproperty(myWorkbook As Workbook, docPropertyName As String) As DocumentProperty
    
    errLogger.Log "In GetCustomDocumentproperty"
    
    Dim docProperty As DocumentProperty
    For Each docProperty In myWorkbook.CustomDocumentProperties
        If InStr(1, docProperty.Name, docPropertyName, vbTextCompare) > 0 Then
            Set GetCustomDocumentproperty = docProperty
            Exit Function
        End If
    Next
    Set GetCustomDocumentproperty = Nothing
    
    errLogger.Log "Out GetCustomDocumentproperty"
    
End Function

Public Function UpgradeWorkbookToLatestTSAPIVersionIfNecessary(myWorkbook As Workbook) As Boolean

    errLogger.Log "In UpgradeWorkbookToLatestTSAPIVersionIfNecessary"
    
    Dim bSuccess As Boolean
    If IsUpgradeNecessary(myWorkbook) = True Then
        Dim answer As Long
        answer = MsgBox("This Excel workbook was created with an older version of Bloomberg Trading System Excel Addin. " + Chr(13) + _
                        "The workbook will be:" + Chr(13) + "-  Upgraded to the latest version (TS API v5.0), and" + Chr(13) + "-  A backup of the current version will be saved as '" + _
                        Left(myWorkbook.Name, Len(myWorkbook.Name) - 4) + ".TSAPI_V4.2.xls' " + Chr(13) + vbCrLf + "Would you like to proceed?", vbOKCancel, "Bloomberg Trading System API ")
        
        If answer = vbCancel Then
            Call myWorkbook.Close(SaveChanges:=False)
        ElseIf answer = vbOK Then
            On Error GoTo HandleConversionErrors
                ConvertThisWorkbookToLatestVersion myWorkbook
                Call myWorkbook.Save
                bSuccess = True
                MsgBox "Excel workbook was upgraded to TS API v5.0 successfully.", vbOKOnly, "Bloomberg TS API v5.0 Upgrade"
                
                errLogger.Log "Out UpgradeWorkbookToLatestTSAPIVersionIfNecessary - Success"
                
                UpgradeWorkbookToLatestTSAPIVersionIfNecessary = bSuccess
                Exit Function
                
HandleConversionErrors:
                bSuccess = False
                UpgradeWorkbookToLatestTSAPIVersionIfNecessary = bSuccess
                Call errLogger.DisplayErrorMessage("Conversion was unsuccessful. The following error was returned. The workbook will be closed without saving changes." _
                    + vbCrLf + Err.Description, "UpgradeWorkbookToLatestTSAPIVersionIfNecessary")
                Call myWorkbook.Close(SaveChanges:=False)
                errLogger.Log "Out UpgradeWorkbookToLatestTSAPIVersionIfNecessary - Failure"
        End If
    Else
        bSuccess = True ' No upgrade was necessary
        UpgradeWorkbookToLatestTSAPIVersionIfNecessary = bSuccess
    End If
End Function

Private Function IsUpgradeNecessary(myWorkbook As Workbook) As Boolean
    
    errLogger.Log "In IsUpgradeNecessary"
    
    Dim bAnswer As Boolean
    Dim customProp As DocumentProperty
    Dim versionNumber As Double
    versionNumber = 0
   
    Set customProp = GetCustomDocumentproperty(myWorkbook, TSAPI_CUSTOM_PROPERTY_NAME)
    If Not customProp Is Nothing Then
        versionNumber = val(customProp.value)
    End If

    If (customProp Is Nothing And DoesWorkbookContainTSAPIInformation(myWorkbook) = True) _
        Or (versionNumber > 0 And versionNumber < val(CURRENT_TSAPI_VERSION_NUMBER)) Then
        bAnswer = True
    End If
    
    IsUpgradeNecessary = bAnswer
    errLogger.Log "Out IsUpgradeNecessary"
    
End Function

Public Sub ConvertThisWorkbookToLatestVersion(myWorkbook As Workbook)

    errLogger.Log "In ConvertThisWorkbookToLatestVersion"
        
        CreateBackupCopyOfThisWorkbook myWorkbook
        
        ConverThisWorkbookToTSAPI5p0 myWorkbook
        
        StoreLatestVersionInformation myWorkbook

    errLogger.Log "Out ConvertThisWorkbookToLatestVersion"
    
End Sub

Public Sub StoreLatestVersionInformation(myWorkbook As Workbook)

    errLogger.Log "In StoreLatestVersionInformation"

    Dim customProp As DocumentProperty
    
    Set customProp = GetCustomDocumentproperty(myWorkbook, TSAPI_CUSTOM_PROPERTY_NAME)
    If customProp Is Nothing Then
         myWorkbook.CustomDocumentProperties.Add Name:=TSAPI_CUSTOM_PROPERTY_NAME, LinkToContent:=False, Type:=msoPropertyTypeString, value:=""
        Set customProp = GetCustomDocumentproperty(myWorkbook, TSAPI_CUSTOM_PROPERTY_NAME)
    End If
    customProp.value = CURRENT_TSAPI_VERSION_NUMBER
    
    errLogger.Log "Out StoreLatestVersionInformation"
    
End Sub

Public Sub CreateBackupCopyOfThisWorkbook(myWorkbook As Workbook)

    errLogger.Log "In CreateBackupCopyOfThisWorkbook"
    
    Dim fName, ChkFile  As Variant
    Dim DoubleCheck As Long


'SaveAgain:
'    fName = Application.GetSaveAsFilename(InitialFileName:=Left(myWorkbook.Name, InStr(1, LCase(myWorkbook.Name), ".xls") - 1) & _
'            ".TSAPI_V4.2" & ".xls", _
'            fileFilter:="Excel Files (*.xls), *.xls")
'    If fName = False Then
'        MsgBox "Please specify a backup name for this file!", vbCritical
'        GoTo SaveAgain
'    End If
'
'    If VarType(fName) = vbBoolean Then Exit Sub
'
'    'Use Dir function to see if file already exists.
'    ChkFile = Dir(fName, vbNormal)
'    If ChkFile <> "" Then
'        DoubleCheck = MsgBox("The file " & ChkFile & _
'        " already exists. Do you want to replace the existing file?", _
'        vbYesNo + vbExclamation)
'
'        'Delete existing file if overwrite is confirmed
'        If DoubleCheck = vbYes Then
'            Kill (fName)
'        Else
'            GoTo SaveAgain
'        End If
'    End If
'
'    myWorkbook.SaveCopyAs fileName:=fName

    myWorkbook.SaveCopyAs fileName:=Left(myWorkbook.FullName, InStr(1, LCase(myWorkbook.FullName), ".xls") - 1) & ".TSAPI_V4.2" & ".xls"
    
    errLogger.Log "Out CreateBackupCopyOfThisWorkbook"
    
End Sub


Public Function ConverThisWorkbookToTSAPI5p0(myWorkbook As Workbook) As Boolean
    
    errLogger.Log "In ConverThisWorkbookToTSAPI5p0"
    
    Dim wrkSheet As Worksheet
    
    ConverThisWorkbookToTSAPI5p0 = False
    
    For Each wrkSheet In myWorkbook.Worksheets
        ConvertSessionInformation wrkSheet
        ConvertQueryInformation wrkSheet
        
    Next wrkSheet
    
    errLogger.Log "Out ConverThisWorkbookToTSAPI5p0"
    
End Function


Public Sub ConvertSessionInformation(myWorksheet As Worksheet)

    errLogger.Log "In ConvertSessionInformation"
    
    Dim worksheetname As Name
    
    For Each worksheetname In myWorksheet.Names
        If InStr(1, worksheetname.Name, TSAPI_V4p2_SESSION_NAME, vbTextCompare) > 0 Then
            'We are translating from: ="RETAIL290,QC retail system"    to:  ="Production,RETAIL290,QC portfolio system"
'              worksheetname.RefersTo = "=""Production," & Right(worksheetname.RefersTo, Len(worksheetname.RefersTo) - 2)
                worksheetname.RefersTo = ""
            Exit Sub      'Because we have one session per sheet
        End If
    Next
    
    errLogger.Log "Out ConvertSessionInformation"
    
End Sub

Public Function ConvertQueryInformation(myWorksheet As Worksheet)

    errLogger.Log "In ConvertQueryInformation"

    Dim localName As Name
    Dim cellNameContainingFormula As String
    Dim formulaToBeConverted As String
    Dim oldParameterArray() As String
    Dim newParameterArray() As String
    
    Dim formulaParameters As String
    Dim formula As String
'    Dim nameForTSAPIQuery As Name
    
    For Each localName In myWorksheet.Names
        If InStr(1, localName.Name, TSAPI_V4p2_QUERY_DATA, vbTextCompare) > 0 Then
            cellNameContainingFormula = Right(localName.Name, Len(localName.Name) - (InStr(1, localName.Name, TSAPI_V4p2_QUERY_DATA, vbTextCompare) + Len(TSAPI_V4p2_QUERY_DATA) - 1))
            Dim tmpCell As Range
            Set tmpCell = myWorksheet.Cells(Range(cellNameContainingFormula).Row, Range(cellNameContainingFormula).Column)
            If CellContainsTSAPIFormula(tmpCell) = True Then
                formulaToBeConverted = tmpCell.formula
            Else
                ' The user has moved the formula to another row
                For Each tmpCell In myWorksheet.Cells.SpecialCells(xlCellTypeFormulas).Cells
                    If CellContainsTSAPIFormula(tmpCell) = True Then
                        cellNameContainingFormula = tmpCell.Address
                        formulaToBeConverted = tmpCell.formula
                    End If
                Next
            End If
            Exit For ' We are assured that there can be only one query per sheet.
        End If
    Next
    
    If formulaToBeConverted = "" Then
        ' There were no TSAPI queries in the sheet. Nothing to convert.
        Exit Function
    End If
    
'    ' Strip off the =" at the beginning, remove the function name and get the string of parameters.
'    cellNameContainingFormula = Right(nameForTSAPIQuery.Name, Len(nameForTSAPIQuery.Name) - (InStr(1, nameForTSAPIQuery.Name, TSAPI_V4p2_QUERY_DATA, vbTextCompare) + Len(TSAPI_V4p2_QUERY_DATA) - 1))
'    formulaToBeConverted = myWorksheet.Cells(Range(cellNameContainingFormula).Row, Range(cellNameContainingFormula).Column).formula
    
    oldParameterArray = GetFormulaParametersAsAnArray(formulaToBeConverted)
    
    Call AddPollingfrequencyIfNecessary(oldParameterArray)

    newParameterArray = ConvertedToNewParameterArray(oldParameterArray)
    
    Call ReplaceQueryFormula(newParameterArray, cellNameContainingFormula, myWorksheet)
    
    Call ReplaceFieldsNamesFormula(myWorksheet, cellNameContainingFormula)
    
    errLogger.Log "Out ConvertQueryInformation"
    
End Function

Private Function CellContainsTSAPIFormula(cellToCheck As Range) As Boolean
    errLogger.Log "In CellContainsTSAPIFormula - success"
    
    On Error GoTo HandleErrors
    Dim bContainsTSAPIFormula As Boolean
    
    If cellToCheck.HasFormula = True Then
        If InStr(1, cellToCheck.formula, "PutShowType", vbTextCompare) > 0 Then
            bContainsTSAPIFormula = True
        End If
    End If
    
    CellContainsTSAPIFormula = bContainsTSAPIFormula
    
    errLogger.Log "Out CellContainsTSAPIFormula - success"
    Exit Function
    
HandleErrors:
    CellContainsTSAPIFormula = bContainsTSAPIFormula
    errLogger.Log "Out CellContainsTSAPIFormula - failure"
End Function

Private Sub ReplaceQueryFormula(newParameterArray() As String, cellNameContainingFormula As String, myWorksheet As Worksheet)
    
    errLogger.Log "In ReplaceQueryFormula"
    
    Dim formula As String
    Dim convertedFormula As String

    'Compose the formula
    formula = Chr(34) & newParameterArray(PARM_INDEX_FOR_CURRENCY) & "," & _
                        newParameterArray(PARM_INDEX_FOR_SECURITYNAMEFORMAT) & "," & _
                        newParameterArray(PARM_INDEX_FOR_SECURITYFILTER) & "," & _
                        newParameterArray(PARM_INDEX_FOR_REQUESTTYPE) & "," & _
                        newParameterArray(PARM_INDEX_FOR_REPORTVALUETYPE) & "," & _
                        newParameterArray(PARM_INDEX_FOR_POSITIONINTHOUSANDS) & "," & _
                        newParameterArray(PARM_INDEX_FOR_SECONDRISK) & "," & _
                        newParameterArray(PARM_INDEX_FOR_MULTICURRENCY) & "," & _
                        newParameterArray(PARM_INDEX_FOR_USERLOGINID) & "," & _
                        Left(newParameterArray(PARM_INDEX_FOR_BOOKNAME), 2) & TSAPIBookstoExcel(Right(newParameterArray(PARM_INDEX_FOR_BOOKNAME), Len(newParameterArray(PARM_INDEX_FOR_BOOKNAME)) - 2)) & "," & _
                        newParameterArray(PARM_INDEX_FOR_POLLINGFREQUENCY) & Chr(34)
       
    convertedFormula = "=GetTSAPIQueryData(" & formula & ")"
    
    'Write formula to the cell
    myWorksheet.Cells(Range(cellNameContainingFormula).Row, Range(cellNameContainingFormula).Column).NumberFormat = "General"
    myWorksheet.Cells(Range(cellNameContainingFormula).Row, Range(cellNameContainingFormula).Column).formula = convertedFormula
    Call myWorksheet.Cells(Range(cellNameContainingFormula).Row, Range(cellNameContainingFormula).Column).Calculate
    
    errLogger.Log "Out ReplaceQueryFormula"
    
End Sub

Private Sub ReplaceFieldsNamesFormula(myWorksheet As Worksheet, cellNameContainingFormula As String)

    errLogger.Log "In ReplaceFieldsNamesFormula"
    
    Dim fieldsNamesRange As Range
    Dim myCell As Range
    Dim newFieldsNamesFormula As String
    Dim formulaParameters() As String
    
   
    Set fieldsNamesRange = myWorksheet.Range(myWorksheet.Cells(Range(cellNameContainingFormula).Row, myWorksheet.Range(cellNameContainingFormula).Column + 1), myWorksheet.Cells(Range(cellNameContainingFormula).Row, myWorksheet.Columns.Count))
    
    For Each myCell In fieldsNamesRange
        If InStr(1, myCell.formula, TSAPI_V4p2_FIELD_FORMULA_NAME, vbTextCompare) Then
            formulaParameters = Split(myCell.formula, TSAPI_V4p2_FIELD_FORMULA_NAME)
            newFieldsNamesFormula = "=TSAPIFieldName" & formulaParameters(1)   'Replace(myCell.formula, TSAPI_V4p2_FIELD_FORMULA_NAME, "=TSAPIFieldName")
            myCell.formula = newFieldsNamesFormula
        End If
    Next myCell
    
    errLogger.Log "Out ReplaceFieldsNamesFormula"
    
End Sub


Private Function ConvertedToNewParameterArray(oldParameterArray() As String) As String()
    errLogger.Log "In ConvertedToNewParameterArray"
    
    'IMPORTANT!!
    'Note : This method assumes that the indexes of parameter values are the same between old and new versions
    
    Dim newParameterArray() As String
    ReDim newParameterArray(UBound(oldParameterArray, 1))
    Dim i As Integer
    
    For i = LBound(oldParameterArray, 1) To UBound(oldParameterArray, 1)
        Select Case i
            Case PARM_INDEX_FOR_CURRENCY:
                newParameterArray(PARM_INDEX_FOR_CURRENCY) = oldParameterArray(PARM_INDEX_FOR_CURRENCY)
            
            Case PARM_INDEX_FOR_SECURITYNAMEFORMAT:
                newParameterArray(PARM_INDEX_FOR_SECURITYNAMEFORMAT) = GetNewSecurityNameFormat(oldParameterArray(PARM_INDEX_FOR_SECURITYNAMEFORMAT))
                
            Case PARM_INDEX_FOR_SECURITYFILTER:
                newParameterArray(PARM_INDEX_FOR_SECURITYFILTER) = GetNewSecurityFilter(oldParameterArray(PARM_INDEX_FOR_SECURITYFILTER))
                
            Case PARM_INDEX_FOR_REQUESTTYPE:
                newParameterArray(PARM_INDEX_FOR_REQUESTTYPE) = GetNewRequestType(oldParameterArray(PARM_INDEX_FOR_REQUESTTYPE))

            Case PARM_INDEX_FOR_REPORTVALUETYPE:
                newParameterArray(PARM_INDEX_FOR_REPORTVALUETYPE) = GetNewReportValueType(oldParameterArray(PARM_INDEX_FOR_REPORTVALUETYPE))
            
            Case PARM_INDEX_FOR_POSITIONINTHOUSANDS:
                newParameterArray(PARM_INDEX_FOR_POSITIONINTHOUSANDS) = GetNewPositionInThousands(oldParameterArray(PARM_INDEX_FOR_POSITIONINTHOUSANDS))
            
            Case PARM_INDEX_FOR_SECONDRISK:
                newParameterArray(PARM_INDEX_FOR_SECONDRISK) = GetNewSecondRisk(oldParameterArray(PARM_INDEX_FOR_SECONDRISK))
            
            Case PARM_INDEX_FOR_MULTICURRENCY:
                newParameterArray(PARM_INDEX_FOR_MULTICURRENCY) = GetNewMultiCurrency(oldParameterArray(PARM_INDEX_FOR_MULTICURRENCY))
            
            Case PARM_INDEX_FOR_USERLOGINID:
                newParameterArray(PARM_INDEX_FOR_USERLOGINID) = oldParameterArray(PARM_INDEX_FOR_USERLOGINID)

            Case PARM_INDEX_FOR_BOOKNAME
                newParameterArray(PARM_INDEX_FOR_BOOKNAME) = oldParameterArray(PARM_INDEX_FOR_BOOKNAME)

            Case PARM_INDEX_FOR_POLLINGFREQUENCY
                newParameterArray(PARM_INDEX_FOR_POLLINGFREQUENCY) = oldParameterArray(PARM_INDEX_FOR_POLLINGFREQUENCY)
        End Select
   Next i
    
    ConvertedToNewParameterArray = newParameterArray

    errLogger.Log "Out ConvertedToNewParameterArray"
    
End Function

Private Function GetFormulaParametersAsAnArray(commaDelimitedParameters As String) As String()
    
    errLogger.Log "In GetFormulaParametersAsAnArray"
    
    Dim formulaParameters() As String
    
    formulaParameters = Split(commaDelimitedParameters, """")
    GetFormulaParametersAsAnArray = VBA.Split(formulaParameters(1), ",")

'    formulaParameters = Replace(commaDelimitedParameters, TSAPI_V4p2_QUERY_FORMULA_NAME, "")
'    formulaParameters = Right(formulaParameters, Len(formulaParameters) - 2) 'Trim "( from the string
'    formulaParameters = Left(formulaParameters, Len(formulaParameters) - 2) 'Trim )" from the string
    
    errLogger.Log "Out GetFormulaParametersAsAnArray"
    
End Function

Private Function AddPollingfrequencyIfNecessary(parameterArray() As String)

    errLogger.Log "In AddPollingfrequencyIfNecessary"
    
    'Polling was not originally supported and hence some of the formulas may have only
    '9 parameters. Add polling frequency as the 10th parameter if it doesn't exist.
    If UBound(parameterArray, 1) = 9 Then
        ReDim Preserve parameterArray(UBound(parameterArray, 1) + 1)
        parameterArray(UBound(parameterArray, 1)) = 0
    End If
    
    errLogger.Log "Out AddPollingfrequencyIfNecessary"
    
End Function

Private Function GetNewSecurityNameFormat(oldSecurityNameFormatValue As String) As String
    
    errLogger.Log "In GetNewSecurityNameFormat"
    
    'Modify SecurityNameFormat::  <SecurityNameFormat>ShortTickerCoupon or LongName or Identifier or LongCouponMaturityOrder or LongNameCouponMaturityOrder or TickerCouponMaturityCouponDateOrder</securityNameFormat>
    Select Case oldSecurityNameFormatValue
        Case "1":
            GetNewSecurityNameFormat = "ShortTickerCoupon"
        Case "2":
            GetNewSecurityNameFormat = "LongName"
        Case "3":
            GetNewSecurityNameFormat = "Identifier"
        Case "4":
            GetNewSecurityNameFormat = "LongCouponMaturityOrder"
        Case "5":
            GetNewSecurityNameFormat = "LongNameCouponMaturityOrder"
        Case "6":
            GetNewSecurityNameFormat = "TickerCouponMaturityCouponDateOrder"
    End Select
    
    errLogger.Log "Out GetNewSecurityNameFormat"
    
End Function

Private Function GetNewSecurityFilter(oldSecurityFilterValue As String) As String
    
    errLogger.Log "In GetNewSecurityFilter"
    
    'Modify SecurityFilter:: <securityFilter>All or Position or Market or MTDCombinedMVDIE or MTDIndividualMVDIE or YTDCombinedMVDIE or YTDIndividualMVDIE</securityFilter>
    If oldSecurityFilterValue = "1" Then
        GetNewSecurityFilter = "All"
    ElseIf oldSecurityFilterValue = "2" Then
        GetNewSecurityFilter = "Position"
    ElseIf oldSecurityFilterValue = "3" Then
        GetNewSecurityFilter = "Market"
    End If
    
    errLogger.Log "Out GetNewSecurityFilter"
    
End Function


Private Function GetNewRequestType(oldSecurityRequestTypeValue As String) As String
    errLogger.Log "In GetNewRequestType"
    
    '<requestType>Trader or Security or MultiCurrency</requestType>
    If oldSecurityRequestTypeValue = "0" Then
        GetNewRequestType = "Trader"
    ElseIf oldSecurityRequestTypeValue = "1" Then
        GetNewRequestType = "Security"
    End If
    
    errLogger.Log "Out GetNewRequestType"
End Function


Private Function GetNewReportValueType(oldSecurityReportValueType As String) As String
  
    errLogger.Log "In GetNewReportValueType"
  
    'Modify ValueType:: <reportValueType>Cash or NumberOfContracts</reportValueType>
    If oldSecurityReportValueType = "0" Or UCase(oldSecurityReportValueType) = UCase("False") Then
        GetNewReportValueType = "Cash"
    ElseIf oldSecurityReportValueType = "1" Or UCase(oldSecurityReportValueType) = UCase("True") Then
        GetNewReportValueType = "NumberOfContracts"
    End If
    
    errLogger.Log "Out GetNewReportValueType"
    
End Function


Private Function GetNewPositionInThousands(oldSecurityPositionInThousands As String) As String
    
    errLogger.Log "In GetNewPositionInThousands"
    
    'Modify PositionsInThousands:: <reportPositionsInThousands>string</reportPositionsInThousands>
    If oldSecurityPositionInThousands = "0" Or UCase(oldSecurityPositionInThousands) = UCase("False") Then
        GetNewPositionInThousands = "False"
    ElseIf oldSecurityPositionInThousands = "1" Or UCase(oldSecurityPositionInThousands) = UCase("True") Then
        GetNewPositionInThousands = "True"
    End If
    
    errLogger.Log "Out GetNewPositionInThousands"
    
End Function


Private Function GetNewSecondRisk(oldSecondRiskValue As String) As String

    errLogger.Log "In GetNewSecondRisk"

    'Modify SecondRisk::  <reportSecondRisk>string</reportSecondRisk>
    If oldSecondRiskValue = "0" Or UCase(oldSecondRiskValue) = UCase("False") Then
        GetNewSecondRisk = "False"
    ElseIf oldSecondRiskValue = "1" Or UCase(oldSecondRiskValue) = UCase("True") Then
        GetNewSecondRisk = "True"
    End If
    
    errLogger.Log "Out GetNewSecondRisk"
    
End Function


Private Function GetNewMultiCurrency(oldMultiCurrencyValue As String) As String

    errLogger.Log "In GetNewMultiCurrency"
    
    'Modify MultiCurrency::
    If oldMultiCurrencyValue = "0" Or UCase(oldMultiCurrencyValue) = UCase("False") Then
        GetNewMultiCurrency = "False"
    ElseIf oldMultiCurrencyValue = "1" Or UCase(oldMultiCurrencyValue) = UCase("True") Then
        GetNewMultiCurrency = "True"
    End If
    
    errLogger.Log "Out GetNewMultiCurrency"
    
End Function


Public Function DoesWorkbookContainTSAPIInformation(myWorkbook As Workbook) As Boolean
    
    errLogger.Log "In DoesWorkbookContainTSAPIInformation"
    
    'Note: All workbooksthat have TSAPI queries and/or sessions will have seession info
    ' stored. So we just check that.
    
    Dim myWorksheet As Worksheet
    Dim localNames As Name
    
    DoesWorkbookContainTSAPIInformation = False
    For Each myWorksheet In myWorkbook.Worksheets
        For Each localNames In myWorksheet.Names
            If InStr(1, localNames.Name, TSAPI_V4p2_QUERY_DATA, vbTextCompare) > 0 Or _
               InStr(1, localNames.Name, TSAPI_V4p2_SESSION_NAME, vbTextCompare) > 0 Then
                DoesWorkbookContainTSAPIInformation = True
                Exit Function
            End If
        Next
    Next
    
    errLogger.Log "Out DoesWorkbookContainTSAPIInformation"
End Function



Attribute VB_Name = "TSAPIWebSvcProxy"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit

'Private Declare Function InitBLPWebSvc Lib "..\activex\BlpWebSvc.dll" _
'(ByVal WebSvcNamespace As String, ByVal TimeOut As Long) As Long

Private Declare Function InitBLPWebSvc Lib "..\activex\tssoap1.dll" _
(ByVal WebSvcNamespace As String, ByVal TimeOut As Long) As Long

'Private Declare Function ExecuteMethod Lib "..\activex\BlpWebSvc.dll" _
'(ByVal WebSvcControl As Long, ByVal EndPointURL As String, ByVal WebMethod As String, _
'ByVal argNames As Variant, ByVal argValues As Variant) As MSXML2.DOMDocument

Private Declare Function ExecuteMethod Lib "..\activex\tssoap1.dll" _
(ByVal WebSvcControl As Long, ByVal EndPointURL As String, ByVal WebMethod As String, _
ByVal argNames As Variant, ByVal argValues As Variant) As MSXML2.DOMDocument

'Private Declare Function DeleteBLPWebSvc Lib "..\activex\BlpWebSvc.dll" _
'(ByVal WebSvcControl As Long) As Long

Private Declare Function DeleteBLPWebSvc Lib "..\activex\tssoap1.dll" _
(ByVal WebSvcControl As Long) As Long

'Web Service Parameters
Private SzWebSvc As String
Private WebSvcCtrl As Long

'Web Service Parameter Names
Private Const SERVICE_PROVIDER As String = "serviceProvider"
Private Const SELECTED_FIRM_WITH_UPPERCASE_F As String = "Firm" 'GetUserEntityListCall, when we request a list of departments requires lowercase f
Private Const SELECTED_FIRM_WITH_LOWERCASE_F As String = "firm" 'GetUserEntityChildNodesCall, when we request a list of traders in department requires uppercase F
Private Const TASK_ID As String = "taskId"
Private Const ENTITY_TYPE As String = "entityType"
Private Const ENTITY_NAME As String = "entityName"

'Web Service Reply tag names
'Private Const USER_FIRM_REPLY As String = "UserFirmsReply"
Private Const USER_ENTITY_SUBMIT_TASK_REPLY As String = "SubmitTaskReply"
Private Const USER_TASK_STATUS_REPLY As String = "TaskStatusReply"
Private Const USER_CANCEL_TASK_REPLY As String = "CancelTaskReply"
Private Const USER_TASK_DATA_REPLY As String = "TaskDataReply"
Private Const REG_KEY_FOR_CONNECTION_WIZARD As String = "SOFTWARE\Bloomberg L.P.\Connection Wizard\"
Private Const REG_NAME_FOR_WEB_SERVICE_PORT_NUMBER As String = "Local HTTP Proxy Port"
Private Const REG_NAME_FOR_IP_OVERRIDE As String = "SSL IP"

Private Const XPATH_SERVICESTATUS_CODE_NODE_FULLPATH As String = "//Header/ServiceStatus/Code" 'This XPath expression is CASE SENSITIVE

Private Const DEFAULT_PORT_NUMBER As Integer = 8290

Private Sub Class_Initialize()
    
    errLogger.Log "In TSAPIWebSvcProxy - Initialize"
    
    Call InitializeWebService
    
    errLogger.Log "Out TSAPIWebSvcProxy - Initialize"
    
End Sub

Public Function DumpStateAsString() As String
    
    DumpStateAsString = "WebSvcCtrl = " + CStr(WebSvcCtrl) + vbCrLf + _
                        "url = " + SzWebSvc
                        
End Function

Private Function InitializeWebService()
    errLogger.Log "In InitializeWebService"
    
    Dim myPort As String
    
    WebSvcCtrl = InitBLPWebSvc(WebSvcNamespace:="urn:bloomberg.tradingsystems.services.data.v1", TimeOut:=90000)
    If (WebSvcCtrl = 0) Then
        Call errLogger.LogWarning("InitializeWebService -- " + DumpStateAsString)
        Call errLogger.DisplayErrorMessage("An error occured while establishing a connection to Bloomberg Trading System. Please try again. ", "InitializeWebService")
        'MsgBox "An error occured while establishing a connection to Bloomberg Trading System. Please try again. "
    End If
    
    Dim portNumber As Integer
    portNumber = GetPortNumber
    If portNumber = 0 Then
        portNumber = DEFAULT_PORT_NUMBER
    End If
    
    myPort = CStr(portNumber)
    'Blade/development
    'SzWebSvc = "http://172.17.2.50/webservices/TradingSystems/TradingSystemsDataService/TradingSystemsDataService.asmx"

    'Production
    SzWebSvc = "http://127.0.0.1:" & myPort & "/webservices/faweb/tradingsystems/TradingSystemsDataService.asmx"

    errLogger.Log "Out InitializeWebService"
End Function

Private Function GetPortNumber() As Long
    errLogger.Log "In GetPortNumber"
    
    DeleteRegistryValue REG_KEY_FOR_CONNECTION_WIZARD, REG_NAME_FOR_IP_OVERRIDE
    
    GetPortNumber = QueryValue(REG_KEY_FOR_CONNECTION_WIZARD, REG_NAME_FOR_WEB_SERVICE_PORT_NUMBER)
    
    errLogger.Log "Out GetPortNumber"
    
End Function

Public Function GetUserFirmList(ServiceProvider As String) As MSXML2.DOMDocument
    
    errLogger.Log "In GetUserFirmList"
    
    Dim xmlResponse As MSXML2.DOMDocument
    Dim argNames As Variant
    Dim argValues As Variant
    
    argNames = Array(SERVICE_PROVIDER)
    argValues = Array(ServiceProvider)
    
    Set xmlResponse = ExecuteMethodOnWebService("GetUserFirmsCall", argNames, argValues)
    If Not xmlResponse Is Nothing Then Set GetUserFirmList = xmlResponse 'xmlResponse.getElementsByTagName(USER_FIRM_REPLY)
    
    errLogger.Log "Out GetUserFirmList"
    
End Function

Public Function GetUserEntityList(ServiceProvider As String, selectedFirm As String, entityType As String) As MSXML2.DOMDocument

    errLogger.Log "In GetUserEntityList"
    
    Dim xmlResponse As MSXML2.DOMDocument
    Dim argNames As Variant
    Dim argValues As Variant
    
    argNames = Array(SERVICE_PROVIDER, SELECTED_FIRM_WITH_LOWERCASE_F, ENTITY_TYPE)
'    selectedFirm = "QC retail system"
    argValues = Array(ServiceProvider, selectedFirm, entityType)
    
    Set xmlResponse = ExecuteMethodOnWebService("GetUserEntityListsCall", argNames, argValues)
    If Not xmlResponse Is Nothing Then Set GetUserEntityList = xmlResponse 'xmlResponse.getElementsByTagName(USER_ENTITY_LIST_REPLY)

    errLogger.Log "Out GetUserEntityList"
End Function

Public Function GetUserEntityChildNodes(ServiceProvider As String, selectedFirm As String, selectedEntity As String, entityType As String) As MSXML2.DOMDocument
    
    errLogger.Log "In GetUserEntityChildNodes"
    
    Dim xmlResponse As MSXML2.DOMDocument
    Dim argNames As Variant
    Dim argValues As Variant
    
    argNames = Array(SERVICE_PROVIDER, SELECTED_FIRM_WITH_UPPERCASE_F, ENTITY_TYPE, ENTITY_NAME)
'    selectedFirm = "QC retail system"
    argValues = Array(ServiceProvider, selectedFirm, entityType, selectedEntity)
    
    Set xmlResponse = ExecuteMethodOnWebService("GetUserEntityChildNodesCall", argNames, argValues)
    If Not xmlResponse Is Nothing Then Set GetUserEntityChildNodes = xmlResponse 'xmlResponse.getElementsByTagName(USER_ENTITY_CHILD_NODES_REPLY)

    errLogger.Log "Out GetUserEntityChildNodes"
    
End Function

Public Function SubmitRequestForEntity(ByVal request As TSAPIDataRequest) As MSXML2.IXMLDOMNode

    errLogger.Log "In SubmitRequestForEntity"
    
    Dim xmlResponse As MSXML2.DOMDocument
    Dim argNames As Variant
    Dim argValues As Variant
    Dim fieldsHexValues() As Variant
    Dim counter As Integer
    
    On Error Resume Next
    counter = UBound(request.FieldsList, 1)
    If Err.Number = 0 Then
        ReDim fieldsHexValues(counter) As Variant
        For counter = LBound(request.FieldsList, 1) To UBound(request.FieldsList, 1)
            fieldsHexValues(counter) = Right("0000" & Hex$(request.FieldsList(counter)), 4)
        Next
    Else
        Err.Clear
    End If
    On Error GoTo 0
    
    argNames = Array(SERVICE_PROVIDER, "Books", "bookType", "Currency", "Firm", "Fields", _
                     "reportPositionsInThousands", "reportSecondRisk", _
                     "reportValueType", "securityFilter", "securityNameFormat", "requestType")
'    request.selectedFirm = "QC retail system"
    argValues = Array(request.configuration, request.BooksList, request.bookType, request.DisplayCurrency, request.selectedFirm, _
                      fieldsHexValues, request.PositionsInThousands, _
                      request.SecondRisk, request.ValueType, request.SecurityFilter, request.SecurityNameFormat, request.RequestType)
                      
    Set xmlResponse = ExecuteMethodOnWebService("SubmitTaskCall", argNames, argValues)
    If Not xmlResponse Is Nothing Then Set SubmitRequestForEntity = xmlResponse.selectSingleNode("//" + USER_ENTITY_SUBMIT_TASK_REPLY) 'getElementsByTagName(USER_ENTITY_SUBMIT_TASK_REPLY)
    
    errLogger.Log "Out SubmitRequestForEntity"
    
End Function

Public Function CancelRequest(ServiceProvider As String, selectedFirm As String, taskid As String)
    errLogger.Log "In CancelRequest"
    
    Dim argNames As Variant
    Dim argValues As Variant
    Dim xmlResponse As MSXML2.DOMDocument

    argNames = Array(SERVICE_PROVIDER, SELECTED_FIRM_WITH_LOWERCASE_F, TASK_ID)
'    selectedFirm = "QC retail system"
    argValues = Array(ServiceProvider, selectedFirm, taskid)
    
    Set xmlResponse = ExecuteMethodOnWebService("CancelTaskCall", argNames, argValues)
    If Not xmlResponse Is Nothing Then Set CancelRequest = xmlResponse.getElementsByTagName(USER_CANCEL_TASK_REPLY)
    
    errLogger.Log "Out CancelRequest"
    
End Function

Public Function GetOutstandingTaskStatus(CurrentTaskID As String, configuration As String, selectedFirm As String) As MSXML2.IXMLDOMNode
    errLogger.Log "In GetOutstandingTaskStatus"
    
    Dim argNames As Variant
    Dim argValues As Variant
    Dim xmlResponse As MSXML2.DOMDocument
    
    argNames = Array("serviceProvider", "Firm", "taskId")
'    selectedFirm = "QC retail system"
    argValues = Array(configuration, selectedFirm, CurrentTaskID)
    
    Set xmlResponse = ExecuteMethodOnWebService("GetTaskStatusCall", argNames, argValues)
    If Not xmlResponse Is Nothing Then Set GetOutstandingTaskStatus = xmlResponse.selectSingleNode("//" + USER_TASK_STATUS_REPLY)   'getElementsByTagName(USER_TASK_STATUS_REPLY)
    
    errLogger.Log "Out GetOutstandingTaskStatus"
End Function

Public Function GetRequestedData(ServiceProvider As String, taskid As String, packetSequence As String) As MSXML2.IXMLDOMNodeList
    errLogger.Log "In GetRequestedData"
    
    Dim xmlResponse As MSXML2.DOMDocument
    Dim argNames As Variant
    Dim argValues As Variant
    
    argNames = Array(SERVICE_PROVIDER, TASK_ID, "packetSequenceNumber")
    argValues = Array(ServiceProvider, taskid, packetSequence)
    
    Set xmlResponse = ExecuteMethodOnWebService("GetTaskDataCall", argNames, argValues)
    If Not xmlResponse Is Nothing Then Set GetRequestedData = xmlResponse.getElementsByTagName(USER_TASK_DATA_REPLY)
    
    errLogger.Log "Out GetRequestedData"
End Function

Private Function ExecuteMethodOnWebService(methodName As String, argNames As Variant, argValues As Variant) As DOMDocument
    errLogger.Log "In ExecuteMethodOnWebService"
    
    Dim xmlResponse As MSXML2.DOMDocument
    On Error GoTo HandleExecuteMethodErrors
    Set xmlResponse = ExecuteMethod(WebSvcCtrl, SzWebSvc, methodName, argNames, argValues)
    If xmlResponse Is Nothing Then
        Call errLogger.LogWarning("ExecuteMethodOnWebService - ExecuteMethod on webservice returned Nothing.")
        Call errLogger.LogWarning("ExecuteMethodOnWebService - ExecuteMethod on webservice was called with the following parameters:")
        Call errLogger.LogWarning("ExecuteMethodOnWebService - MethodName = " + methodName)
        
        Dim argumentNameString As String
        Dim argument As Variant
        
        If IsArray(argNames) Then
            For Each argument In argNames
                argumentNameString = argumentNameString + IIf(argumentNameString = "", "", ", ") + argument
            Next
            Call errLogger.LogWarning("ExecuteMethodOnWebService - argNames: " + argumentNameString)
        Else
            Call errLogger.LogWarning("ExecuteMethodOnWebService - argNames: " + GetValueAsString(argNames))
        End If
        
        ' Now write out argvalues
        Dim argumentValueString As String
        If IsArray(argValues) Then
            For Each argument In argValues
                argumentValueString = argumentValueString + IIf(argumentValueString = "", "", ", ") + GetValueAsString(argument)
            Next
            Call errLogger.LogWarning("ExecuteMethodOnWebService - argValues: " + argumentValueString)
        Else
            Call errLogger.LogWarning("ExecuteMethodOnWebService - argValues array is empty")
        End If
    End If
    
    ' Add a check here to make sure that the xmlResponse is valid and not some SOAP fault.
    If Not xmlResponse Is Nothing Then
        If IsXmlResponseValid(xmlResponse) = False Then
            'MsgBox "An error occured while trying to connect to Bloomberg Trading System, please try again."
            Call errLogger.Log("ExecuteMethodOnWebService - ExecuteMethod returned an XML response which was not valid. The XML response follows.")
            Call errLogger.LogWarning(xmlResponse.XML)
            Call errLogger.Log("ExecuteMethodOnWebService - The XML response ends.")
            Set xmlResponse = Nothing
        End If
    End If
    
    Set ExecuteMethodOnWebService = xmlResponse
    errLogger.Log "Out ExecuteMethodOnWebService - Success"
    Exit Function
    
HandleExecuteMethodErrors:
    'Call MsgBox("An error occured trying to connect to Bloomberg, please try again.")
    'Should we try to re-initialize the web service? Could this resolve the problem?
    'Call InitializeWebService
    Set ExecuteMethodOnWebService = Nothing
    Call errLogger.LogWarning("ExecuteMethodOnWebService - An exception happened in ExecuteMthodOnWebService.")
    errLogger.Log "Out ExecuteMethodOnWebService - Failure"
End Function

Private Function GetValueAsString(val As Variant) As String
    
    Dim valAsString As String
    If IsNumeric(val) Or IsDate(val) Then
        valAsString = CStr(val)
    ElseIf TypeName(val) = "Boolean" Then
        valAsString = IIf(val, "True", "False")
    ElseIf TypeName(val) = "String" Then
        valAsString = val
    Else
        valAsString = "The value was not a string, numeric, date or boolean"
    End If
    
End Function

Private Function IsXmlResponseValid(xmlResponse As MSXML2.DOMDocument) As Boolean

    errLogger.Log "In IsXmlResponseValid"
    
    Dim tsapiStatusNode As MSXML2.IXMLDOMNode
    Dim xPathExpr As String
    'xPathExpr = "soap:Fault" ' This XPath expression is CASE SENSITIVE"
    xPathExpr = XPATH_SERVICESTATUS_CODE_NODE_FULLPATH
    Set tsapiStatusNode = xmlResponse.selectSingleNode(xPathExpr)
    If tsapiStatusNode Is Nothing Then
        IsXmlResponseValid = False 'Not a valid TSAPI response
    Else
        IsXmlResponseValid = True
    End If
    
    errLogger.Log "Out IsXmlResponseValid"
End Function

Private Sub Class_Terminate()

    errLogger.Log "In TSAPIWebSvcProxy - Terminate"
    
    Call CleanupTSAPIWebSvc
    
    errLogger.Log "Out TSAPIWebSvcProxy - Terminate"
    
End Sub

Private Function CleanupTSAPIWebSvc()
    errLogger.Log "In CleanupTSAPIWebSvc"
    
    Dim RefCount As Long
    RefCount = DeleteBLPWebSvc(WebSvcCtrl)

    errLogger.Log "Out CleanupTSAPIWebSvc"
End Function


Attribute VB_Name = "Sheet2"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "frmDisplayOptions"
Attribute VB_Base = "0{9D125C7B-989D-4D10-8F43-621A8A725FDF}{4F64C79E-8E34-49FE-A389-FCCE534BF2E4}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False


Option Explicit
Private displayOptionParameters As TSAPIDataRequest
Private snfShortNames As Variant
Private sfShortNames As Variant
Private Const TRUE_VALUE  As String = "True"
Private Const FALSE_VALUE As String = "False"
Private Const TRADER_VALUE As String = "Trader"
Private Const SECURITY_VALUE As String = "Security"
Private Const MULTICURRENCY_VALUE As String = "MultiCurrency"
Private Const CONTRACT_VALUE As String = "NumberOfContracts"
Private Const CASH_VALUE As String = "Cash"
Private Const CB_SETDROPPEDWIDTH = &H160
Private Const CB_GETDROPPEDWIDTH = &H15F
Private Const DT_CALCRECT = &H400
    
Private Sub cmdCancel_Click()
    errLogger.Log "In frmDisplayOptions - cmdCancel_Click"
    
    Unload Me
    
    errLogger.Log "Out frmDisplayOptions - cmdCancel_Click"
End Sub

…