Sending data & receiving data from another computer via TCP/IP protocal (1 Viewer)

nectorch

New member
Local time
Today, 02:02
Joined
Aug 4, 2021
Messages
28
First to start with I'm currently using the COM serial port to send and receive data from a serial gadget which is working fine , no issues at all, but it cannot be used by multiple users or current users unless it was possible to share it over the network. The alternative to that is to use TCP/IP protocol with the VBA code below, the issue here I'm not familiar how call the following from the said module and reproduced nelow:

(1) Initialize from the invoice form class module
(2) Open connection the invoice form class module
(3) Send data the invoice form class module
(4) Receive data the invoice form class module
(5) Close connection the invoice form class module

See the Module below
Code:
Option Compare Database

Option Explicit

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
 
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


'typedef UINT_PTR        SOCKET;
Type socket
   pointer As Long
End Type



' typedef struct WSAData {
'  WORD           wVersion;
'  WORD           wHighVersion;
'  char           szDescription[WSADESCRIPTION_LEN+1];
'  char           szSystemStatus[WSASYS_STATUS_LEN+1];
'  unsigned short iMaxSockets;
'  unsigned short iMaxUdpDg;
'  char FAR       *lpVendorInfo;
'} WSADATA, *LPWSADATA;

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

'int errorno = WSAGetLastError()
Public Declare PtrSafe Function WSAGetLastError Lib "Ws2_32.dll" _
   () As Integer
  
'   int WSAStartup(
'  __in   WORD wVersionRequested,
'  __out  LPWSADATA lpWSAData
');
Public Declare PtrSafe Function WSAStartup Lib "Ws2_32.dll" _
    (ByVal wVersionRequested As Integer, ByRef lpWSAData As LPWSADATA_Type) As Long



'int sendto(
'  __in  SOCKET s,
'  __in  const char *buf,
'  __in  int len,
'  __in  int flags,
'  __in  const struct sockaddr *to,
'  __in  int tolen
');
Public Declare PtrSafe 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


'    SOCKET WSAAPI socket(
'  __in  int af,
'  __in  int type,
'  __in  int protocol
');

Public Declare PtrSafe Function f_socket Lib "Ws2_32.dll" Alias "socket" _
    (ByVal AF As Long, ByVal stype As Long, ByVal Protocol As Long) As Long

Public Declare PtrSafe Function closesocket Lib "Ws2_32.dll" _
    (ByVal socket As Long) As Long
    
Public Declare PtrSafe Sub WSACleanup Lib "Ws2_32.dll" ()
Public Function main()
Dim ConnectSocket As socket

Dim wsaData As LPWSADATA_Type
Dim SendSocket As Long
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_DGRAM
  
Dim Errno As Integer
Dim iProtocol As Integer
   iProtocol = IPPROTO_UDP
  
Dim SendBuf(0 To 12800) As Byte
Dim BufLen As Integer
   BufLen = 12800
  
Dim RecvAddr As sockaddr_in
RecvAddr.sin_family = AF_INET
RecvAddr.sin_port = 8888
RecvAddr.sin_addr(0) = 192
RecvAddr.sin_addr(1) = 168
RecvAddr.sin_addr(2) = 1
RecvAddr.sin_addr(3) = 197


SendBuf(0) = 65
SendBuf(1) = 66
SendBuf(2) = 67
SendBuf(3) = 0

  

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


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

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


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

End Function
 

LarryE

Member
Local time
Yesterday, 16:02
Joined
Aug 18, 2021
Messages
37
Assuming the VBA code is entered into a standard module you would call the Public Function main() from any other VBA module by using the syntax:
Call main
 

nectorch

New member
Local time
Today, 02:02
Joined
Aug 4, 2021
Messages
28
Hello there!

The above code I have finally abandoned, it does not work at all, after replacing with a new code completely I'm now able to see quality data being sent by using this VBA CODE below :


Code:
strData = BuildData(JsonConverter.ConvertToJson(transaction, Whitespace:=3))
  
lngStatus = Send(8888, strData, Len(strData), 0)


