Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 a4bb940c44d7d0c1…

MALICIOUS

Office (OOXML)

1.96 MB Created: 2001-11-17 01:06:50 UTC Authoring application: Microsoft Excel 16.0300 First seen: 2021-06-20
MD5: 46956edd51d9344b490e0c63a2ae5f80 SHA-1: 40dc44e8254ec6a7702ba1341484e9289cdf6fc9 SHA-256: a4bb940c44d7d0c153ed0ac3b0007c2ae4746fe6bc830d3fd30a3c0d21809692
426 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File

The sample is an Office Open XML document containing a VBA project with an Auto_Open macro. This macro utilizes WScript.Shell and CreateObject to execute arbitrary code, strongly indicating it's designed to download and run a second-stage payload. The presence of obfuscated auto-executing VBA code and the use of Shell() calls are critical indicators of malicious intent. While many URLs were extracted, they were all confirmed as benign or unknown, suggesting the actual payload delivery mechanism is not directly exposed in this file.

Heuristics 13

  • VBA project inside OOXML medium 10 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
        result = F_7_AB_1_ShellAndWaitSimple(CMND, 0)
'    dRetVal = Shell("C:\upload.bat", 0) 'upload the file
    aaa = 0
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
    ' message for 5 seconds, title "Attention:"
   i = CreateObject("wscript.shell").popup("Copyright [2019] National Technology & Engineering Solutions of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with NTESS, there is a non-exclusive license for use of this work by or on behalf of the U.S. Government. Export of this data may require a license from the United States Government.", 5, "Attention:")
'  MsgBox ("Copyright [2019] National Technology & Engineering Solutions of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with NTESS, there is a non-exclusive license for use of this work by or on behalf of the U.S. Government. Export of this data may require a license from the United States Government.")
  • LOLBin reference in VBA critical OLE_VBA_LOLBIN
    LOLBin reference in VBA
    Matched line in script
    'RetVal = Shell(PDFfilename + ".PDF", 1)
Shell "RunDLL32.EXE shell32.dll,ShellExec_RunDLL " + PDFfilename + ".PDF"
End Sub
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
    ' message for 5 seconds, title "Attention:"
   i = CreateObject("wscript.shell").popup("Copyright [2019] National Technology & Engineering Solutions of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with NTESS, there is a non-exclusive license for use of this work by or on behalf of the U.S. Government. Export of this data may require a license from the United States Government.", 5, "Attention:")
'  MsgBox ("Copyright [2019] National Technology & Engineering Solutions of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with NTESS, there is a non-exclusive license for use of this work by or on behalf of the U.S. Government. Export of this data may require a license from the United States Government.")
  • GetObject call high OLE_VBA_GETOBJ
    GetObject call
    Matched line in script
    Set wdapp = GetObject(, "Word.Application")
