Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 aee03cc34bffd2b5…

MALICIOUS

Office (OLE)

765.0 KB Created: 2010-02-25 16:43:56 Authoring application: Microsoft Excel First seen: 2019-01-20
MD5: bfaaa294ef39c536a74cb5dcedb94c7b SHA-1: 4c7bac52e1643646d68c22ba9cd6c81e2fbac188 SHA-256: aee03cc34bffd2b5b6db4541463b05c5d05efacdf781c02fbb69d8cc8510ce36
538 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File T1140 Deobfuscate or Obfuscate Malicious Code T1105 Ingress Tool Transfer

The sample is a malicious Excel document containing obfuscated VBA macros that utilize WScript.Shell and CreateObject to execute code. It embeds a PE executable and references URLs that are likely used for command and control or payload delivery. The Workbook_Open macro appears to be designed to execute a second-stage payload, potentially involving the embedded executable, and attempts to gather user credentials.

Heuristics 14

  • Embedded PE executable critical OLE_EMBEDDED_EXE
    MZ/PE header found inside document — possible embedded executable
  • Ole10Native package drops an auto-executable payload critical OFFICE_PACKAGE_RISKY_FILE
    OLE Package displayName or fullPath ends in a directly auto-executable extension (a runnable binary or a script the default shell host runs on double-click). Embedding such a payload inside an Office document has no benign authoring use — it is a malware-delivery dropper.
  • VBA macros detected medium 7 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
    Normal:
    Shell url, vbNormalFocus
    Shell "C:\Progz\Opera\opera.exe " & url, vbNormalFocus
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
    '
'Set wshshell = CreateObject("WScript.Shell")
'wshshell.Run url
  • Obfuscated auto-exec VBA loader critical OLE_VBA_OBFUSCATED_AUTOEXEC_LOADER
    Auto-exec VBA reconstructs strings with a heavy custom decoder (numeric char-array, repeated hex-string decode, or junk-token Replace removal) and feeds them to a COM-instantiation or execution sink. This obfuscated-loader shape keeps CreateObject/Shell/URL indicators out of the macro source.
    Matched line in script
    '
'Set wshshell = CreateObject("WScript.Shell")
'wshshell.Run url
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
    '
'Set wshshell = CreateObject("WScript.Shell")
'wshshell.Run url
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Private Sub Workbook_Open()
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
    If Application.UserName = "Christian Schleinzer" And _
   Environ("COMPUTERNAME") <> "AT00275W" Then
  • Reference to CreateProcess API high SC_STR_CREATEPROCESS
    Reference to CreateProcess API
  • Reference to Windows Script Host high SC_STR_WSCRIPT
    Reference to Windows Script Host
  • Suspicious extracted artifact high EXTRACTED_FILE_STATIC_TRIAGE
    One or more files extracted from inside this sample matched static suspicious-content checks such as script obfuscation, encoded payload blobs, packed data, or execution/download terms.
  • 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://prdrace1.global-intra.net:8181/ictsft/servlet/ft.report?$casenumber$= In document text (OLE body)
    • http://prdrace1.global-intra.net:8181/ictsft_old_vs/servlet/ft.report?$casenumber$=In document text (OLE body)
    • http://prdrace1.global-intra.net:8181/ictsft/servlet/ft.report?$casenumber$=5In document text (OLE body)

Extracted artifacts 3

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 202617 bytes
SHA-256: a0291cfe34be258d0f27e90663ccdf40304d80e116249fcecf91bc7a25ff01e8
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "DieseArbeitsmappe"
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
Option Explicit


Private Sub Workbook_Open()

ThisWorkbook.Sheets("Version").Cells(3, 2).Value = ""
ThisWorkbook.Sheets("Automation").Cells(1, 2).Value = ""
ThisWorkbook.Saved = True

If Application.UserName = "Christian Schleinzer" And _
   Environ("COMPUTERNAME") <> "AT00275W" Then
    
    Application.UserName = InputBox("Please enter your username", "Define Username")
    
End If

End Sub


Private Sub Workbook_Activate()

Dim UpdateAvailable As Boolean
Dim C As Integer
Dim Line As String
Dim Version As String
Dim MyVersion
Dim NewVersion
Dim MyNiceVersion As String
Dim ImplementedChanges As String
Dim CmdPar


Dim argumente, dummy As String
'excel c:\Commandline.xls /e/User/Password/Ticket
dummy = CmdToStr(GetCommandLine())

