sendto发送垃圾（VBA）

Question

我正在重复使用here中的代码进行一些更改 - 将私有关键字添加到某些定义中，因为Excel VBA报告错误并将类型更改为IPRAW / ICMP。

最后，我在数据包中的wireshark 中看到了垃圾，但数据大小正确（3个字节）。我检查sendBuf实际上是在执行sendTo时将第一个字节包含为三个'a'。有什么问题？

使用列表底部的CommandButton1_Click() sub发送数据。

这是代码

'reference
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms740673(v=vs.85).aspx
Const INVALID_SOCKET = -1
Const WSADESCRIPTION_LEN = 256

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

Enum Protocol
   IPPROTO_ICMP = 1
   IPPROTO_IGMP = 2
   BTHPROTO_RFCOMM = 3
   IPPROTO_TCP = 6
   IPPROTO_UDP = 17
   IPPROTO_ICMPV6 = 58
   IPPROTO_RM = 113
End Enum

'Type sockaddr
'   sa_family As Integer
'   sa_data(0 To 13) As Byte
'End Type

Private Type sockaddr_in
  sin_family As Integer
  sin_port As Integer
  sin_addr(0 To 3) As Byte
  sin_zero(0 To 7) As Byte
End Type

Private Type socket
   pointer As Long
End Type

Private Type LPWSADATA_Type
   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 Declare Function WSAGetLastError Lib "Ws2_32.dll" () As Integer
Private Declare Function WSAStartup Lib "Ws2_32.dll" (ByVal wVersionRequested As Integer, ByRef lpWSAData As LPWSADATA_Type) As Long
Private Declare Function sendto Lib "Ws2_32.dll" (ByVal socket As Long, ByRef buf() As Byte, ByVal length As Long, ByVal flags As Long, ByRef toaddr As sockaddr_in, tolen As Long) As Long
Private Declare Function f_socket Lib "Ws2_32.dll" Alias "socket" (ByVal AF As Long, ByVal stype As Long, ByVal Protocol As Long) As Long
Private Declare Function closesocket Lib "Ws2_32.dll" (ByVal socket As Long) As Long
Private Declare Sub WSACleanup Lib "Ws2_32.dll" ()

Sub SendPacket(Message As String, IP As String, Port As Integer)
   Dim ConnectSocket As socket
   Dim wsaData As LPWSADATA_Type
   Dim iResult As Integer: iResult = 0
   Dim send_sock As sock_type: send_sock = INVALID_SOCKET
   Dim iFamily As AF: iFamily = AF_INET
   Dim iType As Integer: iType = SOCK_RAW 'SOCK_UDP
   Dim iProtocol As Integer: iProtocol = IPPROTO_ICMP 'IPPROTO_UDP
   Dim SendBuf(0 To 1023) As Byte
   Dim BufLen As Integer: BufLen = 1024
   Dim RecvAddr As sockaddr_in: RecvAddr.sin_family = AF_INET: RecvAddr.sin_port = Port
   Dim SplitArray As Variant: SplitArray = Split(IP, ".")

   RecvAddr.sin_addr(0) = SplitArray(0)
   RecvAddr.sin_addr(1) = SplitArray(1)
   RecvAddr.sin_addr(2) = SplitArray(2)
   RecvAddr.sin_addr(3) = SplitArray(3)


   For buf = 1 To Len(Message)
      SendBuf(buf - 1) = Asc(Mid(Message, buf, 1))
   Next buf
   SendBuf(buf + 1) = 0

   iResult = WSAStartup(&H202, wsaData)
   If iResult <> 0 Then
      MsgBox ("WSAStartup failed: " & iResult)
      Exit Sub
   End If

   send_sock = f_socket(iFamily, iType, iProtocol)
   If send_sock = INVALID_SOCKET Then
      Errno = WSAGetLastError()
      Exit Sub
   End If

   iResult = sendto(send_sock, SendBuf, Len(Message), 0, RecvAddr, Len(RecvAddr)) ' BufLen, 0, RecvAddr, Len(RecvAddr))
   If iResult = -1 Then
      MsgBox ("sendto failed with error: " & WSAGetLastError())
      closesocket (send_sock)
      Call WSACleanup
      Exit Sub
   End If

   iResult = closesocket(send_sock)
   If iResult <> 0 Then
      MsgBox ("closesocket failed with error : " & WSAGetLastError())
      Call WSACleanup
   End If
End Sub


Private Sub CommandButton1_Click()
    Call SendPacket("aaa", "192.168.1.55", 1000)
End Sub

更新：根据Remy Lebeau的建议，我做了以下更改

Private Declare Function sendto Lib "Ws2_32.dll" (ByVal socket As Long, ByVal buf As LongPtr, ByVal length As Long, ByVal flags As Long, ByRef toaddr As sockaddr_in, tolen As Long) As Long

