My VBA code below appear not opening /starting the winisock and as result nothing is being sent to the IP/Socket. See if you trace where I’m missing a link.
The calling procedures from subs are stated below :
Code:
Dim lngStatus as integer
lngStatus = OpenSocket("192.168.1.197", 8888)
lngStatus = send(8888, strData, 12280, 0)
lngStatus = recvB(8888, chands, 12280, 0)
Functions being called above see below:
Code:
Option Compare Database
Option Explicit
Public Const COMMAND_ERROR = -1
Public Const RECV_ERROR = -1
Public Const NO_ERROR = 0
Public socketId As Long
Public Const ScpiPort = 8888
'Global Variables for WINSOCK
Global State As Integer
Sub CloseConnection()
Dim x As Long
' we close our connection here
x = CloseSocket(socketId)
If x = SOCKET_ERROR Then
MsgBox ("ERROR: closesocket = " + Str$(x))
Exit Sub
End If
End Sub
Sub EndIt()
Dim x As Long
'Shutdown Winsock DLL
x = WSACleanup()
End Sub
Function OpenSocket(ByVal Hostname As String, ByVal PortNumber As Integer) As Integer
Dim I_SocketAddress As SOCKADDR_IN
Dim ipAddress As Long
Dim x As Long
ipAddress = inet_addr(Hostname)
'Create a new socket
socketId = socket(AF_INET, SOCK_STREAM, 0)
If socketId = SOCKET_ERROR Then
MsgBox ("ERROR: socket = " + Str$(socketId))
OpenSocket = COMMAND_ERROR
Exit Function
End If
'Open a connection to a server
I_SocketAddress.sin_family = AF_INET
I_SocketAddress.sin_port = htons(PortNumber)
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))
OpenSocket = COMMAND_ERROR
Exit Function
End If
OpenSocket = socketId
End Function
Function SendCommand(ByVal command As String) As Integer
' our communication command...
Dim strSend As String
Dim count As Long
strSend = command + vbCrLf
count = send(socketId, ByVal strSend, Len(strSend), 0)
If count = SOCKET_ERROR Then
MsgBox ("ERROR: send = " + Str$(count))
SendCommand = COMMAND_ERROR
Exit Function
End If
SendCommand = NO_ERROR
End Function
Function RecvAscii(dataBuf As String, ByVal maxLength As Integer) As Integer
Dim c As String * 1
Dim length As Integer
Dim count As Long
dataBuf = ""
While length < maxLength
DoEvents
count = recv(socketId, c, 1, 0)
If count < 1 Then
RecvAscii = RECV_ERROR
dataBuf = Chr$(0)
Exit Function
End If
If c = Chr$(10) Then
dataBuf = dataBuf + Chr$(0)
RecvAscii = NO_ERROR
Exit Function
End If
length = length + count
dataBuf = dataBuf + c
Wend
RecvAscii = RECV_ERROR
End Function
Function initWinsock() As Boolean ' {
Dim wsaVersion As Long
wsaVersion = 512
Dim rc As Long
Dim wsa As WSADATA
rc = WSAStartup(wsaVersion, wsa)
If rc <> 0 Then
initWinsock = False
Exit Function
End If
initWinsock = True
End Function '
}
Main bas Module
Code:
Option Compare Database
Option Explicit
'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" Alias "closesocket" (ByVal s As Long) As Long
Public Declare PtrSafe Function connect Lib "wsock32.dll" (ByVal s 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, 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" (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 Declare PtrSafe Function setsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Long, ByVal optlen As Long) As Long
Global Const SO_RCVTIMEO = &H1006
Global Const SOL_SOCKET = &HFFFF&
Re: Challenges Working with winsock and Ms Access VBA
we can only assume you are using a 64bit version of office?
and that your variables strdata and chands have values assigned to them prior to using?
the small test i tried appeared to open a socket, but not enough information for anything further
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Re: Challenges Working with winsock and Ms Access VBA
we can only assume you are using a 64bit version of office?
and that your variables strdata and chands have values assigned to them prior to using?
Strdata = data being sent to the gadget is correct
Chands = expected data to be received from the gadget
64bit version of office = Yes I'm using the 64 BIT Ms Access
Re: Challenges Working with winsock and Ms Access VBA
[QUOTE=nectorch;5531117]we can only assume you are using a 64bit version of office?
and that your variables strdata and chands have values assigned to them prior to using?
Strdata = data being sent to the gadget is correct
Chands = expected data to be received from the gadget
64bit version of office = Yes I'm using the 64 BIT Ms Access
Okay see the manual attached may it will help to interprete
Re: Challenges Working with winsock and Ms Access VBA
Edit: i was sending an example that may help but its VB.ET (i didnt check), im not sure if you can use this, but the code should be almost the same for VBA. My intent was to show a sample to see the basic principles and maybe you could see what is the problem on your side.
Yes!!!
Working from home is so much better than working in an office...
Nothing can beat the combined stress of getting your work done on time whilst
1. one toddler keeps pressing your AVR's power button
2. one baby keeps crying for milk
3. one child keeps running in and out of the house screaming and shouting
4. one wife keeps nagging you to stop playing on the pc and do some real work.. house chores
5. working at 1 O'clock in the morning because nobody is awake at that time
6. being grossly underpaid for all your hard work
Re: Challenges Working with winsock and Ms Access VBA
Thank you so much GBeat, but I'm not able to open the solution because I have only Ms Access 2016. I will appreciate if you can help to interpret the code below. I think it will help to sort out the issue at hand:
Socket creation
Code:
Public Declare PtrSafe Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal socktype As Long, ByVal protocol As Long) As Long
Calling in the on click Sub??
Code:
Dim sockid as long
sockid = socket(family, type, protocol);
Questions
(1) What do I put in the following parameters (family,type and protocal )??????
Assign address to socket: bind
Code:
Public Declare PtrSafe Function bind Lib "ws2_32.dll" (ByVal hSocket As Long, ByRef Name As sockaddr, ByVal NameLen As Long) As Long
Calling in the on click Sub??
Code:
Dim Status as long
status = bind(sockid, &addrport, size);
Questions
(1) What do I put in the following parameters (sockid, &addrport, size)
Assign address to socket: Listen
Code:
Public Declare PtrSafe Function listen% Lib "wsock32.dll" (ByVal s As Long, ByVal backlog%)
Code:
Dim Status as long
status = listen(sockid, queueLimit)
(1) What do I put in the following parameters listen(sockid, queueLimit)??
Assign address to socket: Accept
Code:
Dim S as long
S = accept(sockid, &clientAddr, &addrLen)
Public Declare PtrSafe Function acceptIn& Lib "wsock32.dll" Alias "#1" (ByVal s&, ByRef Addr As SOCKADDR_IN, ByRef namelen%)
(1) What do I put in the following parameters accept(sockid, &clientAddr, &addrLen)??
Assign address to socket: Connect
Code:
Public Declare PtrSafe Function connect Lib "wsock32.dll" (ByVal s As Long, Addr As SOCKADDR_IN, ByVal namelen As Long) As Long
Dim Status as long
status = connect(sockid, &foreignAddr, addrlen)
(1) What do I put in the following parameters connect(sockid, &foreignAddr, addrlen)??
Assign address to socket: Send
Code:
Public Declare PtrSafe Function send Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Dim count as long
count = send(sockid, msg, msgLen, flags)
(1) What do I put in the following parameters send(sockid, msg, msgLen, flags)??
Assign address to socket: Receive
Code:
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
Code:
Dim count as long
count = recv(sockid, recvBuf, bufLen, flags)
(
1) What do I put in the following parameters recv(sockid, recvBuf, bufLen, flags)??
Assign address to socket: Close &n Cleanup
Code:
Public Declare PtrSafe Function CloseSocket Lib "wsock32.dll" Alias "closesocket" (ByVal s As Long) As Long
Public Declare PtrSafe Function WSACleanup Lib "wsock32.dll" () As Long
Are the codes below okay for closing and cleaning up???????
Code:
Function CloseConnection()
Dim x As Long
' we close our connection here
x = CloseSocket(socketId)
If x = SOCKET_ERROR Then
MsgBox ("ERROR: closesocket = " + Str$(x))
Exit Sub
End If
End Function
Function EndIt()
Dim x As Long
'Shutdown Winsock DLL
x = WSACleanup()
End Function
The above structure was derived from the VBA code below, just in case you may want some references.