If Mid(dummy, Len(dummy) - 1) <> "/e" And Mid(dummy, Len(dummy) - 3) <> "/dde" And _
   ThisWorkbook.Sheets("Automation").Cells(1, 2).Value = "" Then
    
    ThisWorkbook.Sheets("Automation").Cells(1, 2).Value = "Yes"
    
    dummy = Mid(dummy, InStr(1, LCase(dummy), "/e/") + 3)
     
    CmdPar = Split(dummy, "/")
    
    If UBound(CmdPar) < 1 Then Exit Sub
    ThisWorkbook.Sheets("Settings").Range("GSIUser").Value = CmdPar(0)
    ThisWorkbook.Sheets("Password").Range("GSIFTRPwd").Value = CmdPar(1)
    
    Application.EnableEvents = False
        For C = 2 To UBound(CmdPar)
            ThisWorkbook.Sheets("Start").Cells(C + 1, 3).Value = CmdPar(C)
        Next C
    Application.EnableEvents = True
    
    ThisWorkbook.Sheets("Start").Activate
    ThisWorkbook.Sheets("Start").Range("C3:C" & UBound(CmdPar) + 1).Select
    
    RefreshIncidents
    
    Exit Sub

End If
 

On Error GoTo Ende

UpdateAvailable = False

If ThisWorkbook.Sheets("Start").CBUpdate.BackColor <> vbGreen And _
   ThisWorkbook.Sheets("Version").Cells(3, 2).Value = "" Then

    ' Prüfen ob neue Version vorhanden ist:
    Open "\\atviee202a\FrontEnd\Version.txt" For Input As #1    ' Datei zum einlesen öffnen.
        Do Until EOF(1)
            Line Input #1, Line
            Version = Version & Line
        Loop
    Close #1
    
    NewVersion = Split(Version, ".")
    MyVersion = Split(ThisWorkbook.Sheets("Version").Cells(1, 2).Value, ".")
    
    ' Versionen vergleichen
    For C = LBound(NewVersion) To UBound(NewVersion)
        If CDec(NewVersion(C)) > CDec(MyVersion(C)) Then
            UpdateAvailable = True
            Exit For
        End If
    Next C
    
    ' Wenn neuere Version vorhanden:
    If UpdateAvailable Then
        
        ThisWorkbook.Sheets("Start").CBUpdate.BackColor = vbGreen
        
        ' Implemented Changes erarbeiten.
        MyNiceVersion = "V" & MyVersion(0) & "." & MyVersion(1) & " R" & CDec(MyVersion(2))
        ImplementedChanges = ""
        
        ' eingebrachte Änderungen auslesen:
        Open "\\atviee202a\FrontEnd\Changes.txt" For Input As #1    ' Datei zum einlesen öffnen.
            Do Until EOF(1)
                Line Input #1, Line
                If InStr(1, Line, MyNiceVersion) > 0 Then Exit Do
                If ImplementedChanges = "" Then
                    ImplementedChanges = Line
                Else
                    ImplementedChanges = ImplementedChanges & Chr(10) & Line
                End If
            Loop
        Close #1
        
        If MsgBox("A new version of IncidentAnalyser is available!" & Chr(10) & Chr(10) & _
                  "Do you want to update?" & Chr(10) & Chr(10) & _
                  "Following changes were implemented since your version:" & Chr(10) & _
                  "=================================================" & Chr(10) & _
                  ImplementedChanges, _
                  vbInformation + vbYesNo, _
                  "Update available") = vbYes Then
                  
                  Call UpdateFrontEnd
                
        End If
    End If
    ThisWorkbook.Sheets("Version").Cells(3, 2).Value = "checked"
    ThisWorkbook.Saved = True
    
End If

Ende:
If ThisWorkbook.Sheets("Version").Cells(3, 2).Value = "" Then
    ThisWorkbook.Sheets("Version").Cells(3, 2).Value = "checked"
    ThisWorkbook.Saved = True
End If

End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

If Application.UserName = "Christian Schleinzer" Then

    Dim C As Integer
    Dim Version As String
    Dim Answer As VbMsgBoxResult
    Dim MyVersion
    
    Version = ""
    
    Answer = MsgBox("New stable Release?", vbYesNoCancel)
    
    If Answer = vbCancel Then
        Cancel = True
    ElseIf Answer = vbYes Then
    
        MyVersion = Split(ThisWorkbook.Sheets("Version").Cells(1, 2).Value, ".")

        MyVersion(UBound(MyVersion)) = CStr(Format(CDec(MyVersion(UBound(MyVersion))) + 1, "000"))
        
        For C = LBound(MyVersion) To UBound(MyVersion)
            If Version = "" Then
                Version = MyVersion(C)
            Else
                Version = Version & "." & MyVersion(C)
            End If
        Next C
        
        ThisWorkbook.Sheets("Version").Cells(1, 2).Value = Version
        ThisWorkbook.Sheets("Version").Cells(2, 2).Value = Format(Now, "DD.MM.YYYY hh:mm:ss")
        
        UFChanges.Show
        
    End If

