Function tuto1() Dim lData As WSADATA Dim lsock As Long Dim lname As SOCKADDR Dim lRet As Long ' Initialisation de Winsock If WSAStartup(257, lData) = 0 Then ' Création d'une socket lsock = socket(AF_INET, SOCK_STREAM, 0) If lsock <> -1 Then lname.sin_family = AF_INET ' famille "classique" lname.sin_port(1) = 502 \ 256 ' première partie du port lname.sin_port(2) = 502 Mod 256 ' deuxième partie du port lname.sin_addr = addrfromhost("10.100.114.123") ' adresse du serveur ' Connexion lRet = Connect(lsock, lname, LenB(lname)) 'Vérification connexion OK If lRet = 0 Then ' Réception des données de connexion lStrToReceive = Space(1024) lRet = recvstr(lsock, lStrToReceive, Len(lStrToReceive), 0) If lRet > 0 Then lStrToReceive = Left(lStrToReceive, lRet) Debug.Print "Octets reçus : " & lRet & vbCrLf & lStrToReceive End If Else MsgBox "Le code d'erreur est :" & Err.LastDllError End If closesocket lsock End If WSACleanup End If End Function
lRet = Connect(lsock, lname, LenB(lname))
Function tuto1() Dim lData As WSADATA Dim lsock As Long Dim lname As SOCKADDR Dim lRet As Long ' Initialisation de Winsock If WSAStartup(257, lData) = 0 Then ' Création d'une socket lsock = socket(AF_INET, SOCK_STREAM, 0) If lsock <> -1 Then lname.sin_family = AF_INET ' famille "classique" lname.sin_port(1) = 502 \ 256 ' première partie du port lname.sin_port(2) = 502 Mod 256 ' deuxième partie du port lname.sin_addr = addrfromhost("10.100.114.123") ' adresse du serveur ' Connexion lRet = Connect(lsock, lname, LenB(lname)) 'Vérification connexion OK If lRet = 0 Then If lRet = 0 Then ' Envoi des données lStrToSend = "XXX.01.C652.XXX" & vbCrLf lRet = sendstr(lsock, lStrToSend, Len(lStrToSend), 0) Debug.Print "Octets envoyés : " & lRet & " / " & Len(lStrToSend) & vbCrLf & lStrToSend ' Réception des données lStrToReceive = Space(1024) lRet = recvstr(lsock, lStrToReceive, Len(lStrToReceive), 0) If lRet > 0 Then lStrToReceive = Left(lStrToReceive, lRet) Debug.Print "Octets reçus : " & lRet & vbCrLf & lStrToReceive End If Else Debug.Print "Erreur de connexion n° " & Err.LastDllError End If closesocket lsock End If WSACleanup End If End If End Function
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionEthernet TCP/IP - Protocole Modbus TCPLecture d'une suite de plusieurs registres (Code Fonction 3)
? Requête :
Octet 0 : Code Fonction = 03
Octets 1-2 : Numéro de référence cible (offset)
Octets 3-4 : Nombre de mots à lire (1-125)
? Réponse :
Octet 0 : Code Fonction = 03
Octet 1: Byte count de la réponse (B=2 x Nb de mots)
Octets 2 à(B+1):Valeurs des registres
? Réponse d'exception :
Octet 0 : Code Fonction = 83 (hexa)
Octet 1 : Code d'exception = 01 ou 02
'Envoi des données lStrToSend = Chr(2) + Chr(1) + Chr(3) + Chr(C6) + Chr(52) + Chr(0) + Chr(1) + vbCrLf lret = sendstr(lsock, lStrToSend, Len(lStrToSend), 0) Debug.Print "Octets envoyés : " & lret & " / " & Len(lStrToSend) & vbCrLf & lStrToSend ' Réception des données Sleep 200 lStrToReceive = Space(1024) lret = recvstr(lsock, lStrToReceive, Len(lStrToReceive), 0) If lret > 0 Then 'lStrToReceive = Left(lStrToReceive, lRet) Debug.Print "Octets reçus : " & lret & lStrToReceive End If
lStrTosend = Chr(&H1) + Chr(&H1) + Chr(&H3) + Chr(&HC6) + Chr(&H52) + Chr(&H0) + Chr(&H2) + Chr(&H59) + Chr(&H7)
Dim ltByte(0 to 8) as Byte ltByte(0)=&h1 ltByte(1)=&h1 ltByte(2)=&h3 ltByte(3)=&hC6 ltByte(4)=&h52 ltByte(5)=&h0 ltByte(6)=&h2 ltByte(7)=&h59 ltByte(8)=&h7
'Envoi des données Dim ltByte(0 To 8) As Byte ltByte(0) = &H1 ltByte(1) = &H1 ltByte(2) = &H3 ltByte(3) = &HC6 ltByte(4) = &H52 ltByte(5) = &H0 ltByte(6) = &H2 ltByte(7) = &H59 ltByte(8) = &H7 'lStrTosend = "0103C6520003" 'lStrTosend = "01" & "03" & "07" & "70" & "00" & "03" & "05" & "64" & vbCrLf lret = sendstr(lsock, ltByte, 9, 0)
Octets reçus : 9 / 9
a?R? € ===> 97 63 82 63 0 3 0 128 1
18 nov. 2014 à 16:54
voir ici :
http://arkham46.developpez.com/articles/office/officeweb/?page=page_8
Modifié par corentinte le 19/11/2014 à 11:18