MALICIOUS
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_VBADocument contains a VBA project — VBA macros present
-
Potential Shell call in VBA critical OLE_VBA_SHELLPotential Shell call in VBAMatched line in script
' ' Shell getSysParam("Terminal Services Client") & _ ' adminconopts & _ -
PowerShell reference in VBA critical OLE_VBA_PSPowerShell reference in VBAMatched 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_CMDcmd.exe reference in VBAMatched 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_ENVIRONEnviron() 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_RELExternal 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_HYPERLINKSDocument 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_URLOne 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.
| Filename | Kind | Source | Size |
|---|---|---|---|
macros.bas |
vba-macro | oletools.olevba.extract_macros (decoded VBA source from OOXML) | 70893 bytes |
SHA-256: 6254a7fae149c52d09727ac9af3d61b29cde24bbbf8d0c8986c0787aa79cafda |
|||
Preview scriptFirst 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 |
|||
Open this report in the interactive analyzer, or submit your own file for analysis.