Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 f6e7ff5ac99b960e…

MALICIOUS

Office (OOXML)

96.2 KB Created: 2011-03-18 12:53:22 UTC Authoring application: Microsoft Excel 16.0300 First seen: 2021-07-07
MD5: 8fdefaf459aa5873c6a179d14ec2869a SHA-1: dc9e415bfcad78389034c21831dae54238ff8588 SHA-256: f6e7ff5ac99b960e6930de48f8b49ae8f153a261cc18559b1a798b3fec67314b
238 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1059.001 PowerShell T1059.003 Windows Command Shell

The file is an Office document containing VBA macros that leverage Shell() and references to cmd.exe and PowerShell. This indicates an attempt to execute arbitrary commands, likely to download and run a secondary payload. The presence of these indicators strongly suggests a malicious intent, though the specific family remains undetermined.

Heuristics 8

  • VBA project inside OOXML medium 4 related findings OOXML_VBA
    Document contains a VBA project — VBA macros present
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
    '
    '    Shell getSysParam("Terminal Services Client") & _
    '        adminconopts & _
  • PowerShell reference in VBA critical OLE_VBA_PS
    PowerShell reference in VBA
    Matched line in script
            Print #f, "cd /d ""%~dp0"""
            Print #f, "powershell instmgrdata\rdp-file-password-encryptor.ps1 '" & pass & "' >pass.txt"
            Close #f
  • cmd.exe reference in VBA high OLE_VBA_CMD
    cmd.exe reference in VBA
    Matched line in script
            Dim res As ShellAndWaitResult
            res = ShellAndWait("cmd.exe /c """ & ActiveWorkbook.Path & "\rdp-file-password-encryptor.bat""", 20000, vbNormalFocus, PromptUser)
            If res <> ShellAndWaitResult.Success Then Exit Sub
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
        Dim s As String
        s = Environ$("TEMP")
        If Len(s) = 0 Then s = Environ$("TMP")
  • External relationship high OOXML_EXTERNAL_REL
    External target in xl/externalLinks/_rels/externalLink1.xml.rels: file:///\\Ofdocserver.romtelecom.ro\hyperion\Documents and Settings\alexandru.nita\Desktop\Securitati Hyperion\Security2
  • External hyperlinks (1) low OOXML_EXTERNAL_HYPERLINKS
    Document contains 1 external hyperlink — clickable URLs are stored as external relationships. First target: http://docs.oracle.com/cd/E10530_01/doc/nav/portal_1.htm
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://docs.oracle.com/cd/E10530_01/doc/nav/portal_1.htm Document hyperlink
    • http://go.microsoft.com/fwlink/?LinkID=215358OOXML external relationship
    • http://go.microsoft.com/fwlink/?LinkID=215357OOXML external relationship
    • http://go.microsoft.com/fwlink/?LinkId=177572OOXML external relationship
    • http://vb.mvps.org/articles/ap200106.aspOOXML external relationship

Extracted artifacts 2

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source from OOXML) 70893 bytes
SHA-256: 6254a7fae149c52d09727ac9af3d61b29cde24bbbf8d0c8986c0787aa79cafda
Preview script
First 1,000 lines of the extracted script
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
'<VBA_INSPECTOR_RUN />
Option Explicit

Private Sub Workbook_Activate()
    cleanupWbk
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    cleanupWbk
End Sub

Private Sub Workbook_Deactivate()
    cleanupWbk
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Range, Cancel As Boolean)
    If sh Is getAdmSheet Then
        modAdmin.rclickCellAddr = Target.AddressLocal(False, False)
        cleanupWbk
        dashActivateCtxMenu sh
    End If
End Sub

Private Sub cleanupWbk()
    dashDeactivateCtxMenu getAdmSheet
End Sub



Attribute VB_Name = "Sheet1"
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
'<VBA_INSPECTOR_RUN />
Option Explicit


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
'<VBA_INSPECTOR_RUN />
Option Explicit


Attribute VB_Name = "frmPass"
Attribute VB_Base = "0{E0FE549D-F5C2-4BA8-B34F-0FA0724E7B8F}{D1E4DF30-E4D8-4A64-99BE-D884B9DA6467}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
'<VBA_INSPECTOR_RUN />
Option Explicit

Public confirmed As Boolean

Public Property Get pass() As String
    pass = TextBox1.Text
End Property

Private Sub cmdCancel_Click()
    confirmed = False
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    confirmed = True
    Me.Hide
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then
        Cancel = True
        cmdCancel_Click
    End If
End Sub


Attribute VB_Name = "modAdmin"
'<VBA_INSPECTOR_RUN />
Option Explicit

'<VBA_INSPECTOR>
'   <DEPRECATION>
'       <MESSAGE>Potentially contains deprecated items in the object model</MESSAGE>
'       <ITEM>[mso]IMsoChartData.Workbook</ITEM>
'       <URL>http://go.microsoft.com/fwlink/?LinkID=215358 /URL>
'   </DEPRECATION>
'</VBA_INSPECTOR>
Private mRefWbk As Excel.Workbook
Public rclickCellAddr As String

Public Const VMWRBKNAME As String = "hyp-dashboard.xlsm"

