asked on
Window defender blocking Winsock from communicating in Ms Access
After working with VBA code below to try and send data to the serial gadget, now the communication is being blocked by window defender. Could it the VBA code below I have made a mistake somewhere?
To start the winisock I 'm calling the function below:
To send and receive data I'm calling the function below:
To start the winisock I 'm calling the function below:
Call main
To send and receive data I'm calling the function below:
Call getStringFromSocket (strData)
Option Compare Database
Option Explicit
Sub main() ' {
If Not initWinsock Then
MsgBox "Could not initialize Winsock"
End If
Debug.Print "winsock initialized"
Dim serverSocket As Long
serverSocket = createServerSocket(8888)
acceptConnections serverSocket
closesocket serverSocket
WSACleanup
End Sub ' }
Function createServerSocket(ByVal port As Long) ' {
createServerSocket = socket(AF_INET, SOCK_STREAM, 0)
Dim endPoint As sockaddr_in
endPoint.sin_family = AF_INET
endPoint.sin_addr.s_addr = INADDR_ANY
endPoint.sin_port = htons(port)
' debug.print "lenB: " & lenB(endPoint)
Dim rc As Long
rc = bind(createServerSocket, endPoint, 16)
If rc <> 0 Then
MsgBox "Could not bind, error = " & WSAGetLastError()
Exit Function
End If
rc = listen(createServerSocket, 10) ' 10 = backlog
If rc <> 0 Then
MsgBox "Could not listen"
End If
End Function ' }
Sub acceptConnections(serverSocket As Long) ' {
Dim clientSocket As Long
Dim i As Long
i = 0
Do While i < 200
i = i + 1
Sleep 100
Debug.Print "i = " & i
clientSocket = getClientSocket(serverSocket)
If clientSocket = 0 Then
GoTo SKIP_THIS_ITERATION
End If
Dim reqText As String
reqText = getStringFromSocket(clientSocket)
Dim textResponse As String
textResponse = "HTTP/1.1 200 OK" & Chr(10)
textResponse = textResponse & "Content-Type: text/html" & Chr(10)
textResponse = textResponse & Chr(10)
textResponse = textResponse & "<!doctype html>" & Chr(10)
textResponse = textResponse & "<html><body>Request was:<br><code><pre>"
textResponse = textResponse & reqText
textResponse = textResponse & "</pre></code></body></html>"
send clientSocket, ByVal textResponse, Len(textResponse), 0
closesocket clientSocket
SKIP_THIS_ITERATION:
Loop
End Sub ' }
Function getClientSocket(serverSocket As Long) As Long ' {
Dim fdSet As fd_set
Dim emptyFdSet As fd_set
Dim rc As Integer
FD_ZERO fdSet
FD_SET_ serverSocket, fdSet
Dim timeOutMs As Long
timeOutMs = 500
Dim timeOut As timeval
timeOut.tv_sec = timeOutMs / 1000
timeOut.tv_usec = timeOutMs Mod 1000
rc = select_(serverSocket, fdSet, emptyFdSet, emptyFdSet, timeOut)
If rc = 0 Then
getClientSocket = 0
Exit Function
End If
Dim socketAddress As sockaddr
getClientSocket = accept(serverSocket, socketAddress, 16)
If getClientSocket = -1 Then
getClientSocket = 0
Exit Function
End If
rc = setsockopt(getClientSocket, SOL_SOCKET, SO_RCVTIMEO, timeOutMs, 4)
End Function ' }
Function getStringFromSocket(s As Long) ' {
Dim message As String
Dim buffer As String * 1024
Dim readBytes As Long
message = ""
Do
buffer = ""
readBytes = recv(s, buffer, Len(buffer), 0)
If readBytes > 0 Then
message = message & Trim(buffer)
End If
Loop While readBytes > 0
getStringFromSocket = Trim(message)
End Function ' }
Function initWinsock() As Boolean ' {
Dim wsaVersion As Long
wsaVersion = 257
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 ' }
* microsoft defenderMicrosoft AccessWindows XPNetworkingAnti-Virus Apps
Last Comment
Jonathan Kelly