Hallo zusammen,

ich möchte gerne Werte von Messgebern einlesen. Ich kann nun einen Befehl senden und laut Wireshark kommen auch Werte zurück. Jedoch sind die Bytes, welche ich einlese leer bzw. 0. Kann mir hier jemand helfen?

Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

#If VBA7 Then
Declare PtrSafe Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequested As Integer, ByRef lpWSAData As wsaData) As Long
Declare PtrSafe Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal socktype As Long, ByVal protocol As Long) As Long
Declare PtrSafe Function connect Lib "ws2_32.dll" (ByVal s As Long, ByRef name As SOCKADDR, ByVal namelen As Long) As Long
Declare PtrSafe Function send Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal len1 As Long, ByVal flags As Long) As Long
Declare PtrSafe Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
Declare PtrSafe Function WSACleanup Lib "ws2_32.dll" () As Long
#Else
Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequested As Integer, ByRef lpWSAData As wsaData) As Long
Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal socktype As Long, ByVal protocol As Long) As Long
Declare Function connect Lib "ws2_32.dll" (ByVal s As Long, ByRef name As SOCKADDR, ByVal namelen As Long) As Long
Declare Function send Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal len1 As Long, ByVal flags As Long) As Long
Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
Declare Function WSACleanup Lib "ws2_32.dll" () As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function inet_addr_impl Lib "ws2_32.dll" (ByVal ipAddress As String) As Long
Public Declare Function inet_addr Lib "ws2_32" (ByVal s As String) As Long
#Else
Private Declare Function inet_addr_impl Lib "ws2_32.dll" (ByVal ipAddress As String) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function recv Lib "ws2_32.dll" (ByVal s As LongPtr, ByVal buf As String, ByVal len2 As Long, ByVal flags As Long) As Long
#Else
Private Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal len2 As Long, ByVal flags As Long) As Long
#End If

Type wsaData
wVersion As Integer
wHighVersion As Integer
szDescription(0 To 255) As Byte
szSystemStatus(0 To 128) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type

Type SOCKADDR
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero(0 To 7) As Byte
End Type

Sub TCPIPCommunication()
Dim wsaData As wsaData
Dim clientSocket As Long
Dim serverAddress As SOCKADDR
Dim result As Long
Dim commandString As String
commandString = ""
Dim commandBytes() As Byte
Dim BytesSent As Long
commandBytes = "M0" 'StrConv(commandString, vbUnicode)

'WinSock initialisieren
result = WSAStartup(2.2, wsaData)
If result > 0 Then
MsgBox "Error initializing Winsock!"
Exit Sub
End If

'Socket erstellen
clientSocket = socket(2, 1, 0) ' AF_INET, SOCK_STREAM, IPPROTO_TCP
If clientSocket = -1 Then
MsgBox "Error creating socket!"
WSACleanup
Exit Sub
Else
Debug.Print "socket created"
End If

serverAddress.sin_family = 2 ' AF_INET
serverAddress.sin_port = htons(81) ' Port number
serverAddress.sin_addr = inet_addr("4.2.0.1")

' Connect
result = connect(clientSocket, serverAddress, Len(serverAddress))
If result = 0 Then
Debug.Print "connected"
End If
If result = -1 Then
MsgBox "Error connecting to server!"
closesocket clientSocket
WSACleanup
Exit Sub
End If


BytesSent = send(clientSocket, commandBytes(0), UBound(commandBytes) + 1, 0)
If Not BytesSent = UBound(commandBytes) + 1 Then
MsgBox ("Fehler beim Senden")
Else
Debug.Print "bytes sent : " & BytesSent
End If


Sleep (20)

ReceiveData (clientSocket)

closesocket clientSocket
WSACleanup
End Sub
Sub ReceiveData(socketHandle As Long)
Dim bufferSize As Long
Dim buffer() As Byte
Dim bytesRead As Long
Dim receivedData As Long
Dim idx As Long
On Error GoTo ende
bufferSize = 11
ReDim buffer(bufferSize)
Do
Debug.Print "Wert socket : " & socketHandle
bytesRead = recv(socketHandle, buffer(0), UBound(buffer), 0)
Debug.Print "Anzahl gelesene Bytes : " & bytesRead
If bytesRead = -1 Then
Debug.Print "Fehler beim Empfangen : " & Err.LastDllError
ElseIf bytesRead > 0 Then
'receivedData = receivedData + BytesToHex(buffer)
'Debug.Print receivedData
receivedData = receivedData + BytesToString(buffer)
Debug.Print "tmpstr = " & receivedData
End If
Sleep (50)
Loop Until bytesRead = 11

ende:
closesocket socketHandle

End Sub




Function htons(value As Integer) As Integer
If htons = 0 Then
htons = (value And &HFF) * 256 + ((value And &HFF00) \ 256)
End If
End Function



Function BytesToString(bytes() As Byte) As String
Dim i As Long
Dim result As String
Debug.Print "BytesToString"
Dim k As Long
For k = LBound(bytes) To UBound(bytes)
Debug.Print "Byte" & k & ": " & bytes(k)
Sleep (30)
Next k
result =StrConv(bytes, vbFromUnicode)
For i = 1 To Len(result)
If AscW(Mid(result, i, 1)) > 127 Then
Mid(result, i, 1) = "?"


End If
Next i
BytesToString = result
End Function






Laut Wireshark kommen 11 Bytes zurueck.