End If
    
End Sub

Attribute VB_Name = "Tabelle7"
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_Control = "CBUnhideColumns, 1364, 4, MSForms, CommandButton"
Attribute VB_Control = "CBExport, 2, 5, MSForms, CommandButton"
Attribute VB_Control = "CBClear, 3, 6, MSForms, CommandButton"
Attribute VB_Control = "CBSettings, 5, 7, MSForms, CommandButton"
Attribute VB_Control = "CBHelp, 27, 8, MSForms, CommandButton"
Attribute VB_Control = "CBUpdate, 40, 9, MSForms, CommandButton"
Attribute VB_Control = "CBRefreshSelected, 1240, 10, MSForms, CommandButton"
Attribute VB_Control = "TBHLs, 1305, 11, MSForms, ToggleButton"
Attribute VB_Control = "CBColumnOrder, 1362, 12, MSForms, CommandButton"
Attribute VB_Control = "CBHideColumns, 1363, 13, MSForms, CommandButton"
Attribute VB_Control = "CBResetColumnOrder, 1367, 14, MSForms, CommandButton"
Attribute VB_Control = "CBShowReport, 1420, 15, MSForms, CommandButton"
Option Explicit

Private Sub Worksheet_Activate()
Dim C As Integer
Dim sh As Worksheet


' Wenn Knopf zum Einblenden aller Spalten schon rot is, das Makro abbrechen
If Me.CBUnhideColumns.BackColor <> vbRed Then
    For C = 1 To 16
        If Columns(C).EntireColumn.Hidden Then
            Me.CBUnhideColumns.BackColor = vbRed
            Me.CBUnhideColumns.Enabled = True
            Exit Sub
        End If
    Next C
End If

If Not IsDefaultColumnOrderSet Then
    Me.CBResetColumnOrder.BackColor = vbRed
    Me.CBResetColumnOrder.Enabled = True
Else
    Me.CBResetColumnOrder.BackColor = vbButtonFace
    Me.CBResetColumnOrder.Enabled = False
End If

For Each sh In ThisWorkbook.Worksheets
    If InStr(1, sh.Name, "_Report") = 11 Then
        Me.CBExport.Enabled = True
        Me.CBExport.BackColor = vbGreen
        Me.CBClear.Enabled = True
        Me.CBClear.BackColor = vbRed
        Exit Sub
    End If
Next sh

Me.CBExport.Enabled = False
Me.CBExport.BackColor = vbButtonFace
Me.CBClear.Enabled = False
Me.CBClear.BackColor = vbButtonFace

RedrawButtons
    
End Sub

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

Dim UserName As String
Dim Password As String
Dim url As String
Dim appIE As Object   ' InternetExploer

Dim e As Integer
Dim C As Integer

Dim NCError As Integer


Dim oWin

Dim Ticket As String

Dim Erstneuladen As Boolean

Dim IEThere As Boolean

Ticket = ThisWorkbook.Sheets("Start").Range(Target.Range.Address).Value

Dim StartTime As String


Erstneuladen = True
NCError = 0

'Dim wshshell

UserName = ThisWorkbook.Sheets("Settings").Range("GSIUser").Value
Password = DecodeCredentials(ThisWorkbook.Sheets("Password").Range("GSIFTRPwd").Value)
''url = "http://prdrace1.global-intra.net:8181/ictsft/servlet/ft.report?$casenumber$=" & ThisWorkbook.Sheets("Start").Range(Target.Range.Address).Value & "&$server$=prdrace1.global-intra.net&$worklogtype$=allworklogs&$username$=" & UserName & "&$password$=" & DecodeCredentials(Password)
'url = "http://prdrace1.global-intra.net:8181/ictsft_old_vs/servlet/ft.report?$casenumber$=" & ThisWorkbook.Sheets("Start").Range(Target.Range.Address).Value & "&$server$=prdrace1.global-intra.net&$withoutsystemworklogs$=false&$username$=" & UserName & "&$password$=" & DecodeCredentials(Password)
'
'Set wshshell = CreateObject("WScript.Shell")
'wshshell.Run url

If UserName <> "" And Password <> "" Then

Erneut:
     For Each oWin In CreateObject("shell.application").Windows
        On Error GoTo DaNexte
            If oWin.Name = "Windows Internet Explorer" Then
                Set appIE = oWin
                IEThere = True