Public Type TInstance
    wks_host_name As String
    wks_host_user As String
    wks_host_pass As String
    wks_webapp_url As String
    wks_webapp_login As String
    wks_webapp_pass As String
    
    plan_host_name As String
    plan_host_login As String
    plan_host_pass As String
    plan_webapp_url As String
    plan_webapp_pass As String
    plan_oas_pass As String
    
    ess_host_name As String
    ess_host_login As String
    ess_host_pass As String
    ess_webapp_url As String
    ess_webapp_pass As String
    ess_oas_pass As String
    
    ss_host_name As String
    ss_host_login As String
    ss_host_pass As String
    ss_webapp_url As String
    ss_webapp_pass As String
    ss_oas_pass As String
    
    obiee_host_name As String
    obiee_host_login As String
    obiee_host_pass As String
    obiee_webapp_url As String
    obiee_webapp_pass As String
    
    oc4j_host_name As String
    oc4j_host_login As String
    oc4j_host_pass As String
    oc4j_webapp_url As String
    oc4j_webapp_pass As String
    
    odi_host_name As String
    odi_host_login As String
    odi_host_pass As String
    odi_webapp_url As String
    odi_webapp_pass As String
    odi_asc_url As String
    odi_asc_login As String
    odi_asc_pass As String
    
    ppk As String
    ppk4oas As String
End Type

Public Enum YesNoBlankEnum
    blank
    yes
    no
End Enum

Public Const COLMIN As Long = 2
Public Const COLMAX As Long = 256
Public Const ROWMIN As Long = 2
Public Const ROWMAX As Long = 65536

Private rdpFullScrOpt As Boolean

Public Function getAdmSheet() As Excel.Worksheet
    Set getAdmSheet = getRefWbk.Worksheets("HYPADM")
End Function

Public Function getParamSheet() As Excel.Worksheet
    Set getParamSheet = getRefWbk.Worksheets("sys-specific data")
End Function

Public Function getSysParam(ByVal paramname As String, Optional ByVal defaultIfNull As Variant) As Variant
    Dim i As Long
    Dim s As String
    i = 1
    Dim sh As Excel.Worksheet
    Set sh = getParamSheet
    s = sh.Cells(i, 1).Value
    Do While Len(s) > 0
        If UCase$(LTrim(RTrim(s))) = UCase$(LTrim$(RTrim$(paramname))) Then
            getSysParam = sh.Cells(i, 2).Value
            Exit Function
        End If
        i = i + 1
        s = sh.Cells(i, 1).Value
    Loop
    getSysParam = defaultIfNull
End Function


Private Function getLastRow(ByRef sh As Excel.Worksheet, ByVal nCol As Long, ByVal rowStart As Long) As Long
    Dim i As Long
    Dim s As String
    If (sh Is Nothing) Or (nCol < 1) Then
        getLastRow = 0
        Exit Function
    End If
    For i = rowStart To ROWMAX
        s = LTrim(RTrim(sh.Cells(i, nCol).Value))
        If Len(s) = 0 Then
            If i < ROWMIN Then
                getLastRow = 0
            Else
                getLastRow = i - 1
            End If
            Exit Function
        End If
    Next
End Function

Private Function getLastCol(ByRef sh As Excel.Worksheet, ByVal nRow As Long, ByVal colStart As Long) As Long
    Dim i As Long
    Dim s As String
    If (sh Is Nothing) Or (nRow < 1) Then
        getLastCol = 0
        Exit Function
    End If
    For i = colStart To COLMAX
        s = LTrim(RTrim(sh.Cells(nRow, i).Value))
        If Len(s) = 0 Then
            If i < COLMIN Then
                getLastCol = 0
            Else
                getLastCol = i - 1
            End If
            Exit Function
        End If
    Next
End Function