使用ByRef buf() As Byte，

更改ByVal buf As LongPtr

Private Declare PtrSafe Function VarPtrArray Lib "VBE7" Alias "VarPtr" (Var() As Any) As LongPtr
...
iResult = sendto(send_sock, VarPtrArray(SendBuf) + 12, Len(Message), 0, RecvAddr, Len(RecvAddr))

将SendBuf更改为VarPtrArray(SendBuf) + 12。

但我仍然得到垃圾。

更新2：成功：

加入

Private Declare PtrSafe Function VarPtrArray Lib "VBE7" Alias "VarPtr" (Var() As Any) As LongPtr

修饰

iResult = sendto(send_sock, VarPtr(SendBuf(0)), Len(Message), 0, RecvAddr, Len(RecvAddr))

Answer 1

您在buf的{​​{1}}参数中传递了错误的内存地址，因此它从错误的内存中检索字节。这就是为什么你看到＆＃34;垃圾＆＃34;在数据包有效载荷中。

您对sendto()的{​​{1}}参数使用ByRef buf() as Byte是完全错误的。 buf期望指针直接指向要发送的实际字节。但是你的sendto()变量是一个动态数组（它是包含指向实际字节的指针的COM SAFEARRAY的包装器）。通过使用sendto()按原样传递SendBuf，实际上是在传递SendBuf变量本身的ByRef内存地址，而不是字节数据的内存地址（位于其他位置）在内存中sendto()指的是。

来自VBA Internals: What’s in a variable：

  

VBA中的数组至少由3个指针构成。首先，在数组变量上调用SendBuf将获得变量内容的地址。如果您直接读取变量内容，您将获得另一个指针 - 指向SendBuf结构的开头。最后，如果您直接从VarPtrArray()的字节偏移12（SAFEARRAY字段）读取，您将获得指向数组元素数据开头的指针。

最后一个值（＆＃34;指向数组元素数据开头的指针＆＃34;）是您需要传递给pvData SAFEARRAY参数的内存地址。因此，将buf参数更改为LongPtr，然后使用sendto()和buf的组合从VarPtrArray()＆＃中提取指向字节数据的指针39; s内部CopyMemory()。

请参阅VBA Internals: Getting Pointers（根据您的Office版本提供SendBuf的相应声明）和VBA Internals: Array Variables and Pointers in Depth（其中显示如何使用SAFEARRAY获取来自数组变量的内部数据指针。）

例如：

VarPtrArray()

更新：显然，您根本不需要直接访问VarPtrArray()。 Public Declare PtrSafe Function VarPtrArray Lib "VBE7" Alias "VarPtr" (Var() As Any) As LongPtr ' Public Declare Function VarPtrArray Lib "VBE6" Alias "VarPtr" (Var() As Any) As Long ... Private Declare Function sendto Lib "Ws2_32.dll" (ByVal socket As Long, ByVal buf As LongPtr, ByVal length As Long, ByVal flags As Long, ByRef toaddr As sockaddr_in, tolen As Long) As Long ... Dim SendBuf(0 To 1023) As Byte Dim ptrToArrayVar As LongPtr Dim ptrToSafeArray As LongPtr Dim ptrToArrayData As LongPtr Dim uSAFEARRAY As SAFEARRAY_VECTOR ... ' Get pointer to array *variable* ptrToArrayVar = VarPtrArray(SendBuf) ' Get the pointer to the *SAFEARRAY* by directly ' reading the variable's address CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH ' Read the SAFEARRAY struct CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY) ' Get the pointer to the actual vector of bytes ptrToArrayData = uSAFEARRAY.pvData iResult = sendto(send_sock, ptrToArrayData, buf + 1, 0, RecvAddr, Len(RecvAddr)) 能够获取数组变量的特定元素的内存地址。因此，您可以使用以下代码来获取SAFEARRAY中第一个字节的内存地址（实际上与内部VarPtr()指向的内存地址相同）：

SendBuf

Answer 2

方法sendto获取缓冲区中数据开头的地址。

使用ByRef buffer As Any声明参数：

Private Declare PtrSafe Function sendto Lib "Ws2_32.dll" ( _
    ByVal socket As Long, _
    ByRef buffer As Any, _
    ByVal length As Long, _
    ByVal flags As Long, _
    ByRef toaddr As Any, _
    ByVal tolen As Long) As Long

并通过引用提供第一个元素：

Dim buffer() As Byte, size As Long

buffer = StrConv(Message, vbFromUnicode)  ' UTF-16 2 bytes to ANSI 1 byte
size = UBound(buffer) + 1

iResult = sendto(send_sock, buffer(0), size, 0, RecvAddr, Len(RecvAddr))