DaNexte:
            End If
        On Error GoTo 0
    Next
    
    If appIE Is Nothing Then
        On Error Resume Next
            Set appIE = CreateObject("InternetExplorer.Application")
            IEThere = False
        On Error GoTo 0
    End If

    If appIE Is Nothing Then
        If e = 100 Then GoTo Normal
        e = e + 1
        GoTo Erneut
    End If



    ' IE sichtbar machen und zum FTR navigieren
    appIE.Visible = True
    SetForegroundWindow appIE.hwnd
    appIE.Silent = True

    'appIE.Navigate ("http://prdrace1.global-intra.net:8181/ictsft/servlet/ft.report?$casenumber$=" & Ticket & "&$server$=prdrace1.global-intra.net&$worklogtype$=allworklogs")
    'appIE.newtab
    If IEThere Then
        appIE.Navigate2 ("http://prdrace1.global-intra.net:8181/ictsft/servlet/ft.report?$casenumber$=" & Ticket & "&$server$=prdrace1.global-intra.net&$worklogtype$=allworklogs"), _
        2048 '2048=open in new tab
    Else
        appIE.Navigate ("http://prdrace1.global-intra.net:8181/ictsft/servlet/ft.report?$casenumber$=" & Ticket & "&$server$=prdrace1.global-intra.net&$worklogtype$=allworklogs")
    End If

Nochmal:
    ' Warten bis url fertig geladen wurde => Nach 30 Sekunden abbrechen (wenn da der loginscreen nicht da ist, hats was)
    StartTime = CDec(DateValue(Now) + TimeValue(Now))
    Do While appIE.Busy
        DoEvents
        If CDec(DateValue(Now) + TimeValue(Now)) - CDec(StartTime) > 1.15740740740741E-05 * 30 Or _
           C >= 10 Then
            GoTo Ende
        End If
    Loop

    
    
NeuSuchen:
'    Set appIE = Nothing
'
'    For Each oWin In CreateObject("shell.application").Windows
'        On Error Resume Next
'            If oWin.Name = "Windows Internet Explorer" Then
'                Set appIE = oWin
'                Exit For
'danext:
'            End If
'        On Error GoTo 0
'    Next

    ' Eine sekunde noch warten, sonst hängt der nächste befehl evtl.
    Sleep 1000
    
    ' Prüfen ob der FTR wieder mal spinnt
    If InStr(appIE.Document.Body.innertext, "Operational Report Error") > 0 Then
        Exit Sub
    End If

    ' Prüfen ob es sich um ein altes ICTS ticket handlet => Kein login notwendig, also einfach abbrechen
    If InStr(appIE.Document.Body.innertext, "ICTS Full Ticket Report ") = 1 Then
        Exit Sub
    End If

    ' Logindaten ausfüllen und weiter
    On Error GoTo NeuLaden
        If appIE.Document.all("UserName") Is Nothing Then
            NCError = NCError + 1
            If NCError >= 10 Then
                MsgBox "It seeme like InternetExplorer can not load the FTR, please check the connectivity with the SEN network!", _
                       vbCritical + vbOKOnly, _
                       "Can not load FTR"
                Exit Sub
            Else
                GoTo NeuSuchen
            End If
        End If
        appIE.Document.all("UserName").Value = UserName
    On Error GoTo 0
    appIE.Document.all("Password").Value = Password
    appIE.Document.all("Submit").Click
    
    Do While appIE.Busy
        DoEvents
        If CDec(DateValue(Now) + TimeValue(Now)) - CDec(StartTime) > 1.15740740740741E-05 * 30 Or _
           C >= 10 Then
            GoTo Ende
        End If
    Loop
    
    
    appIE.Document.Title = Ticket

Ende:
    Set appIE = Nothing

Else
Normal:
    Shell url, vbNormalFocus
    Shell "C:\Progz\Opera\opera.exe " & url, vbNormalFocus

End If

Exit Sub

NeuLaden:
Sleep 3000
appIE.Refresh2 3
C = C + 1
GoTo Nochmal

Fehler:

End Sub

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.rows.Count > 1 Then Exit Sub
    If Target.Row > 2 Then
        If Application.CutCopyMode <> xlCopy And _
           Application.CutCopyMode <> xlCut Then
            ReadColumnOrder
        
            If SheetExists(Cells(Target.Row, ColIncNumber).Value & "_Report") Then
                CBShowReport.BackColor = &HC0FFC0
                CBShowReport.Enabled = True
            Else
                CBShowReport.BackColor = vbButtonFace
                CBShowReport.Enabled = False
            End If
        End If
    End If

End Sub


Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

Dim AlterName As String
Dim AlteSpalte As Integer

Dim NeuerName As String
Dim NeueSpalte As Integer

Dim sh As Worksheet