n = FreeFile()
Open "C:\Users\chris.hankwembo\Desktop\WinTesting\Test.txt" For Output As #n
Print #n, ShowHex(strData)
Close #n
MsgBox "strData:" & vbCrLf & ShowHex(strData)

Main VBA Code :


Code:
Option Compare Database

Option Explicit

Dim x As Long
Dim socketId As Long
Dim COMMAND_ERROR As Integer
Dim RECV_ERROR As Integer
Dim RecvAscii As Long
Dim OpenSocket As Long
Dim count As Long
Dim NO_ERROR As Integer
'This is the Winsock API definition file for Visual Basic


'Setup the variable type 'hostent' for the WSAStartup command
Type Hostent
h_name As Long
h_aliases As Long
h_addrtype As String * 2
h_length As String * 2
h_addr_list As Long
End Type
Public Const SZHOSTENT = 16

'Set the Internet address type to a long integer (32-bit)
Type in_addr
s_addr As Long
End Type

'A note to those familiar with the C header file for Winsock
'Visual Basic does not permit a user-defined variable type
'to be used as a return structure. In the case of the
'variable definition below, sin_addr must
'be declared as a long integer rather than the user-defined
'variable type of in_addr.
Type sockaddr_in
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero As String * 8
End Type


Public Const WSADESCRIPTION_LEN = 256
Public Const WSASYS_STATUS_LEN = 128
Public Const WSA_DescriptionSize = WSADESCRIPTION_LEN + 1
Public Const WSA_SysStatusSize = WSASYS_STATUS_LEN + 1

'Setup the structure for the information returned from
'the WSAStartup() function.
Type WSAData
wVersion As Integer
wHighVersion As Integer
szDescription As String * WSA_DescriptionSize
szSystemStatus As String * WSA_SysStatusSize
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As String * 200
End Type

'Define socket return codes
Public Const INVALID_SOCKET = &HFFFF
Public Const SOCKET_ERROR = -1

'Define socket types
Public Const SOCK_STREAM = 1 'Stream socket
Public Const SOCK_DGRAM = 2 'Datagram socket

Public Const SOCK_RAW = 3 'Raw data socket
Public Const SOCK_RDM = 4 'Reliable Delivery socket
Public Const SOCK_SEQPACKET = 5 'Sequenced Packet socket

'Define address families
Public Const AF_UNSPEC = 0 'unspecified
Public Const AF_UNIX = 1 'local to host (pipes, portals)
Public Const AF_INET = 2 'internetwork: UDP, TCP, etc.
Public Const AF_IMPLINK = 3 'arpanet imp addresses
Public Const AF_PUP = 4 'pup protocols: e.g. BSP
Public Const AF_CHAOS = 5 'mit CHAOS protocols
Public Const AF_NS = 6 'XEROX NS protocols
Public Const AF_ISO = 7 'ISO protocols
Public Const AF_OSI = AF_ISO 'OSI is ISO
Public Const AF_ECMA = 8 'european computer manufacturers
Public Const AF_DATAKIT = 9 'datakit protocols
Public Const AF_CCITT = 10 'CCITT protocols, X.25 etc
Public Const AF_SNA = 11 'IBM SNA
Public Const AF_DECnet = 12 'DECnet
Public Const AF_DLI = 13 'Direct data link interface
Public Const AF_LAT = 14 'LAT
Public Const AF_HYLINK = 15 'NSC Hyperchannel
Public Const AF_APPLETALK = 16 'AppleTalk
Public Const AF_NETBIOS = 17 'NetBios-style addresses
Public Const AF_MAX = 18 'Maximum # of address families

'Setup sockaddr data type to store Internet addresses
Type sockaddr
sa_family As Integer
sa_data As String * 14
End Type
Public Const SADDRLEN = 16

'Declare Socket functions