Private Function getVars(ByVal nColNum As Long, ByRef lpData As TInstance) As Boolean
    getVars = False
    Dim sh As Excel.Worksheet
    Set sh = getAdmSheet
    If nColNum >= COLMIN And nColNum <= getLastCol(sh, 1, nColNum) Then
        With lpData
            .wks_host_name = findCell(sh, nColNum, "workspace hostname")
            .wks_host_user = findCell(sh, nColNum, "workspace host user")
            .wks_host_pass = findCell(sh, nColNum, "workspace host pass")
            .wks_webapp_url = findCell(sh, nColNum, "workspace webapp url")
            .wks_webapp_login = findCell(sh, nColNum, "workspace webapp login")
            .wks_webapp_pass = findCell(sh, nColNum, "workspace webapp pass")
            
            .ess_host_login = findCell(sh, nColNum, "ESSBase host user")
            .ess_host_name = findCell(sh, nColNum, "ESSBase hostname")
            .ess_host_pass = findCell(sh, nColNum, "ESSBase host pass")
            .ess_webapp_url = findCell(sh, nColNum, "ESSBase webapp url")
            .ess_webapp_pass = findCell(sh, nColNum, "ESSBase webapp pass")
            .ess_oas_pass = findCell(sh, nColNum, "ess oas password", False)
            
            .obiee_host_login = findCell(sh, nColNum, "OBIEE host login")
            .obiee_host_name = findCell(sh, nColNum, "OBIEE hostname")
            .obiee_host_pass = findCell(sh, nColNum, "OBIEE host pass")
            .obiee_webapp_url = findCell(sh, nColNum, "OBIEE webapp url")
            .obiee_webapp_pass = findCell(sh, nColNum, "OBIEE webapp pass")
            
            .plan_host_login = findCell(sh, nColNum, "Planning host user")
            .plan_host_name = findCell(sh, nColNum, "Planning hostname")
            .plan_host_pass = findCell(sh, nColNum, "Planning host pass")
            .plan_webapp_url = findCell(sh, nColNum, "Planning webapp url")
            .plan_oas_pass = findCell(sh, nColNum, "planning oas password", False)
            .plan_webapp_pass = findCell(sh, nColNum, "Planning webapp pass")
            
            .ss_host_login = findCell(sh, nColNum, "Shared Services host login")
            .ss_host_name = findCell(sh, nColNum, "Shared Services hostname")
            .ss_host_pass = findCell(sh, nColNum, "Shared Services host pass")
            .ss_webapp_url = findCell(sh, nColNum, "Shared Services webapp url")
            .ss_webapp_pass = findCell(sh, nColNum, "Shared Services webapp pass")
            .ss_oas_pass = findCell(sh, nColNum, "ss oas password", False)
            
            .oc4j_host_login = findCell(sh, nColNum, "oc4j host login")
            .oc4j_host_name = findCell(sh, nColNum, "oc4j hostname")
            .oc4j_host_pass = findCell(sh, nColNum, "oc4j host pass")
            .oc4j_webapp_url = findCell(sh, nColNum, "oc4j webapp url")
            .oc4j_webapp_pass = findCell(sh, nColNum, "oc4j webapp pass")
            
            .odi_host_login = findCell(sh, nColNum, "odi host login")
            .odi_host_name = findCell(sh, nColNum, "odi hostname")
            .odi_host_pass = findCell(sh, nColNum, "odi host pass")
            .odi_webapp_url = findCell(sh, nColNum, "odi webapp url")
            .odi_webapp_pass = findCell(sh, nColNum, "odi webapp pass")
            .odi_asc_url = findCell(sh, nColNum, "odi OAS control webapp url")
            .odi_asc_login = findCell(sh, nColNum, "odi OAS control login")
            .odi_asc_pass = findCell(sh, nColNum, "odi OAS control pass")
            
            .ppk = findCell(sh, nColNum, "ppk")
            .ppk4oas = findCell(sh, nColNum, "ppk4oas")
        End With
        getVars = True
    End If
End Function

Private Function findCell(ByRef sh As Excel.Worksheet, ByVal colNum As Long, ByVal cellTitle As String, _
    Optional ByVal ignoreStrikeThroughFormat As Boolean = True) As String
    Dim i As Long
    Dim b As Boolean
    For i = 2 To getLastRow(sh, 1, 2)
        If ignoreStrikeThroughFormat Then
            b = True
        Else
            '<VBA_INSPECTOR>
            '   <DEPRECATION>
            '       <MESSAGE>Potentially contains deprecated items in the object model</MESSAGE>
            '       <ITEM>[mso]ChartFont.StrikeThrough</ITEM>
            '       <URL>http://go.microsoft.com/fwlink/?LinkID=215358 /URL>
            '   </DEPRECATION>
            '</VBA_INSPECTOR>
            b = Not sh.Cells(i, 1).Font.Strikethrough
        End If
        If b And _
            (UCase$(LTrim$(RTrim$(sh.Cells(i, 1)))) = UCase$(LTrim$(RTrim$(cellTitle)))) _
        Then
            findCell = LTrim$(RTrim$(sh.Cells(i, colNum).Value))
            Exit Function
        End If
    Next
End Function

Public Function getRefWbk() As Excel.Workbook
    If mRefWbk Is Nothing Then
        Set mRefWbk = Workbooks(VMWRBKNAME)
    End If
    Set getRefWbk = mRefWbk
End Function

Private Function getSubmenuPtr(ByRef pParentMenu As Office.CommandBarPopup, _
                             ByVal lpszCaption As String) _
                             As Office.CommandBarPopup
        Dim cSubMenu As Office.CommandBarPopup
        Set cSubMenu = pParentMenu.Controls.Add(Temporary:=True, Type:=msoControlPopup)
        cSubMenu.Caption = lpszCaption
        'cSubMenu.BeginGroup = True
        Set getSubmenuPtr = cSubMenu
End Function


