Peter M. Groen / oletools

Commit 26f83bf45a3eced5d0c8f554bb84069d77f5f079

Authored by decalage2
1 parent bacfd4b6

added DocVarDump.vba

Inline Side-by-side
Showing 1 changed file with 117 additions and 0 deletions
oletools/DocVarDump.vba 0 → 100644
  View file @26f83bf
  1 +' DocVarDump.vba
  2 +'
  3 +' DocVarDump is a VBA macro that can be used to dump the content of all document
  4 +' variables stored in a MS Word document.
  5 +'
  6 +' USAGE:
  7 +' 1. Open the document to be analyzed in MS Word
  8 +' 2. Do NOT click on "Enable Content", to avoid running malicious macros
  9 +' 3. Save the document with a new name, using the DOCX format (not doc, not docm)
  10 +' This will remove all VBA macro code.
  11 +' 4. Close the file, and reopen the DOCX file you just saved
  12 +' 5. Press Alt+F11 to open the VBA Editor
  13 +' 6. Double-click on "This Document" under Project
  14 +' 7. Copy and Paste all the code from DocVarDump.vba
  15 +' 8. Move the cursor on the line "Sub DocVarDump()"
  16 +' 9. Press F5: This should run the code, and create a file "docvardump.txt"
  17 +' containing a hex dump of all document variables.
  18 +'
  19 +' ALTERNATIVE: Open the document in LibreOffice/OpenOffice,
  20 +' then go to File / Properties / Custom Properties
  21 +'
  22 +' Author: Philippe Lagadec - http://www.decalage.info
  23 +' License: BSD, see source code or documentation
  24 +'
  25 +' DocVarDump is part of the python-oletools package:
  26 +' http://www.decalage.info/python/oletools
  27 +
  28 +' CHANGELOG:
  29 +' 2016-09-21 v0.01 PL: - First working version
  30 +' 2017-04-10 v0.02 PL: - Added usage instructions
  31 +
  32 +Sub DocVarDump()
  33 + intFileNum = FreeFile
  34 + FName = Environ("TEMP") & "\docvardump.txt"
  35 + Open FName For Output As intFileNum
  36 + For Each myvar In ActiveDocument.Variables
  37 + Write #intFileNum, "Name = " & myvar.Name
  38 + 'TODO: check VarType, and only use hexdump for strings with non-printable chars
  39 + Write #intFileNum, "Value = " & HexDump(myvar.value)
  40 + Write #intFileNum,
  41 + Next myvar
  42 + Close intFileNum
  43 + Documents.Open (FName)
  44 +End Sub
  45 +
  46 +Function Hex2(value As Integer)
  47 + h = Hex(value)
  48 + If Len(h) < 2 Then
  49 + h = "0" & h
  50 + End If
  51 + Hex2 = h
  52 +End Function
  53 +
  54 +Function HexN(value As Integer, nchars As Integer)
  55 + h = Hex(value)
  56 + Do While Len(h) < nchars
  57 + h = "0" & h
  58 + Loop
  59 + HexN = h
  60 +End Function
  61 +
  62 +Function ReplaceClean1(sText As String)
  63 + Dim J As Integer
  64 + Dim vAddText
  65 +
  66 + vAddText = Array(Chr(129), Chr(141), Chr(143), Chr(144), Chr(157))
  67 + For J = 0 To 31
  68 + sText = Replace(sText, Chr(J), "\x" & Hex2(J))
  69 + Next
  70 + For J = 0 To UBound(vAddText)
  71 + c = vAddText(J)
  72 + a = Asc(c)
  73 + sText = Replace(sText, c, "\x" & Hex2(a))
  74 + Next
  75 + ReplaceClean1 = sText
  76 +End Function
  77 +
  78 +Function ReplaceClean3(sText As String)
  79 + Dim J As Integer
  80 + For J = 0 To 31
  81 + sText = Replace(sText, Chr(J), ".")
  82 + Next
  83 + For J = 127 To 255
  84 + sText = Replace(sText, Chr(J), ".")
  85 + Next
  86 + ReplaceClean3 = sText
  87 +End Function
  88 +
  89 +Function HexBytes(sText As String)
  90 + Dim i As Integer
  91 + HexBytes = ""
  92 + For i = 1 To Len(sText)
  93 + HexBytes = HexBytes & Hex2(Asc(Mid(sText, i))) & " "
  94 + Next
  95 +End Function
  96 +
  97 +
  98 +Function HexDump(sText As String)
  99 + Dim chunk As String
  100 + Dim i As Long
  101 + ' "\" is integer division, "/" is normal division (float)
  102 + nbytes = 8
  103 + nchunks = Len(sText) \ nbytes
  104 + lastchunk = Len(sText) Mod nbytes
  105 + HexDump = ""
  106 + For i = 0 To nchunks - 1
  107 + Offset = HexN(i * nbytes, 8)
  108 + chunk = Mid(sText, i * nbytes + 1, nbytes)
  109 + HexDump = HexDump & Offset & " " & HexBytes(chunk) & " " & ReplaceClean3(chunk) & vbCrLf
  110 + Next i
  111 + 'TODO: LAST CHUNK!
  112 + If lastchunk > 0 Then
  113 + Offset = HexN(nchunks * nbytes, 8)
  114 + chunk = Mid(sText, nchunks * nbytes + 1, lastchunk)
  115 + HexDump = HexDump & Offset & " " & HexBytes(chunk) & " " & ReplaceClean3(chunk) & vbCrLf
  116 + End If
  117 +End Function
... ...