Set sh = ThisWorkbook.Sheets("Spaltenkonfiguration")

    
    If Target.Row = 2 And Target.Column > 1 And Target.Column < 18 Then
    
        If Target.Value = "" Then
            Target.Value = MissingColName
            MsgBox "Please do not delete column captions!", _
                   vbCritical + vbOKOnly, _
                   "Protected data"
            Exit Sub
        End If
        
        NeuerName = Target.Value
        NeueSpalte = Target.Column
        
        AlterName = MissingColName
        If AlterName = "" Then Exit Sub
        AlteSpalte = sh.Range(CStr(CStr(Replace(Replace(NeuerName, ".", ""), " ", "")) & "Col")).Value
        
        Application.EnableEvents = False
            Target.Value = AlterName
        Application.EnableEvents = True
        
        
        If ColumnSwitcher(Me, NeueSpalte, AlteSpalte) Then

            sh.Range(CStr(CStr(Replace(Replace(NeuerName, ".", ""), " ", "")) & "Col")).Value = NeueSpalte
            sh.Range(CStr(CStr(Replace(Replace(AlterName, ".", ""), " ", "")) & "Col")).Value = AlteSpalte
            If Not IsDefaultColumnOrderSet Then
                Me.CBResetColumnOrder.BackColor = vbRed
                Me.CBResetColumnOrder.Enabled = True
            Else
                Me.CBResetColumnOrder.BackColor = vbButtonFace
                Me.CBResetColumnOrder.Enabled = False
            End If
            
        End If
        
    End If
    
End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim tmp

' Prüfen ob Sheet vorhanden:
On Error GoTo NixDa
    tmp = ThisWorkbook.Sheets(Target.Value & "_Report").Cells(1, 1).Value
On Error GoTo 0

    ' Tabellenblatt aktivieren:
    Cancel = True
    ThisWorkbook.Sheets(Target.Value & "_Report").Activate
Exit Sub

NixDa:
End Sub

Private Sub CBRefreshSelected_Click()

Dim rng As Range
Dim rws As Collection

Set rws = New Collection

If Not CredentialsAvailable Then
    MsgBox "Please enter your credentials to access Full Ticket Reports.", _
           vbCritical + vbOKOnly, _
           "Missing credentials"
    
    ThisWorkbook.Sheets("Settings").Visible = xlSheetVisible
    ThisWorkbook.Sheets("Settings").Activate
    ThisWorkbook.Sheets("Settings").Range("GSIUser").Select
    
    Exit Sub
    
End If

For Each rng In Selection
    On Error Resume Next
        If Not rows(rng.Row).Hidden Then rws.Add rng.Row, CStr(rng.Row)
    On Error GoTo 0
Next rng

If rws.Count > 30 Then
    MsgBox "Please do not refresh more than 30 Incidents in one run!", _
           vbInformation + vbOKOnly, _
           "Too much Incidents to refresh"
Else
    ' Ausgewählte Incidents aktualisieren
    Call RefreshIncidents
End If

RedrawButtons
     
End Sub

Private Sub CBShowReport_Click()

    If Selection.rows.Count > 1 Then Exit Sub
    
    If Selection.Row > 2 Then
        ReadColumnOrder
        If SheetExists(Cells(Selection.Row, ColIncNumber).Value & "_Report") Then
            ThisWorkbook.Sheets(Cells(Selection.Row, ColIncNumber).Value & "_Report").Activate
        End If
    End If
    
    RedrawButtons
    
End Sub


Private Sub TBHLs_Change()

    ToggleHLsInStartSheet
    
    RedrawButtons
    
End Sub

Private Sub CBColumnOrder_Click()

    UFChangeColumns.Tag = "Start"
    UFChangeColumns.LaCaption.Caption = "Please select any cell in the column you want to change, and press " & Chr(34) & "Continue" & Chr(34) & "."
    UFChangeColumns.LaCaption.Height = 36
    UFChangeColumns.CBOK.Caption = "Continue"
    UFChangeColumns.CoBoColumns.Visible = False
    UFChangeColumns.Show vbModeless
    
    RedrawButtons
                  
End Sub

Private Sub CBResetColumnOrder_Click()

    RestoreColumnOrder Me, 2
    Me.CBResetColumnOrder.BackColor = vbButtonFace
    Me.CBResetColumnOrder.Enabled = False
    
    RedrawButtons
End Sub

Private Sub CBHideColumns_Click()
    
    Dim rng As Range
    
    For Each rng In Selection
        Columns(rng.Column).EntireColumn.Hidden = True
    Next rng
    
    Me.CBUnhideColumns.BackColor = vbRed
    Me.CBUnhideColumns.Enabled = True
    
    RedrawButtons
    
End Sub


Private Sub CBUnhideColumns_Click()
    Columns.Hidden = False
    Me.CBUnhideColumns.BackColor = vbButtonFace
    Me.CBUnhideColumns.Enabled = False
    
    RedrawButtons