Public Sub dashActivateCtxMenu(ByRef sh As Excel.Worksheet)
    If sh Is Nothing Then Exit Sub
    If Not ( _
                (sh Is getAdmSheet) _
        ) Then
        '// right-click context menu must only be enabled for specific sheets !
        Exit Sub
    End If
    

    Dim wb As Excel.Workbook
    Set wb = sh.Parent
    
    Dim cBut As Office.CommandBarPopup
    Dim cSubMenu As Office.CommandBarPopup
    
    On Error Resume Next
    dashDeactivateCtxMenu wb
    
    '<VBA_INSPECTOR>
    '   <CHANGE>
    '       <MESSAGE>Potentially contains changed items in the object model</MESSAGE>
    '       <ITEM>[xls]Application.CommandBars</ITEM>
    '       <URL>http://go.microsoft.com/fwlink/?LinkID=215357 </URL>
    '   </CHANGE>
    '</VBA_INSPECTOR>
    Set cBut = wb.Application.CommandBars("Cell"). _
                    Controls.Add( _
                        Temporary:=True, _
                        Type:=msoControlPopup)

    With cBut
       .Caption = " [ HYP Dashboard ] "
       .BeginGroup = True
    End With
    
    Dim shname As String
    shname = sh.Name
    
    Dim rclkCol As Long
    '<VBA_INSPECTOR>
    '   <REMOVED>
    '       <MESSAGE>Potentially contains removed items in the object model</MESSAGE>
    '       <ITEM>[mso]ODSOFilter.Column</ITEM>
    '       <URL>http://go.microsoft.com/fwlink/?LinkID=215358 /URL>
    '   </REMOVED>
    '</VBA_INSPECTOR>
    rclkCol = sh.Range(rclickCellAddr).Column
            
    Dim dash As TInstance
    If Not getVars(rclkCol, dash) Then Exit Sub
    
    Dim actionhist As String
    actionhist = iniMgr.readVarIni("Actions", "Last")
    If Len(actionhist) > 0 Then actionhist = " - " & Replace(Replace(actionhist, shname & ":", ""), ":", "-")
    dashAddAction cBut, shname & ":" & "Repeat action" & actionhist
    
    Set cSubMenu = getSubmenuPtr(cBut, "[ 1. Wrkspace ]")
        dashAddAction cSubMenu, shname & ":" & "Wrkspace RDP"
        dashAddAction cSubMenu, shname & ":" & "Wrkspace web"
        dashAddAction cSubMenu, shname & ":" & "Wrkspace ping"
        
    Set cSubMenu = getSubmenuPtr(cBut, "[ 2. Planning ]")
        dashAddAction cSubMenu, shname & ":" & "Planning ssh"
        dashAddAction cSubMenu, shname & ":" & "Planning sftp"
        dashAddAction cSubMenu, shname & ":" & "Planning web"
        dashAddAction cSubMenu, shname & ":" & "Planning ping"
        If Len(dash.plan_oas_pass) > 0 Then
            dashAddAction cSubMenu, shname & ":" & "Planning oas (ssh)"
            dashAddAction cSubMenu, shname & ":" & "Planning oas (sftp)"
        End If
    
    Set cSubMenu = getSubmenuPtr(cBut, "[ 3. ESSBase ]")
        dashAddAction cSubMenu, shname & ":" & "ESSBase ssh"
        dashAddAction cSubMenu, shname & ":" & "ESSBase sftp"
        dashAddAction cSubMenu, shname & ":" & "ESSBase web"
        dashAddAction cSubMenu, shname & ":" & "ESSBase ping"
        If Len(dash.ess_oas_pass) > 0 Then
            dashAddAction cSubMenu, shname & ":" & "ESSBase oas (ssh)"
            dashAddAction cSubMenu, shname & ":" & "ESSBase oas (sftp)"
        End If
        
    Set cSubMenu = getSubmenuPtr(cBut, "[ 4. SS ]")
        dashAddAction cSubMenu, shname & ":" & "SS ssh"
        dashAddAction cSubMenu, shname & ":" & "SS sftp"
        dashAddAction cSubMenu, shname & ":" & "SS web"
        dashAddAction cSubMenu, shname & ":" & "SS ping"
        If Len(dash.ss_oas_pass) > 0 Then
            dashAddAction cSubMenu, shname & ":" & "SS oas (ssh)"
            dashAddAction cSubMenu, shname & ":" & "SS oas (sftp)"
        End If
            
    Set cSubMenu = getSubmenuPtr(cBut, "[ 5. OBIEE ]")
        dashAddAction cSubMenu, shname & ":" & "OBIEE ssh"
        dashAddAction cSubMenu, shname & ":" & "OBIEE sftp"
        dashAddAction cSubMenu, shname & ":" & "OBIEE web"
        dashAddAction cSubMenu, shname & ":" & "OBIEE ping"

    Set cSubMenu = getSubmenuPtr(cBut, "[ OC4J ]")
        dashAddAction cSubMenu, shname & ":" & "OC4J ssh"
        dashAddAction cSubMenu, shname & ":" & "OC4J sftp"
        dashAddAction cSubMenu, shname & ":" & "OC4J web"
        dashAddAction cSubMenu, shname & ":" & "OC4J ping"

    Set cSubMenu = getSubmenuPtr(cBut, "[ ODI ]")
        dashAddAction cSubMenu, shname & ":" & "ODI ssh"
        dashAddAction cSubMenu, shname & ":" & "ODI sftp"
        dashAddAction cSubMenu, shname & ":" & "ODI web"
        dashAddAction cSubMenu, shname & ":" & "ODI ping"
        dashAddAction cSubMenu, shname & ":" & "ODI OAS control webapp"

    dashAddAction cBut, "_________________"
    Set cSubMenu = getSubmenuPtr(cBut, "[ Options ]")
        dashAddAction cSubMenu, shname & ":" & "RDP full screen (" & readMenuOption("options", "rdpfullscreen") & ")"
        dashAddAction cSubMenu, shname & ":" & "RDP admin console (" & readMenuOption("options", "rdpadmincon") & ")"
End Sub

Private Sub toggleMenuOption(menuName, optName)
    Dim s As String
    s = readMenuOption(menuName, optName)
    If s = "-" Then s = "X" Else s = "-"
    writeMenuOption menuName, optName, s