Set mydoc = wdapp.ActiveDocument
  • CallByName call high OLE_VBA_CALLBYNAME
    CallByName call
    Matched line in script
    '''''''''''''''''''''''''''''''''''''''''''''
' Use CallByName to set the text of
' A_7_AB_1_MessageControl's Text or Caption
  • 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.
  • Auto_Open macro low OLE_VBA_AUTO
    Auto_Open macro
    Matched line in script
    'Routine to start the sample app.
Sub Auto_Open()
    Dim newsheet As Object, gatesheet As Object
  • Auto_Close macro low OLE_VBA_AUTOCLOSE
    Auto_Close macro
    Matched line in script
    Sub ResetMenus_by_auto()
Auto_Close
Auto_Open
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
    Do
    EnvString = Environ(indx)
    Cells(indx, 1) = EnvString
  • External relationship high OOXML_EXTERNAL_REL
    External target in xl/externalLinks/_rels/externalLink1.xml.rels: file:///E:\test\NUPEC\M2x\NUPEC M-8-2\NUPEC M-8-2 plots.xls
  • 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://www.oaltd.co.uk OOXML external relationship
    • http://vbadud.blogspot.comOOXML external relationship
    • https://meldevlnx32.sandia.gov/svn/developers/llhumph/PTFRead/trunk/OOXML external relationship
    • https://melzilla.sandia.gov/buglist.cgi?query_format=advanced&short_desc_type=allwordssubstr&OOXML external relationship
    • http://melcor.sandia.gov/OOXML external relationship
    • https://melzilla.sandia.gov/OOXML external relationship
    • https://melcorwiki.sandia.gov/index.php/Main_PageOOXML external relationship
    • https://melzilla.sandia.gov/buglist.cgi?list_id=2602&classification=MELCOR%20Code&chfieldto=Now&query_format=advanced&chfieldfrom=-10M&bug_status=UNCONFIRMED&bug_status=NEW&bug_status=ASSIGNED&bug_status=REOPENED&bug_status=RESOLVED&bug_status=VERIFIEDOOXML external relationship
    • http://www.bing.com/search?q=oxmlhttp.open+password+subversion&form=QBREOOXML external relationship
    • http://melcor.sandia.gov/�OOXML external relationship
    • https://melcorwiki.sandia.gov/index.php/Main_Page�OOXML external relationship

Extracted artifacts 7

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source from OOXML) 1297246 bytes
SHA-256: a2ca8122bd7f06d567ec7dbbdb69826648772050fe0b72964c277edaa88cb7d0
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









Attribute VB_Name = "Whichvariables"
Attribute VB_Base = "0{11BACED7-823E-4E80-8AE8-E59B5A855B8D}{02D0CEF9-D206-42BB-A2D2-D91444C10E0C}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub CheckBox1_Click()
a = Whichvariables.CheckBox1.Value
If Whichvariables.CheckBox1.Value Then
Whichvariables.ListBox1.MultiSelect = fmMultiSelectExtended
Whichvariables.ListBox2.MultiSelect = fmMultiSelectExtended
 Whichvariables.Label2.Visible = True
Whichvariables.Label2.Caption = "No description available for multiselect"
Else
 Whichvariables.Label2.Visible = False
Whichvariables.ListBox1.MultiSelect = fmMultiSelectSingle
Whichvariables.ListBox2.MultiSelect = fmMultiSelectSingle
End If
End Sub

Private Sub CheckBox2_Click()
iheight = Whichvariables.Height
If Whichvariables.CheckBox2 Then
   Whichvariables.Height = 380
Else
   Whichvariables.Height = 270
End If
If (PTF1.whVars = "COR-TSVC" Or PTF1.whVars = "COR-TSVB") Then
   If PTF1.whVars = "COR-TSVC" Then
      l = 0
      ReDim entry(PTF1.ncvh)
      For i = 1 To PTF1.icorz
      For j = 1 To PTF1.icorr
       aa = PTF1.corchan(i, j)
       notexist = True
       For l1 = 1 To l
        If aa = entry(l1) Then
          notexist = False
          Exit For
        End If
       Next l1
       If notexist Then
        l = l + 1
        entry(l) = aa
       End If
      Next j
      Next i
   End If
   ReDim Preserve entry(l)
   entry(0) = "All COR cells"
   For j = 1 To l
    entry(j) = "COR cells connected to CVH # " + CStr(entry(j))
   Next j
   Whichvariables.ListBox3.List = entry
End If
If (PTF1.whVars = "FL") Then
   ReDim entry(PTF1.ncvh + 1)           'added + 1
   entry(0) = "All Flow Paths"
   entry(1) = "Flow paths with valves"  'added
   For j = 1 To PTF1.ncvh
    entry(j + 1) = "Flow Paths connected to CVH # " + CStr(PTF1.cvhn(j)) + ": '" + PTF1.cvhname(j) + "'"
   Next j                               'entry(j + 1)
  Whichvariables.ListBox3.List = entry
End If
If (PTF1.whVars = "COR-M") Then
   ReDim entry(PTF1.icorz)
   entry(0) = "All Flow Paths"
   For j = 1 To PTF1.icorz
    entry(j) = "All COR cells at elevation " + CStr(j)
   Next j
  Whichvariables.ListBox3.List = entry
End If
If (PTF1.whVars = "CVH") Then
   ReDim entry(PTF1.nTypes)
   entry(0) = "All Nodes Paths"
   For j = 1 To PTF1.nTypes
    entry(j) = "All CVH volumes of type " + CStr(PTF1.TypeNames(j))
   Next j
  Whichvariables.ListBox3.List = entry
End If
End Sub

Private Sub CommandButton_Click()
  Whichvariables.Hide
End Sub

Private Sub CommandButton1_Click()
Dim entry1(), entry2(), entry()
jc = Whichvariables.ListBox2.ListCount
For j = 1 To jc
 ReDim Preserve entry1(jc - 1)
 ReDim Preserve entry2(jc - 1)
 If Whichvariables.ListBox1.ColumnCount > 1 Then
  entry1(j - 1) = Whichvariables.ListBox2.List(j - 1, 0)
  entry2(j - 1) = Whichvariables.ListBox2.List(j - 1, 1)
 Else
  entry1(j - 1) = Whichvariables.ListBox2.List(j - 1, 0)
 End If
Next j
If Whichvariables.ListBox2.MultiSelect = fmMultiSelectSingle Then
 ReDim Preserve entry1(jc)
 ReDim Preserve entry2(jc)
  isel = Whichvariables.ListBox1.ListIndex
 If Whichvariables.ListBox1.ColumnCount = 1 Then
  entry1(jc) = Whichvariables.ListBox1.List(isel)
 Else
  entry1(jc) = Whichvariables.ListBox1.List(isel, 0)
  entry2(jc) = Whichvariables.ListBox1.List(isel, 1)
 End If
Else
  jc = jc - 1
  For k = 0 To Whichvariables.ListBox1.ListCount - 1
    If Whichvariables.ListBox1.Selected(k) Then
      jc = jc + 1
      ReDim Preserve entry1(jc)
      ReDim Preserve entry2(jc)
      entry1(jc) = Whichvariables.ListBox1.List(k, 0)
      If Whichvariables.ListBox1.ColumnCount > 1 Then _
      entry2(jc) = Whichvariables.ListBox1.List(k, 1)
    End If
  Next k
End If
ReDim Preserve entry(jc, 1)
For k = 0 To jc
 entry(k, 0) = entry1(k)
 entry(k, 1) = entry2(k)
Next k
Whichvariables.ListBox2.List = entry
End Sub

Private Sub CommandButton2_Click()
jc = Whichvariables.ListBox2.ListCount
If jc > 1 Then
 If ListBox2.MultiSelect = fmMultiSelectSingle Then
  isel = Whichvariables.ListBox2.ListIndex
  Whichvariables.ListBox2.RemoveItem (isel)
 Else
  For k = jc - 1 To 0 Step -1
   If Whichvariables.ListBox2.Selected(k) Then
    Whichvariables.ListBox2.RemoveItem (k)
   End If
  Next k
 End If
Else
 Whichvariables.ListBox2.RemoveItem (0)
End If
End Sub

Private Sub CommandButton3_Click()
 PTF1.cb1 = 1
 Whichvariables.Hide
End Sub

Private Sub FilterText_Change()
  If Whichvariables.ListBox1.ColumnCount = 2 Then
    Call TextFilter
  Else
    Call TextFilter
  End If
  
End Sub
Private Sub TextFilter()
  Dim utext(), xlvar(), xinfo1(), xinfo(), foundmatch(1)
  usertext = UCase(Whichvariables.FilterText.Text)
  iLast = Len(usertext)
  If iLast > 0 Then
  clast = Mid(usertext, iLast, 1)
  Else
  clast = ""
  End If
  bang = False
  If clast = "!" Then
   usertext = Mid(usertext, 1, iLast - 1)
   bang = True
  End If
  iseg = 0
  Istart1 = 1
  Do Until Istart1 > Len(usertext)
  i = InStr(Istart1, usertext, "*")
  iseg = iseg + 1
  If i = 0 Then
   ilen = Len(usertext) - Istart1 + 1
   i = Len(usertext) + 1
  Else
   ilen = i - Istart1
  End If
  ReDim Preserve utext(iseg + 1)
  utext(iseg) = Mid(usertext, Istart1, ilen)

  Istart1 = i + 1
  Loop
   inumber = 0
     longest1 = 0
     longest2 = 0
   If IsArrayAllocated(PTF1.info) Then
   For i = 0 To UBound(PTF1.info, 1)
    foundmatch(0) = False
    foundmatch(1) = False
    For l = 0 To 1
    pvar = UCase(PTF1.info(i, l))
    Istart1 = 1
    For k = 1 To iseg
     ifound = InStr(Istart1, pvar, utext(k))
     If ifound > 0 Then
      Istart1 = ifound + Len(utext(k))
      foundmatch(l) = True
     Else
      foundmatch(l) = False
     End If
     If Not foundmatch(l) Then GoTo failed0
    Next k
failed0:
  If iseg > 0 Then
   pos = InStrRev(pvar, utext(iseg))
  End If
  If bang And foundmatch(l) Then
    If (Len(pvar) - pos + 1 = Len(utext(iseg))) Then
    aaa = 0
    Else
     foundmatch(l) = False
    End If
  End If
  Next l
    If foundmatch(1) Or foundmatch(0) Then
     inumber = inumber + 1
     ReDim Preserve xlvar(inumber)
     ReDim Preserve xinfo1(inumber)
     longest1 = maxi(longest1, Len(PTF1.info(i, 0)))
     longest2 = maxi(longest1, Len(PTF1.info(i, 1)))
     xinfo1(inumber - 1) = PTF1.info(i, 1)
     xlvar(inumber - 1) = PTF1.info(i, 0)
    End If
  Next i
  Else
   Exit Sub
  End If

   If inumber = 0 Then
    ReDim xinfo(1, 1)
    Whichvariables.ListBox1.ColumnCount = 2
    Whichvariables.ListBox2.ColumnCount = 2
    Whichvariables.ListBox1.Width = maxi(245, mini(4.5 * (longest1 + 5 + longest2), 245))
    xFont = Whichvariables.ListBox1.Font.Size
    Whichvariables.ListBox1.ColumnWidths = CStr(5 * (longest1 + 1)) & ";" & CStr(5 * (longest2 + 1))
    Whichvariables.ListBox1.List() = xinfo 'lvar()
    GoTo done
   End If
   ReDim xinfo(inumber, 1)
   For i = 1 To inumber
     xinfo(i - 1, 0) = xlvar(i - 1)
     xinfo(i - 1, 1) = xinfo1(i - 1)
   Next i
   If Whichvariables.ListBox1.ColumnCount = 1 Then
    Whichvariables.ListBox1.List() = xlvar()
    Whichvariables.ListBox1.Width = 245
   Else
    Whichvariables.ListBox1.Width = maxi(232, mini(4.5 * (longest1 + 5 + longest2), 232))
    xFont = Whichvariables.ListBox1.Font.Size
    Whichvariables.ListBox1.ColumnWidths = CStr(5 * (longest1 + 1)) & ";" & CStr(5 * (longest2 + 1))
    Whichvariables.ListBox1.List() = xinfo 'lvar()
   End If
done:
End Sub

Private Sub Label1_Click()
l = 0
i = Whichvariables.ListBox1.ListIndex
If i > 0 Then
If PTF1.txtline(i) = "" Then
 Whichvariables.Label2.Visible = False
Else
 Whichvariables.Label2.Visible = True
 Whichvariables.Label2.Caption = PTF1.txtline(i)
End If
End If
End Sub

Private Sub Whichvariables_Click()

End Sub

Private Sub ListBox1_Click()

i = Whichvariables.ListBox1.ListIndex
If i >= 0 Then
If PTF1.txtline(i) = "" Then
 Whichvariables.Label2.Visible = False
Else
 Whichvariables.Label2.Visible = True
 Whichvariables.Label2.Caption = PTF1.txtline(i)
End If
End If
End Sub

Private Sub ListBox2_Click()

i = Whichvariables.ListBox2.ListIndex
jn = Whichvariables.ListBox1.ListCount
atxt = ""
For j = 1 To jn
 If Whichvariables.ListBox1.List(j - 1) = Whichvariables.ListBox2.List(i) Then atxt = PTF1.txtline(j - 1)
Next j
If atxt = "" Then
 Whichvariables.Label2.Visible = False
Else
 Whichvariables.Label2.Visible = True
 Whichvariables.Label2.Caption = atxt
End If
End Sub

Private Sub ListBox3_Click()
aaa = 0
If Whichvariables.ListBox3.ListIndex = 0 Then
   If PTF1.info(1, 1) = "" Then
    Whichvariables.ListBox1.ColumnCount = 1
    Whichvariables.ListBox1.List() = PTF1.lvar()
    Whichvariables.ListBox1.Width = 105
   Else
    Whichvariables.ListBox1.ColumnCount = 2
    Whichvariables.ListBox1.Width = maxi(105, mini(4.5 * (PTF1.longest1 + 5 + PTF1.longest2), 195))
    xFont = Whichvariables.ListBox1.Font.Size
    Whichvariables.ListBox1.ColumnWidths = CStr(5 * (PTF1.longest1 + 1)) & ";" & CStr(5 * (PTF1.longest2 + 1))
    Whichvariables.ListBox1.List() = PTF1.info
   End If
   Exit Sub
ElseIf PTF1.whVars = "FL" And Whichvariables.ListBox3.ListIndex = 1 Then ' FL with valve
'use PTF1.flpathn and flvalvepathi to get the list
If PTF1.info(1, 1) = "" Then
 TwoColumns = False
 ReDim construct2(PTF1.nflpath)
Else
 TwoColumns = True
 ReDim construct(PTF1.nflpath, 0 To 1)
End If
nflpaths = -1
'nvalves = UBound(flvalvepathi) 'error when no valves, ReDim flvalvepathi not done in gSetup
nvalves = PTF1.nvalves
If nvalves = 0 Then
  Whichvariables.ListBox1.Clear
 aaa = 0
   Exit Sub
End If
' if nvalves > 0 is following:
  For ia = 1 To nvalves
For j = 1 To PTF1.nflpath
 If PTF1.flpathn(j) = flvalvepathi(ia) Then
  nflpaths = nflpaths + 1
  If TwoColumns Then
   construct(nflpaths, 0) = PTF1.info(j - 1, 0)
   construct(nflpaths, 1) = PTF1.info(j - 1, 1)
  Else
   construct2(nflpaths) = PTF1.lvar(j - 1)
  End If
 End If
Next j
Next ia
If nflpaths >= 0 Then
   If Not TwoColumns Then
    ReDim Preserve construct2(nflpaths)
    Whichvariables.ListBox1.ColumnCount = 1
    Whichvariables.ListBox1.List() = construct2
    Whichvariables.ListBox1.Width = 105
   Else
    ReDim construct3(nflpaths, 1)
    For i = 0 To nflpaths
      construct3(i, 0) = construct(i, 0)
      construct3(i, 1) = construct(i, 1)
    Next i
    Whichvariables.ListBox1.ColumnCount = 2
    Whichvariables.ListBox1.Width = maxi(105, mini(4.5 * (PTF1.longest1 + 5 + PTF1.longest2), 195))
    xFont = Whichvariables.ListBox1.Font.Size
    Whichvariables.ListBox1.ColumnWidths = CStr(5 * (PTF1.longest1 + 1)) & ";" & CStr(5 * (PTF1.longest2 + 1))
    Whichvariables.ListBox1.List() = construct3
   End If
Else
  Whichvariables.ListBox1.Clear
 aaa = 0
End If
   Exit Sub
End If
'CVH -----------------
If (PTF1.whVars = "CVH") Then
  ihsX = Whichvariables.ListBox3.ListIndex
  If PTF1.info(1, 1) = "" Then
   TwoColumns = False
   ReDim construct2(PTF1.ncvh)
 Else
   TwoColumns = True
   ReDim construct(PTF1.ncvh, 0 To 1)
 End If
nCVHs = -1
For j = 1 To PTF1.ncvh
 If PTF1.cvhTYPE(j) = PTF1.TypeNumbs(ihsX) Then
  nCVHs = nCVHs + 1
  If TwoColumns Then
   construct(nCVHs, 0) = PTF1.info(j - 1, 0)
   construct(nCVHs, 1) = PTF1.info(j - 1, 1)
  Else
   construct2(nCVHs) = PTF1.lvar(j - 1)
  End If
 End If
Next j
nflpaths = nCVHs
End If
'HS -----------------
If (PTF1.whVars = "HS") Then
  ihsX = Whichvariables.ListBox3.ListIndex
  If PTF1.info(1, 1) = "" Then
   TwoColumns = False
   ReDim construct2(PTF1.nhs)
 Else
   TwoColumns = True
   ReDim construct(PTF1.nhs, 0 To 1)
 End If
nHSs = -1
For j = 1 To UBound(PTF1.lvar)
 If InStr(1, PTF1.info(j - 1, 1), hsname(ihsX)) > 0 Then
  nHSs = nHSs + 1
  If TwoColumns Then
   construct(nHSs, 0) = PTF1.info(j - 1, 0)
   construct(nHSs, 1) = PTF1.info(j - 1, 1)
  Else
   construct2(nHSs) = PTF1.lvar(j - 1)
  End If
 End If
Next j
nflpaths = nHSs
End If
'FL connecting CVH -----------------
If (PTF1.whVars = "FL") Then
icvh = Whichvariables.ListBox3.ListIndex - 1 'FL ListIndex 2 to CVH 1, since adding option "Flow paths with valves"
                                             'see Sub CheckBox2_Click()
                                             'entry(j + 1) is "Flow Paths connected to CVH # " + CStr(PTF1.cvhn(j))
If PTF1.info(1, 1) = "" Then
 TwoColumns = False
 ReDim construct2(PTF1.nflpath)
Else
 TwoColumns = True
 ReDim construct(PTF1.nflpath, 0 To 1)
End If
nflpaths = -1
For j = 1 To PTF1.nflpath
 If PTF1.flpathfrm(j) = CStr(PTF1.cvhn(icvh)) Then
  nflpaths = nflpaths + 1
  If TwoColumns Then
   construct(nflpaths, 0) = PTF1.info(j - 1, 0)
   construct(nflpaths, 1) = PTF1.info(j - 1, 1)
  Else
   construct2(nflpaths) = PTF1.lvar(j - 1)
  End If
 End If
 If PTF1.flpathto(j) = CStr(PTF1.cvhn(icvh)) Then
  nflpaths = nflpaths + 1
  If TwoColumns Then
   construct(nflpaths, 0) = PTF1.info(j - 1, 0)
   construct(nflpaths, 1) = PTF1.info(j - 1, 1)
  Else
   construct2(nflpaths) = PTF1.lvar(j - 1)
  End If
 End If
Next j
End If
'COR-M -----------------
If (PTF1.whVars = "COR-M") Then
ind = Whichvariables.ListBox3.ListIndex
aa = Whichvariables.ListBox3.List(ind)
aaa = 0
iimax = PTF1.icorz * PTF1.icorr
If PTF1.info(1, 1) = "" Then
 TwoColumns = False
 ReDim construct2(iimax)
Else
 TwoColumns = True
 ReDim construct(iimax, 0 To 1)
End If
nCorCells = -1
i = ind
For j = 1 To PTF1.icorr
' If PTF1.corchan(i, j) = icvh Then
  nCorCells = nCorCells + 1
  ii = (j - 1) * PTF1.icorz + i
  If TwoColumns Then
   construct(nCorCells, 0) = PTF1.info(ii - 1, 0)
   construct(nCorCells, 1) = PTF1.info(ii - 1, 1)
  Else
   construct2(nCorCells) = PTF1.lvar(ii - 1)
  End If
' End If
Next j
nflpaths = nCorCells
End If
'COR-TSVC -----------------
If (PTF1.whVars = "COR-TSVC") Then
ind = Whichvariables.ListBox3.ListIndex
aa = Whichvariables.ListBox3.List(ind)
ipound = InStrRev(aa, "#")
icvh = CSng(Mid(aa, ipound + 1, Len(aa) - ipound))
aaa = 0
iimax = PTF1.icorz * PTF1.icorr
If PTF1.info(1, 1) = "" Then
 TwoColumns = False
 ReDim construct2(iimax)
Else
 TwoColumns = True
 ReDim construct(iimax, 0 To 1)
End If
nCorCells = -1
For i = 1 To PTF1.icorz
For j = 1 To PTF1.icorr
 If PTF1.corchan(i, j) = icvh Then
  nCorCells = nCorCells + 1
  ii = (j - 1) * PTF1.icorz + i
  If TwoColumns Then
   construct(nCorCells, 0) = PTF1.info(ii - 1, 0)
   construct(nCorCells, 1) = PTF1.info(ii - 1, 1)
  Else
   construct2(nCorCells) = PTF1.lvar(ii - 1)
  End If
 End If
Next j
Next i
nflpaths = nCorCells
End If
'flow paths list
If nflpaths >= 0 Then
   If Not TwoColumns Then
    ReDim Preserve construct2(nflpaths)
    Whichvariables.ListBox1.ColumnCount = 1
    Whichvariables.ListBox1.List() = construct2
    Whichvariables.ListBox1.Width = 105
   Else
    ReDim construct3(nflpaths, 1)
    For i = 0 To nflpaths
      construct3(i, 0) = construct(i, 0)
      construct3(i, 1) = construct(i, 1)
    Next i
    Whichvariables.ListBox1.ColumnCount = 2
    Whichvariables.ListBox1.Width = maxi(105, mini(4.5 * (PTF1.longest1 + 5 + PTF1.longest2), 195))
    xFont = Whichvariables.ListBox1.Font.Size
    Whichvariables.ListBox1.ColumnWidths = CStr(5 * (PTF1.longest1 + 1)) & ";" & CStr(5 * (PTF1.longest2 + 1))
    Whichvariables.ListBox1.List() = construct3
   End If
Else
  Whichvariables.ListBox1.Clear
 aaa = 0
End If
End Sub

Private Sub SheetNames_Click()
 Dim varnamelocal()
 isht = Choosepackage.SheetSelection.ListIndex
 shtname = Choosepackage.SheetSelection.List(isht)
  If imode = 0 Then nindex = 0
   inumber = 0
    For j = 5 To 256
     usertext = Sheets(shtname).Cells(1, j)
If (Not IsEmpty(usertext)) Then
   For i = 1 To UBound(vnam)
    pvar = vnam(i)
    If InStr(1, pvar, usertext) = 1 Then
    inumber = inumber + 1
    ReDim Preserve lvar(inumber)
    ReDim Preserve txtlineLocal(inumber)
    ReDim Preserve varnamelocal(inumber)
    ReDim Preserve info1(inumber)
    longest1 = 0
    longest2 = 0
     longest1 = maxi(longest1, Len(pvar))
     info1(inumber - 1) = pvar
     varnamelocal(inumber - 1) = pvar
     txtlineLocal(inumber - 1) = ""
     lvar(inumber - 1) = pvar
    End If
   Next i
   End If
    Next j
   If inumber = 0 Then GoTo done
   ReDim info(inumber, 1)
   For i = 1 To inumber
     info(i - 1, 0) = info1(i - 1)
     info(i - 1, 1) = ""
   Next i
    Whichvariables.CheckBox1 = True
    If Whichvariables.CheckBox1 Then
     Whichvariables.ListBox1.MultiSelect = fmMultiSelectExtended
     Whichvariables.ListBox2.MultiSelect = fmMultiSelectExtended
     Whichvariables.Label2.Caption = "No description available for multiselect"
    Else
     Whichvariables.ListBox1.MultiSelect = fmMultiSelectSingle
     Whichvariables.ListBox2.MultiSelect = fmMultiSelectSingle
     Whichvariables.Label2.Caption = "Select variable for description"
    End If
done:
End Sub

Private Sub TextSearchInput_Change()
  Dim utext()
  usertext = UCase(Whichvariables.TextSearchInput.Text)
  iLast = Len(usertext)
  If iLast > 0 Then
  clast = Mid(usertext, iLast, 1)
  Else
  clast = ""
  End If
  bang = False
  If clast = "!" Then
   usertext = Mid(usertext, 1, iLast - 1)
   bang = True
  End If
  iseg = 0
  Istart1 = 1
  Do Until Istart1 > Len(usertext)
  i = InStr(Istart1, usertext, "*")
  iseg = iseg + 1
  If i = 0 Then
   ilen = Len(usertext) - Istart1 + 1
   i = Len(usertext) + 1
  Else
   ilen = i - Istart1
  End If
  ReDim Preserve utext(iseg + 1)
  utext(iseg) = Mid(usertext, Istart1, ilen)

  Istart1 = i + 1
  Loop
  If imode = 0 Then nindex = 0
   inumber = 0
   For i = 1 To UBound(vnam)
    foundmatch = True
    pvar = UCase(vnam(i))
    Istart1 = 1
    For k = 1 To iseg
     ifound = InStr(Istart1, pvar, utext(k))
     If ifound > 0 Then
      Istart1 = ifound + Len(utext(k))
     Else
      foundmatch = False
     End If
    Next k
  If iseg > 0 Then
   pos = InStrRev(pvar, utext(iseg))
  End If
  If bang And foundmatch Then
    If (Len(pvar) - pos + 1 = Len(utext(iseg))) Then
    aaa = 0
    Else
     foundmatch = False
    End If
  End If
'    foundMatch = InStr(1, pvar, userText) = 1
    If foundmatch Then
    ReDim Preserve lvar(inumber)
    ReDim Preserve info1(inumber)
     inumber = inumber + 1
    longest1 = 0
    longest2 = 0
     longest1 = maxi(longest1, Len(pvar))
     info1(inumber - 1) = pvar
     lvar(inumber - 1) = pvar
    End If
   Next i
   If inumber = 0 Then
    ReDim info(1, 1)
    Whichvariables.ListBox1.ColumnCount = 2
    Whichvariables.ListBox2.ColumnCount = 2
    Whichvariables.ListBox1.Width = maxi(105, mini(4.5 * (longest1 + 5 + longest2), 195))
    xFont = Whichvariables.ListBox1.Font.Size
    Whichvariables.ListBox1.ColumnWidths = CStr(5 * (longest1 + 1)) & ";" & CStr(5 * (longest2 + 1))
    Whichvariables.ListBox1.List() = info 'lvar()
    GoTo done
   End If
   ReDim info(inumber, 1)
   For i = 1 To inumber
     info(i - 1, 0) = info1(i - 1)
     info(i - 1, 1) = ""
   Next i
   If info(1, 1) = "" Then
    Whichvariables.ListBox1.ColumnCount = 1
    Whichvariables.ListBox2.ColumnCount = 1
    Whichvariables.ListBox1.List() = lvar()
    Whichvariables.ListBox1.Width = 105
   Else
    Whichvariables.ListBox1.ColumnCount = 2
    Whichvariables.ListBox2.ColumnCount = 2
    Whichvariables.ListBox1.Width = maxi(105, mini(4.5 * (longest1 + 5 + longest2), 195))
    xFont = Whichvariables.ListBox1.Font.Size
    Whichvariables.ListBox1.ColumnWidths = CStr(5 * (longest1 + 1)) & ";" & CStr(5 * (longest2 + 1))
    Whichvariables.ListBox1.List() = info 'lvar()
   End If
done:
End Sub

Private Sub UserForm_Terminate()
MsgBox ("Dialogue Window Closed, PTFREAD Is Closing...")
End Sub

Attribute VB_Name = "choosering"
Attribute VB_Base = "0{72A20B30-14BA-4383-BA93-9340A71E09BD}{7F73C5AA-F3D7-44DF-AF45-E3A522F21546}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False








Private Sub CommandButton1_Click()
choosering.Hide
End Sub

Attribute VB_Name = "Choosepackage"
Attribute VB_Base = "0{A7D0384E-E5B3-4EBE-BF5B-E75F06F5D362}{FC612009-90D0-446C-ADDB-F54F9016E0C4}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False



Private Sub UserForm_Terminate()
If Choosepackage.OptionButton1 = True Or _
   Choosepackage.OptionButton2 = True Or _
   Choosepackage.OptionButton3 = True Then 'avoid msgbox when PTFREAD is not used
' Without these three conditions, msgbox shows up when open Excel and close right away
 MsgBox ("You Closed Dialogue Window, PTFREAD Is Closing")
 End 'end the program
End If
 
End Sub





Private Sub CommandButton1_Click()
  PTF1.buttonresults = 1
  PTF1.iPackage = Choosepackage.ListBox1.ListIndex
  Choosepackage.Hide
End Sub

Private Sub CommandButton2_Click()
  PTF1.buttonresults = 2
  Choosepackage.Hide
End Sub

Private Sub ListBox2_Click()

End Sub

Private Sub Image1_Click()

End Sub

Private Sub OptionButton1_Click()

 'Choosepackage.CheckBox1.Visible = False
 'Choosepackage.CheckBox1.Visible = True is added in sub fulluse(chk)
 fulluse (chk)
 Choosepackage.Label1.Visible = True
 Choosepackage.Label2.Visible = True
 Choosepackage.Frame1.Visible = True
 Choosepackage.ListBox1.Visible = True
 Choosepackage.ManualInput.Visible = False
 Choosepackage.ManualInputLabel.Visible = False
 Choosepackage.Units.Visible = False
 Choosepackage.unitslabel.Visible = False
 Choosepackage.SheetSelection.Visible = False
End Sub

Private Sub OptionButton2_Click()
 Choosepackage.CheckBox1.Visible = False
 Choosepackage.Label1.Visible = False
 Choosepackage.Label2.Visible = False
 Choosepackage.Frame1.Visible = False
 Choosepackage.ListBox1.Visible = False
 Choosepackage.ManualInput.Visible = False
 Choosepackage.ManualInputLabel.Visible = True
 Choosepackage.ManualInputLabel.Caption = "Select WorkSheet:"
 Choosepackage.SheetSelection.Visible = True
 nsh = Worksheets.Count
 ReDim xsheets(nsh - 1)
 ReDim xsheets2(nsh - 1)
 icsh = 0
 For Each xSheet In Worksheets
  isum = 0
  icsh = icsh + 1
  xsheets(icsh - 1) = xSheet.Name
nxtsht:
 Next xSheet
 For i = 1 To icsh
   xsheets2(i - 1) = "zzz"
  For j = 1 To icsh
   If i = 1 Then
    If xsheets(j - 1) < xsheets2(0) Then xsheets2(0) = xsheets(j - 1)
   Else
    If xsheets(j - 1) < xsheets2(i - 1) And xsheets(j - 1) > xsheets2(i - 2) Then xsheets2(i - 1) = xsheets(j - 1)
   End If
  Next j
 Next i
 Choosepackage.SheetSelection.MultiSelect = fmMultiSelectSingle
 Choosepackage.SheetSelection.List() = xsheets2
 Choosepackage.SheetSelection.SetFocus
 Whichvariables.SheetNames.Visible = True 'turns visible to avoid SetFocus error
 Whichvariables.SheetNames.MultiSelect = fmMultiSelectSingle
 Whichvariables.SheetNames.List() = xsheets2
 Whichvariables.SheetNames.SetFocus

End Sub

Private Sub OptionButton3_Click()
 Choosepackage.CheckBox1.Visible = False
 Choosepackage.Label1.Visible = False
 Choosepackage.Label2.Visible = False
 Choosepackage.Frame1.Visible = False
 Choosepackage.ListBox1.Visible = False
 Choosepackage.ManualInput.Visible = True
 Choosepackage.ManualInputLabel.Visible = True
 Choosepackage.ManualInputLabel.Caption = "Input Plot Key Text:"
 Choosepackage.SheetSelection.Visible = False
 Choosepackage.Units.Visible = True
 Choosepackage.unitslabel.Visible = True
 If Choosepackage.ListBox1.ListIndex >= 0 Then
 txt = Choosepackage.ListBox1.List(Choosepackage.ListBox1.ListIndex)
 If InStr(3, txt, "-") > 0 Then
  txt = Mid(txt, 1, 2)
 End If
 Choosepackage.ManualInput.Value = txt
 End If
 Choosepackage.Units.List() = Array("time [sec]", "time [min]", "time [hr]", "cycle")
 Choosepackage.Units.ListIndex = 0
End Sub

Private Sub TestButton_Click()
  fname = "e:\undefinedvars.txt"
  Open fname For Output As #8
  For i = 1 To UBound(PTF1.keywd)
    aaa = PTF1.keywd(i)
    Call plotdef(aaa, vgen, buffer)
    If buffer = "Could not find definition" Then
     Print #8, aaa
    End If
  Next i
  Close #8
  PTF1.buttonresults = 2
  Choosepackage.Hide
End Sub

Private Sub UserForm_Click()
  fulluse (chk)
  PTF1.buttonresults = 3
  PTF1.iPackage = Choosepackage.ListBox1.ListIndex
  Choosepackage.Hide
End Sub
Private Sub ListBox1_Click()
i = Choosepackage.ListBox1.ListIndex
If i = -1 Then
Else
 Choosepackage.Label2 = mdesc(i)
End If
End Sub

Attribute VB_Name = "choosecalc"
Attribute VB_Base = "0{7AEA3AED-FE90-45AC-9F2A-946318CA8C0E}{F3058170-7419-4B8A-AE3F-B9716A00FB4B}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False









Private Sub CommandButton1_Click()
 choosecalc.Hide
End Sub

Private Sub CommandButton2_Click()
PTF1.ibutton2 = 1
 choosecalc.Hide
End Sub


Attribute VB_Name = "choosesheets"
Attribute VB_Base = "0{0CB13F30-837A-4B46-B5FC-EC2E99A5B0D2}{03A69BAC-50A5-40CF-AFFF-1AAAFFC4E062}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False









Private Sub CheckBox1_Click()
Dim xsheets()
If choosesheets.CheckBox2 Then
 iisel = 1
Else
 iisel = 0
End If
If choosesheets.CheckBox1 Then
 Call avsheets(xsheets, icsh, 1, iisel)
Else
 Call avsheets(xsheets, icsh, 0, iisel)
End If
If choosesheets.ListBox1.List(0) = "Add New Sheet" Then
n = icsh 'UBound(xsheets)
ReDim xsheets2(n + 1)
xsheets2(0) = "Add New Sheet"
For i = 1 To n
xsheets2(i) = xsheets(i - 1)
Next i
choosesheets.ListBox1.List() = xsheets2
Else
choosesheets.ListBox1.List() = xsheets
End If
End Sub

Private Sub CheckBox2_Click()
Dim xsheets()
If choosesheets.CheckBox2 Then
 iisel = 1
Else
 iisel = 0
End If
If choosesheets.CheckBox1 Then
 Call avsheets(xsheets, icsh, 1, iisel)
Else
 Call avsheets(xsheets, icsh, 0, iisel)
End If
If choosesheets.ListBox1.List(0) = "Add New Sheet" Then
n = icsh 'UBound(xsheets)
ReDim xsheets2(n)
xsheets2(0) = "Add New Sheet"
For i = 1 To n
xsheets2(i) = xsheets(i - 1)
Next i
choosesheets.ListBox1.List() = xsheets2
Else
choosesheets.ListBox1.List() = xsheets
End If
End Sub

Private Sub CommandButton1_Click()
 ii = choosesheets.ListBox1.ListIndex
 If ii < 0 Then
    MsgBox ("Select a Sheet to continue")
    GoTo subend
 End If
'################################################################
'double check if any sheet is selected
'When updating sheets, scrolling down the list changes .ListIndex
'the first check above does not work
 icsh = choosesheets.ListBox1.ListCount
 isel = 0
 For i = 0 To icsh - 1
  If choosesheets.ListBox1.Selected(i) Then isel = isel + 1
 Next i
  If isel = 0 Then
   MsgBox ("Select a Sheet to continue")
    GoTo subend
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 4399104 bytes
SHA-256: 0e5b61d0e0a97446e4015dc72198bd0f574c96ac09fd9b8f99e33cb170f7f9db
emf_00.emf ooxml-emf OOXML EMF part: xl/media/image7.emf 2724 bytes
SHA-256: a92e934c5d28c1be0e8e18637af985ea90cadbafa737596b9c5d5e766c0a2503
emf_01.emf ooxml-emf OOXML EMF part: xl/media/image8.emf 2408 bytes
SHA-256: ffd22219fa98a53e4bb572cd24ea1ea31a66d16a3a8639accbd095229c7d8990
emf_02.emf ooxml-emf OOXML EMF part: xl/media/image9.emf 2408 bytes
SHA-256: ee0a8a92cb4cafb1cb4403727186b3f91acc92f1619c76baca6ae1d984a2231e
emf_03.emf ooxml-emf OOXML EMF part: xl/media/image10.emf 2408 bytes
SHA-256: 3df1d8e110678df6bcade8c706dd72fee2b29da24fbe0541dd70bb6f809fdefb
emf_04.emf ooxml-emf OOXML EMF part: xl/media/image11.emf 2408 bytes
SHA-256: 7646996c2aaccd86306ac3827f542453a1545bf5101dc4fcf22883fcb46d70c6

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