End Sub

Private Sub CBExport_Click()

    ' Reporte in neue Datei exportieren
    Call ExportReports
    
    RedrawButtons
    
End Sub

Private Sub CBClear_Click()
    
    ' Reporte löschen
    Call ClearReports
    Me.CBExport.BackColor = vbButtonFace
    Me.CBExport.Enabled = False
    Me.CBClear.BackColor = vbButtonFace
    Me.CBClear.Enabled = False
    
    RedrawButtons
    
End Sub

Private Sub CBSettings_Click()

    ' Blatt einblenden/aktivieren
    If ThisWorkbook.Sheets("Settings").Visible = xlSheetHidden Then
        ThisWorkbook.Sheets("Settings").Visible = xlSheetVisible
        ThisWorkbook.Sheets("Settings").Activate
    Else
        ThisWorkbook.Sheets("Settings").Activate
    End If
    
    RedrawButtons
    
End Sub

Private Sub CBHelp_Click()

    ' Blatt einblenden/aktivieren
    If ThisWorkbook.Sheets("Documentation").Visible = xlSheetHidden Then
        ThisWorkbook.Sheets("Documentation").Visible = xlSheetVisible
        ThisWorkbook.Sheets("Documentation").Activate
    Else
        ThisWorkbook.Sheets("Documentation").Activate
    End If
    
    RedrawButtons
    
End Sub


Private Sub CBUpdate_Click()

    ' Update starten
    Call UpdateFrontEnd
    
    RedrawButtons
    
End Sub


Private Sub RedrawButtons()

    CBRefreshSelected.ShapeRange.Height = 30
    CBRefreshSelected.ShapeRange.Height = 24.75
    
    CBShowReport.ShapeRange.Height = 30
    CBShowReport.ShapeRange.Height = 24.75

    TBHLs.ShapeRange.Height = 30
    TBHLs.ShapeRange.Height = 24.75

    CBColumnOrder.ShapeRange.Height = 30
    CBColumnOrder.ShapeRange.Height = 24.75

    CBResetColumnOrder.ShapeRange.Height = 30
    CBResetColumnOrder.ShapeRange.Height = 24.75

    CBHideColumns.ShapeRange.Height = 30
    CBHideColumns.ShapeRange.Height = 24.75

    CBUnhideColumns.ShapeRange.Height = 30
    CBUnhideColumns.ShapeRange.Height = 24.75
    CBUnhideColumns.Locked = True

    CBExport.ShapeRange.Height = 30
    CBExport.ShapeRange.Height = 24.75

    CBClear.ShapeRange.Height = 30
    CBClear.ShapeRange.Height = 24.75

    CBSettings.ShapeRange.Height = 30
    CBSettings.ShapeRange.Height = 24.75
    
    CBHelp.ShapeRange.Height = 30
    CBHelp.ShapeRange.Height = 24.75
    
    CBUpdate.ShapeRange.Height = 30
    CBUpdate.ShapeRange.Height = 24.75
    
End Sub


Attribute VB_Name = "Tabelle2"
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_Control = "CBHideConfig, 1, 0, MSForms, CommandButton"
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    ' Wenn Doppelklick auf Zelle "B5"
    If Target.Row = 6 And Target.Column = 2 Then
        ' Blatt ein/ausblenden
        If ThisWorkbook.Sheets("Colors").Visible = xlSheetHidden Then
            ThisWorkbook.Sheets("Colors").Visible = xlSheetVisible
            ThisWorkbook.Sheets("Colors").Activate
        Else
            ThisWorkbook.Sheets("Colors").Visible = xlSheetHidden
        End If
        Cancel = True
    End If
    
    
    ' Wenn Doppelklick auf Zelle "B7"
    If Target.Row = 7 And Target.Column = 2 Then
        ' Blatt ein/ausblenden
        If ThisWorkbook.Sheets("Spaltenkonfiguration").Visible = xlSheetHidden Then
            ThisWorkbook.Sheets("Spaltenkonfiguration").Visible = xlSheetVisible
            ThisWorkbook.Sheets("Spaltenkonfiguration").Activate
        Else
            ThisWorkbook.Sheets("Spaltenkonfiguration").Visible = xlSheetHidden
        End If
        Cancel = True
    End If
    
End Sub

Private Sub CBHideConfig_Click()
    Me.Visible = xlSheetHidden   ' Blatt ausblenden
End Sub


Attribute VB_Name = "Tabelle3"
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_Control = "CBHide, 1, 0, MSForms, CommandButton"
Option Explicit

Private Sub CBHide_Click()
    Me.Visible = xlSheetHidden   ' Blatt ausblenden
End Sub