Public Declare PtrSafe Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Public Declare PtrSafe Function Connect Lib "wsock32.dll" Alias "connect" (ByVals As Long, addr As sockaddr_in, ByVal namelen As Long) As Long
Public Declare PtrSafe Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Public Declare PtrSafe Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Public Declare PtrSafe Function recv Lib "wsock32.dll" (ByVal s As Long, ByVal buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare PtrSafe Function recvB Lib "wsock32.dll" Alias "recv" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare PtrSafe Function Send Lib "wsock32.dll" Alias "send" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare PtrSafe Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal socktype As Long, ByVal protocol As Long) As Long
Public Declare PtrSafe Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired As Long, lpWSAData As WSAData) As Long
Public Declare PtrSafe Function WSACleanup Lib "wsock32.dll" () As Long
Public Declare PtrSafe Function WSAUnhookBlockingHook Lib "wsock32.dll" () As Long
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Function ConnectServer(ByVal Hostname As String, ByVal PortNumber As Integer) As Integer

Dim StartUpInfo As WSAData
'Version 1.1 (1*256 + 1) = 257
'version 2.0 (2*256 + 0) = 512
'Get WinSock version
'Initialize Winsock DLL
x = WSAStartup(257, StartUpInfo)

Dim I_SocketAddress As sockaddr_in
Dim ipAddress As Long
ipAddress = inet_addr(Hostname) '...........(1)
'Create a new socket
socketId = socket(AF_INET, SOCK_STREAM, 0) '
If socketId = SOCKET_ERROR Then '
MsgBox ("ERROR: socket = " + Str$(socketId)) '...........(2)
OpenSocket = COMMAND_ERROR '
GoTo end1
End If '
'Open a connection to a server
I_SocketAddress.sin_family = AF_INET '
I_SocketAddress.sin_port = htons(PortNumber) '...........(3)
I_SocketAddress.sin_addr = ipAddress '
I_SocketAddress.sin_zero = String$(8, 0) '
x = Connect(socketId, I_SocketAddress, Len(I_SocketAddress)) '
If socketId = SOCKET_ERROR Then '
        MsgBox ("ERROR: connect = " + Str$(x)) '..(4)
        OpenSocket = COMMAND_ERROR '
    Else
        OpenSocket = socketId
End If
end1:
End Function


Public Function RecData(dataBuf As String, ByVal maxLength As Integer) As Integer
Dim c As String * 1
Dim length As Integer
dataBuf = ""
While length < maxLength
DoEvents
count = recv(socketId, c, 1, 0) '
If count < 1 Then '
RecvAscii = RECV_ERROR '............(1)
dataBuf = Chr$(0) '
GoTo EndRec
End If '
If c = Chr$(10) Then '
dataBuf = dataBuf + Chr$(0) '............(2)
RecvAscii = NO_ERROR '
GoTo EndRec
End If '
length = length + count '............(3)
dataBuf = dataBuf + c '
Wend
RecvAscii = RECV_ERROR
EndRec:
End Function

Public Sub Disconnect()
x = closesocket(socketId)
If x = SOCKET_ERROR Then MsgBox ("ERROR: closesocket = " + Str$(x))

'Shutdown Winsock DLL
x = WSACleanup()
End Sub

Public Function Sendcommand(ByVal command As String) As Integer
Dim strSend As String
strSend = command + vbCrLf
count = Send(socketId, ByVal strSend, Len(strSend), 0)
If count = SOCKET_ERROR Then
        MsgBox ("ERROR: send = " + Str$(count))
        Sendcommand = COMMAND_ERROR
    Else
        Sendcommand = NO_ERROR
End If
End Function


Calling the module

Code:
Start the initializing  :  Call  lngStatus = ConnectServer("192.168.1.197", 8888)

Sending Data  : Call  lngStatus = Send(8888, strData, Len(strData), 0)

Receiving : Call lngStatus = recv(8888, strData, Len(strData), 0)

Closing :  Call Disconnect


The problem now here I'm not able to receive data its coming EMPTY where I'm going wrong ?

Regards
 

nectorch

New member
Local time
Today, 02:02
Joined
Aug 4, 2021
Messages
28
Pinging works.png


As you can see I'm able to ping that gadget from a remote computer, anyway I will keep on trying
 

Users who are viewing this thread

Top Bottom