End Sub

Private Function readMenuOption(ByVal menuName As String, ByVal optName As String) As String
    Dim s As String
    s = iniMgr.readVarIni("MenuOptions", menuName & " - " & optName)
    If s = "" Then s = "-"
    readMenuOption = s
End Function
Private Sub writeMenuOption(ByVal menuName As String, ByVal optName As String, ByVal optVal As String)
    If optVal = "" Then optVal = "-"
    iniMgr.writeVarIni "MenuOptions", menuName & " - " & optName, optVal
End Sub

Private Function isOptionChecked(ByVal optValue As String) As Boolean
    '// an option is checked if the string ends with "(X)"
    '// it is not checked if the string ends with "(-)"
    isOptionChecked = CBool(Right$(UCase$(optValue), 3) = "(X)")
End Function

Private Function strmid(ByVal s As String, ByVal start As Long, Optional ByVal Length As Long = -1) As String
    On Error GoTo lerrh
    If Length < 0 Then
        strmid = Mid$(s, start)
    Else
        strmid = Mid$(s, start, Length)
    End If
    Exit Function
lerrh:
    strmid = ""
End Function
Private Function strright(ByVal s As String, ByVal n As Long) As String
    On Error GoTo lerrh
    strright = Right$(s, n)
    Exit Function
lerrh:
    strright = ""
End Function
Private Function strleft(ByVal s As String, ByVal n As Long) As String
    On Error GoTo lerrh
    strleft = Left$(s, n)
    Exit Function
lerrh:
    strleft = ""
End Function

Private Function getBaseMenuName(ByVal s As String) As String
    If strright(s, 1) = ")" And strmid(s, Len(s) - 2, 1) = "(" Then
        getBaseMenuName = LTrim$(RTrim$(strleft(s, Len(s) - 4)))
    Else
        getBaseMenuName = LTrim$(RTrim$(s))
    End If
End Function

Private Sub dashAddAction(ByRef cBut As Office.CommandBarPopup, _
                             ByVal lpszCaption As String)
    If cBut Is Nothing Then
        Exit Sub
    End If
    Dim v
    v = Split(lpszCaption, ":")
    Dim s As String
    s = v(UBound(v))
    With cBut
       Dim subtn As Office.CommandBarButton
       Set subtn = .Controls.Add(Type:=msoControlButton)
       With subtn
        .Caption = s
        .OnAction = "'dashCtx " & _
                    Chr$(34) & lpszCaption & Chr$(34) & "'"
       End With
    End With
End Sub

Public Sub dashDeactivateCtxMenu(ByRef sh As Excel.Worksheet)
    If sh Is Nothing Then Exit Sub
    
    On Error Resume Next
    '<VBA_INSPECTOR>
    '   <CHANGE>
    '       <MESSAGE>Potentially contains changed items in the object model</MESSAGE>
    '       <ITEM>[xls]Application.CommandBars</ITEM>
    '       <URL>http://go.microsoft.com/fwlink/?LinkID=215357 </URL>
    '   </CHANGE>
    '</VBA_INSPECTOR>
    sh.Parent.Application.CommandBars("Cell").Reset
    On Error GoTo 0
End Sub