Attribute VB_Name = "Tabelle4"
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_Control = "CBHideColorSheet, 1, 0, MSForms, CommandButton"
Option Explicit

Private Sub CBHideColorSheet_Click()
    Me.Visible = xlSheetHidden   ' Blatt ausblenden
End Sub

Attribute VB_Name = "GSI_Flow"
Option Explicit

'Sub CreateIncidentReports(ByVal TicketNumbersAsStringOrArray)
Sub CreateIncidentReports(ByVal Numbers As Collection)

'Output:
' Für jedes Ticket wird ein Blatt mit Namen "%Ticketnummer%_Report" erstellt

Dim colsh As Worksheet

Variablen:
Dim ac As Integer    ' Zähler zum Array durchlaufen
Dim rc As Integer    ' Zähler für abgearbeitete incidents pro durchlauf
Dim Arr              ' Array oder String, je nach Übergabeparameter
'Dim Numbers As Collection   ' Collection mit allen Nummern für die Reporte erstellt werden sollen
Dim Numbers2Remove As Collection ' Collection mit allen zu löschenden Nummern damit nicht während for each gelöscht wird
Dim Number As clsRequest       ' String zum speichern der aktuellen Nummer
Dim Numbera As clsRequest       ' String zum speichern der aktuellen Nummer
Dim Nummer
Dim OutputSheetName As String   ' Name des AusgabeSheets
Dim ReportCount As Integer     ' Zahl aller zu erstellender Reports damit "Watchdog Timer berechnet werden kann

Dim CreateNewReport As Boolean ' Damit gespeichert werden kann ob der Report neu erstellt werden soll
Dim WaitingTime As Integer     ' Damit die Laufzeit berechnet werden kann
Dim ReportCreation As String   ' ErstellDatum des vorhandenen Reports
Dim RequestFolder As String    ' Pfad zum Request Folder (in diesem Ordner werden Dateien erstellt mit der Ticketnummer als Namen
Dim ReportFolder As String     ' Pfad zum Report Folder (in diesem Ordner werden die exportierten Incident-Klassen gespeichert)
Dim Datum As String            ' Damit das Datum korrekt berechnet werden kann
Dim ReportAge As Double        ' Alter des bereits existierenden Reports
Dim LatestProblemtic As clsTicket ' Damit in der Übersicht immer das letzte Problem Ticket angezeigt wird
Dim LatestICTStic As clsTicket       ' Damit in der Übersicht immer das letzte ICTS Ticket angezeigt wird
Dim WO As String                  ' Damit die aktuellste Workorder gespeichert werden kann
Dim WOText As String                  ' Damit der aktuellste WorkorderText gespeichert werden kann

Dim ExtendedConnectorActivity As Boolean
Dim OldFiles As Collection
Dim NewFiles As Collection
Dim MessageShowed As Boolean

Dim Answer As VbMsgBoxResult

Dim Incident As clsIncident    ' Jeweiliger Incident
Dim Zeile As Long

Dim tic As clsTicket

Dim CommaCharacter As String
Dim ChangeComma As Boolean

Dim GSIUser As String
Dim GSIFTRPwd As String

Dim WinUser As String
Dim CreateTaskString As String
Dim ExecuteTaskString As String
Dim DeleteTaskString As String
Dim ff As Integer
Dim ConfigureAccessAttempts As Integer

Dim MissingNumbers As String


GSIUser = ThisWorkbook.Sheets("Settings").Range("GSIUser").Value
GSIFTRPwd = ThisWorkbook.Sheets("Password").Range("GSIFTRPwd").Value
ConfigureAccessAttempts = 0

CommaCharacter = Mid(CCur(1.1), 2, 1)

If CommaCharacter <> "," Then
    ChangeComma = True
Else
    ChangeComma = False
End If

Set ssh = ThisWorkbook.Sheets("Settings") ' zum Auslesen der Variablen
Set colsh = ThisWorkbook.Sheets("Colors")
RequestFolder = ssh.Range("RequestShare").Value & "\"
ReportFolder = ssh.Range("ReportShare").Value & "\"
WaitingTime = 0
ExtendedConnectorActivity = False   ' Legt fest ob eine erweiterte Erkennung ob der Connector aktiv ist durchgeführt werden soll
ConnectorActive = False
MessageShowed = False
'Set Numbers = New Collection

' Prüfen ob sleep.exe am System vorhanden ist
If Dir("sleep.exe") <> "" Then
    SleepIsThere = True
Else
    SleepIsThere = False
End If

' Datum speichern
Datum = Date
If InStr(1, Datum, " ") <> 0 Then Datum = Left(Datum, InStr(1, Datum, " ") - 1)  ' Falsche Zeichen entfernen (Griechenland, Bulgarien)
            