Public Sub dashCtx(ByVal action As String)
    If Len(LTrim$(RTrim$(action))) = 0 Then Exit Sub
    
    Dim v
    Dim mrow As Long, mcol As Long
    
    v = Split(action, ":")
    Dim shname As String
    Dim sh As Excel.Worksheet
    Dim mAction As String
    shname = v(LBound(v))
    If Left$(shname, 2) = "__" Then Exit Sub
    mAction = v(UBound(v))
    Dim mactionOrig As String
    mactionOrig = mAction
    Set sh = getRefWbk.Worksheets(shname)
    '<VBA_INSPECTOR>
    '   <DEPRECATION>
    '       <MESSAGE>Potentially contains deprecated items in the object model</MESSAGE>
    '       <ITEM>[xls]SmartTag.Range</ITEM>
    '       <URL>http://go.microsoft.com/fwlink/?LinkID=215357 /URL>
    '   </DEPRECATION>
    '</VBA_INSPECTOR>
    mrow = sh.Range(rclickCellAddr).Row
    '<VBA_INSPECTOR>
    '   <REMOVED>
    '       <MESSAGE>Potentially contains removed items in the object model</MESSAGE>
    '       <ITEM>[mso]ODSOFilter.Column</ITEM>
    '       <URL>http://go.microsoft.com/fwlink/?LinkID=215358 /URL>
    '   </REMOVED>
    '</VBA_INSPECTOR>
    mcol = sh.Range(rclickCellAddr).Column
    
    Dim vinst As TInstance
    If Not getVars(mcol, vinst) Then Exit Sub
    
    mAction = getBaseMenuName(mAction)
    
    Select Case mAction
        Case "Wrkspace RDP"
            gordp vinst
        Case "Wrkspace web"
            setwpass vinst.wks_webapp_pass
            gohttp vinst.wks_webapp_url
        Case "Wrkspace ping"
            goping vinst.wks_host_name
        
        Case "Planning ssh"
            goputty vinst.plan_host_login, vinst.plan_host_pass, vinst.plan_host_name, vinst.ppk
        Case "Planning sftp"
            gosftp vinst.plan_host_login, vinst.plan_host_pass, vinst.plan_host_name, vinst.ppk
        Case "Planning web"
            setwpass vinst.plan_webapp_pass
            gohttp vinst.plan_webapp_url
        Case "Planning ping"
            goping vinst.plan_host_name
        Case "Planning oas (ssh)"
            goputty "oas", vinst.plan_oas_pass, vinst.plan_host_name, vinst.ppk4oas
        Case "Planning oas (sftp)"
            gosftp "oas", vinst.plan_oas_pass, vinst.plan_host_name, vinst.ppk4oas
    
        Case "ESSBase ssh"
            goputty vinst.ess_host_login, vinst.ess_host_pass, vinst.ess_host_name, vinst.ppk
        Case "ESSBase sftp"
            gosftp vinst.ess_host_login, vinst.ess_host_pass, vinst.ess_host_name, vinst.ppk
        Case "ESSBase web"
            setwpass vinst.ess_webapp_pass
            gohttp vinst.ess_webapp_url
        Case "ESSBase ping"
            goping vinst.ess_host_name
        Case "ESSBase oas (ssh)"
            goputty "oas", vinst.ess_oas_pass, vinst.ess_host_name, vinst.ppk4oas
        Case "ESSBase oas (sftp)"
            gosftp "oas", vinst.ess_oas_pass, vinst.ess_host_name, vinst.ppk4oas
            
        Case "SS ssh"
            goputty vinst.ss_host_login, vinst.ss_host_pass, vinst.ss_host_name, vinst.ppk
        Case "SS sftp"
            gosftp vinst.ss_host_login, vinst.ss_host_pass, vinst.ss_host_name, vinst.ppk
        Case "SS web"
            setwpass vinst.ss_webapp_pass
            gohttp vinst.ss_webapp_url
        Case "SS ping"
            goping vinst.ss_host_name
        Case "SS oas (ssh)"
            goputty "oas", vinst.ss_oas_pass, vinst.ss_host_name, vinst.ppk4oas
        Case "SS oas (sftp)"
            gosftp "oas", vinst.ss_oas_pass, vinst.ss_host_name, vinst.ppk4oas
            
        Case "OBIEE ssh"
            goputty vinst.obiee_host_login, vinst.obiee_host_pass, vinst.obiee_host_name, vinst.ppk
        Case "OBIEE sftp"
            gosftp vinst.obiee_host_login, vinst.obiee_host_pass, vinst.obiee_host_name, vinst.ppk
        Case "OBIEE web"
            setwpass vinst.obiee_webapp_pass
            gohttp vinst.obiee_webapp_url
        Case "OBIEE ping"
            goping vinst.obiee_host_name
        
        Case "OC4J ssh"
            goputty vinst.oc4j_host_login, vinst.oc4j_host_pass, vinst.oc4j_host_name, vinst.ppk
        Case "OC4J sftp"
            gosftp vinst.oc4j_host_login, vinst.oc4j_host_pass, vinst.oc4j_host_name, vinst.ppk
        Case "OC4J web"
            setwpass vinst.oc4j_webapp_pass
            gohttp vinst.oc4j_webapp_url
        Case "OC4J ping"
            goping vinst.oc4j_host_name
        
        Case "ODI ssh"
            goputty vinst.odi_host_login, vinst.odi_host_pass, vinst.odi_host_name, vinst.ppk
        Case "ODI sftp"
            gosftp vinst.odi_host_login, vinst.odi_host_pass, vinst.odi_host_name, vinst.ppk
        Case "ODI web"
            setwpass vinst.odi_webapp_pass
            gohttp vinst.odi_webapp_url
        Case "ODI ping"
            goping vinst.odi_host_name
        Case "ODI OAS control webapp"
            setwpass vinst.odi_asc_pass
            gohttp vinst.odi_asc_url
        
        Case "RDP full screen"
            toggleMenuOption "options", "rdpfullscreen"
            Exit Sub
        Case "RDP admin console"
            toggleMenuOption "options", "rdpadmincon"
            Exit Sub
        Case Else
            If Left$(mAction, Len("Repeat action")) = "Repeat action" Then
                dashCtx iniMgr.readVarIni("Actions", "Last")
                Exit Sub
            End If
    End Select
    iniMgr.writeVarIni "Actions", "Last", action
End Sub

Private Sub setwpass(pass)
    Dim b As Boolean
    b = modClipboard.SetText("")
    Debug.Print "Emptying clipboard: " & b
    b = modClipboard.SetText(pass)
    Debug.Print "Setting clipboard to value " & pass & ": " & b
    Debug.Print "Checking clipboard: " & modClipboard.GetText
End Sub

Public Function inList(srchItem As Variant, ParamArray items() As Variant) As Boolean
    Dim i As Long
    On Error GoTo lerrh
    For i = LBound(items) To UBound(items)
        If items(i) = srchItem Then
            inList = True
            Exit Function
        End If
    Next
    Exit Function
lerrh:
    inList = False
End Function