'' 1. Paramenter in Collection umwandeln, damit mit for each gearbeitet werden kann:
'If IsArray(TicketNumbersAsStringOrArray) Then
'    Set Arr = TicketNumbersAsStringOrArray        ' Array in Arr speichern
'ElseIf InStr(TicketNumbersAsStringOrArray, "|") Then
'    Arr = Split(TicketNumbersAsStringOrArray, "|")   ' String im Format N1|N2 in Array splitten
'Else
'    Arr = TicketNumbersAsStringOrArray              ' String speichern
'End If
'
'' Collection füllen
'If IsArray(Arr) Then
'    For ac = LBound(Arr) To UBound(Arr)
'        On Error GoTo Weiter
'            Numbers.Add Arr(ac), Arr(ac)
'Weiter:
'        On Error GoTo 0
'    Next ac
'Else
'    On Error GoTo Weiter1
'        Numbers.Add Arr, Arr
'Weiter1:
'    On Error GoTo 0
'End If

ReportCount = Numbers.Count

Application.StatusBar = "Requesting IncidentReports"

' Reports vom Backend anfordern
For Each Number In Numbers
    
    CreateNewReport = True

    ' Prüfen ob es sich um eine gültige Ticketnummer handelt
    If TicketNumber(Number.Number) <> "" Then
    
        iniFile = ReportFolder & Number.Number & ".ini"
        ' Prüfen ob Report für Ticket in den letzten 3 Minuten erstellt wurde, sonst neuen anfordern
        
        If IniIsThere(iniFile) Then  ' Report schon vorhanden!
        
            ReportCreation = ReadValueFromFile(iniFile, "ReportCreationTime")
            If ChangeComma Then ReportCreation = Replace(ReportCreation, ",", CommaCharacter)
            ReportAge = (DateValue(Datum) + TimeValue(Time)) - CDec(ReportCreation)
            
            ' Wenn Report in den letzten 3 Minuten erstellt worden ist, einfach den vorhandenen Anzeigen
            ' Wichtig für verlinkte Incidents, damit alle Reports sicher zur selben Zeit vorhanden sind ~80 Sekunden?!? (*2 + puffer sind 3 Minuten)
            If ReportAge > 2.08333333333333E-03 Then
                Kill iniFile         ' Immer neuen Report anzeigen, also vorhandenen einfach löschen
            Else ' Wenn Report in den letzten 3 Minuten erstellt wurde, einfach anzeigen
                CreateNewReport = False
            End If
                            
        End If
        
        ' Wenn neuer Report erstellt werden soll das entsprechende Request-File erstellen......
        If CreateNewReport Then
            
AccessConfigured:
            ff = FreeFile
            On Error GoTo ZugriffsFehler
                If Not IniIsThere(RequestFolder & Number.Number) Then
                    Open RequestFolder & Number.Number For Output As #ff    ' Datei zur Ausgabe öffnen.
                        Print #ff, Application.UserName
                        Print #ff, "%KEY%GSIUSER%KEY%=" & EncodeCredentials(GSIUser)
                        Print #ff, "%KEY%GSIFTRPWD%KEY%=" & GSIFTRPwd
                    Close #ff
                End If
            On Error GoTo 0
        End If
        
    End If
    
Next Number

'Alle benötigten Reporte wurden angefordert.....

' Alle Reports abarbeiten
Do While Numbers.Count > 0
    
    ' Eine Sekunde warten
    Wait1Second
    
    ' Waitingtime berechnen & Status ausgeben
    If Numbers.Count = 1 Then
        Application.StatusBar = "Waiting for IncidentReports (" & Numbers.Count & " Report left)"
    Else
        Application.StatusBar = "Waiting for IncidentReports (" & Numbers.Count & " Reports left)"
    End If
    WaitingTime = WaitingTime + 1
    
    ' Alle 2 Minuten nachfragen ob weiter gewartet werden soll....
    If WaitingTime Mod 120 = 0 Then
        
        MissingNumbers = ""
        
…
embedded_office_0005c458.exe embedded-pe Office MZ+PE at offset 0x5C458 405416 bytes
SHA-256: 386c231b33a4e2b84c84a3a3fe3eeedfac244fb8986ab4ae8b1a3e973443f53b
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Static shellcode analysis recovered command string(s): WScript.Shell")4$ Carved artifact contains 29 Chr/ChrW string-construction calls. Carved macro source contains an auto-exec entry point and execution/download terms.
ole10native_00.bin ole-package OLE Ole10Native stream: MBD03522546/Ole10Native 16474 bytes
SHA-256: 76b4eb5f04c865752739f4d7ec80313e439c600bd297fcc82703cf6a538c1e6a

Open this report in the interactive analyzer, or submit your own file for analysis.