Private Sub gordp(ByRef vinst As TInstance)
    Dim fullScreen As Boolean
    fullScreen = CBool(readMenuOption("options", "rdpfullscreen") = "X")
    '// fullScreen = False
    Dim fopts As String
    If fullScreen Then
        fopts = "/f"
    Else
        fopts = "/w:1024 /h:768"
    End If
    
    execRDP vinst.wks_host_name & ".romtelecom.ro", vinst.wks_host_user, _
        "romtelecom.ro", vinst.wks_host_pass, fopts
'
'
'    Dim rdpadmincon As Boolean
'    rdpadmincon = CBool(readMenuOption("options", "rdpadmincon") = "X")
'    Dim adminconopts As String
'    If rdpadmincon Then
'        adminconopts = " /admin"
'    Else
'        adminconopts = ""
'    End If
'
'    Shell getSysParam("Terminal Services Client") & _
'        adminconopts & _
'        " /v:" & vinst.wks_host_name & _
'        " /u:" & vinst.wks_host_user & _
'        " /p:" & vinst.wks_host_pass & _
'        " /nosound /noprinters /nowallpaper" & _
'        " " & fopts, vbNormalFocus

End Sub
Public Sub execRDP(ByVal host As String, ByVal usrname As String, ByVal usrdomain As String, ByVal pass As String, ByVal fopts As String)
    Dim f As Integer
    If Len(pass) > 0 Then
        f = FreeFile
        Open ActiveWorkbook.Path & "\rdp-file-password-encryptor.bat" For Output As #f
        Print #f, "cd /d ""%~dp0"""
        Print #f, "powershell instmgrdata\rdp-file-password-encryptor.ps1 '" & pass & "' >pass.txt"
        Close #f
        Dim res As ShellAndWaitResult
        res = ShellAndWait("cmd.exe /c """ & ActiveWorkbook.Path & "\rdp-file-password-encryptor.bat""", 20000, vbNormalFocus, PromptUser)
        If res <> ShellAndWaitResult.Success Then Exit Sub
        
        f = FreeFile
        Open ActiveWorkbook.Path & "\pass.txt" For Input As #f
        Dim s As String
        Do While Not EOF(f)
            Line Input #f, s
            s = LTrim$(RTrim$(s))
            If Len(s) > 0 Then
                pass = s
                Exit Do
            End If
        Loop
        Close #f
    End If
    
    
    f = FreeFile
    Open ActiveWorkbook.Path & "\" & host & ".rdp" For Output As #f
    
    Dim t As Integer
    t = FreeFile
    
    
    Open ActiveWorkbook.Path & "\instmgrdata\rdp_template.rdp" For Input As #t
    
    Do While Not EOF(t)
        Line Input #t, s
        If s Like "domain:s:*" Then
            s = "domain:s:" & usrdomain
        ElseIf s Like "username:s:*" Then
            s = "username:s:" & usrname
        ElseIf s Like "full address:s:*" Then
            s = "full address:s:" & host
        ElseIf s Like "password 51:b:*" Then
            If Len(pass) > 0 Then
                s = "password 51:b:" & pass
            Else
                s = ""
            End If
        End If
        Print #f, s
    Loop
    
    Close #f
    Close #t
    
    ShellWrapper getSysParam("Terminal Services Client") & " " & fopts & " """ & ActiveWorkbook.Path & "\" & host & ".rdp""", vbNormalFocus
    
End Sub
Public Function getTemp() As String
    Dim s As String
    s = Environ$("TEMP")
    If Len(s) = 0 Then s = Environ$("TMP")
    s = LTrim$(RTrim$(s))
    Do While Len(s) > 0 And Right$(s, 1) = "\"
        s = Left$(s, Len(s) - 1)
    Loop
    getTemp = s
End Function

Private Sub goping(ByVal fqdn As String)
    Shell "ping -t " & _
            fqdn, vbNormalFocus
End Sub

Private Function gohttp(ByVal url As String)
    Shell getSysParam("iexplore") & " " & url, vbNormalFocus
End Function

Public Sub hiliteFormulas()
    Dim i As Long
    Dim j As Long
    Dim sh As Excel.Worksheet
    Set sh = getAdmSheet
    Dim c As Excel.Range
    For i = getLastRow(sh, 1, 2) To 2 Step -1
        For j = getLastCol(sh, 1, 2) To 2 Step -1
            Set c = sh.Cells(i, j)
            If Left$(c.FormulaR1C1, 1) = "=" Then
                '<VBA_INSPECTOR>
                '   <DEPRECATION>
                '       <MESSAGE>Potentially contains deprecated items in the object model</MESSAGE>
                '       <ITEM>[mso]ChartFont.Italic</ITEM>
                '       <URL>http://go.microsoft.com/fwlink/?LinkID=215358 /URL>
                '   </DEPRECATION>
                '</VBA_INSPECTOR>
                c.Font.Italic = True
                c.Font.Color = ColorConstants.vbMagenta
                cellBorders c
            Else
                cellNoBorders c
            End If
        Next
    Next
End Sub

Public Sub cellBorders(ByRef c As Excel.Range)
    On Error Resume Next
    c.Borders(xlDiagonalDown).LineStyle = xlNone
    c.Borders(xlDiagonalUp).LineStyle = xlNone
    With c.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        '<VBA_INSPECTOR>
        '   <DEPRECATION>
        '       <MESSAGE>Potentially contains deprecated items in the object model</MESSAGE>
        '       <ITEM>[mso]ChartFont.ColorIndex</ITEM>
        '       <URL>http://go.microsoft.com/fwlink/?LinkID=215358 /URL>
        '   </DEPRECATION>
        '</VBA_INSPECTOR>
        .ColorIndex = xlAutomatic
    End With
    With c.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        '<VBA_INSPECTOR>
        '   <DEPRECATION>
        '       <MESSAGE>Potentially contains deprecated items in the object model</MESSAGE>
        '       <ITEM>[mso]ChartFont.ColorIndex</ITEM>
        '       <URL>http://go.microsoft.com/fwlink/?LinkID=215358 /URL>
        '   </DEPRECATION>
        '</VBA_INSPECTOR>
        .ColorIndex = xlAutomatic
    End With
    With c.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        '<VBA_INSPECTOR>
        '   <DEPRECATION>
        '       <MESSAGE>Potentially contains deprecated items in the object model</MESSAGE>
        '       <ITEM>[mso]ChartFont.ColorIndex</ITEM>
        '       <URL>http://go.microsoft.com/fwlink/?LinkID=215358 /URL>
        '   </DEPRECATION>
        '</VBA_INSPECTOR>
        .ColorIndex = xlAutomatic
    End With
    With c.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        '<VBA_INSPECTOR>
        '   <DEPRECATION>
        '       <MESSAGE>Potentially contains deprecated items in the object model</MESSAGE>
        '       <ITEM>[mso]ChartFont.ColorIndex</ITEM>
        '       <URL>http://go.microsoft.com/fwlink/?LinkID=215358 /URL>
        '   </DEPRECATION>
        '</VBA_INSPECTOR>
        .ColorIndex = xlAutomatic
    End With
    With c.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        '<VBA_INSPECTOR>
        '   <DEPRECATION>
        '       <MESSAGE>Potentially contains deprecated items in the object model</MESSAGE>
        '       <ITEM>[mso]ChartFont.ColorIndex</ITEM>
        '       <URL>http://go.microsoft.com/fwlink/?LinkID=215358 /URL>
        '   </DEPRECATION>
        '</VBA_INSPECTOR>
        .ColorIndex = xlAutomatic
    End With
    With c.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        '<VBA_INSPECTOR>
        '   <DEPRECATION>
        '       <MESSAGE>Potentially contains deprecated items in the object model</MESSAGE>
        '       <ITEM>[mso]ChartFont.ColorIndex</ITEM>
        '       <URL>http://go.microsoft.com/fwlink/?LinkID=215358 /URL>
        '   </DEPRECATION>
        '</VBA_INSPECTOR>
        .ColorIndex = xlAutomatic
    End With
End Sub
Public Sub cellNoBorders(ByRef c As Excel.Range)
    On Error Resume Next
    c.Borders(xlDiagonalDown).LineStyle = xlNone
    c.Borders(xlDiagonalUp).LineStyle = xlNone
    c.Borders(xlEdgeLeft).LineStyle = xlNone
    c.Borders(xlEdgeTop).LineStyle = xlNone
    c.Borders(xlEdgeBottom).LineStyle = xlNone
    c.Borders(xlEdgeRight).LineStyle = xlNone
    c.Borders(xlInsideVertical).LineStyle = xlNone
    c.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

Private Function getPass(ByVal tijtel As String) As String
    Dim s As String
    Dim f As frmPass
    Set f = New frmPass
    Load f
    If Len(tijtel) > 0 Then f.Caption = tijtel
    f.Show vbModal
    If f.confirmed Then
        s = f.pass
    End If
    Unload f
    Set f = Nothing
    getPass = s
End Function

Private Property Get passwd(ByVal indx As String) As String
    passwd = iniMgr.readVarIni("auth", "pass_" & indx)
End Property
Private Property Let passwd(ByVal indx As String, ByVal pass As String)
    iniMgr.writeVarIni "auth", "pass_" & indx, pass
End Property

Private Function getTmpDir() As String
    Dim s As String
    s = Environ$("TEMP")
    If Len(s) = 0 Then s = Environ$("TMP")
    If Len(s) = 0 Then s = Environ$("TMPDIR")
    If Len(s) = 0 Then s = Environ$("TEMPDIR")
    '<VBA_INSPECTOR>
    '   <REMOVED>
    '       <MESSAGE>Potentially contains removed items in the object model</MESSAGE>
    '       <ITEM>[mso]ScopeFolder.Path</ITEM>
    '       <URL>http://go.microsoft.com/fwlink/?LinkID=215358 /URL>
    '   </REMOVED>
    '</VBA_INSPECTOR>
    If Len(s) = 0 Then s = ActiveWorkbook.Path
    If Len(s) > 0 Then If Right$(s, 1) = "\" Then s = Left$(s, Len(s) - 1)
    getTmpDir = s
End Function

Public Function getPuttyPPKSTR(ByVal ppk As String, ByVal defaultPass As String) As String
    If Len(ppk) > 0 Then
        If Len(Dir$(ppk)) > 0 Then
            '// ppk = " -agent "
            ppk = " -i " & Chr$(34) & ppk & Chr$(34) & " "
        Else
            ppk = " -pw " & defaultPass
        End If
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 175104 bytes
SHA-256: edd8dad833f8ad2291476392dec9e67a2aefa1c6bce7ae310d3854b8cd41699d