Winsock with VBA failing to connect
I need help on the code below, I'm able to start Winsock with VBA library below or initialize , but I'm failing to connect to my local machine with IP address 127.0.0.1 & Port number 49414, before going to the server I wanted it if it was working okay on my machine.
Code:
Option Compare Database
Option Explicit
'Receiving data in 64 & 32 BITRemember to thoroughly test any modifications, as networking code
'can be quite sensitive to changes. Additionally, because the code
'involves direct memory operations and system API calls, it's important
'to ensure that your Access project is running in a trusted environment
'to avoid security issues.
'Define address families
Public Const AF_INET = 2 'internetwork: UDP, TCP, etc.
'Define socket types
Public Const SOCK_STREAM = 1 'Stream socket
'Define return codes
Public Const GENERAL_ERROR As Long = vbObjectError + 100
Public Const INVALID_SOCKET = &HFFFF
Public Const SOCKET_ERROR = -1
Public Const NO_ERROR = 0
' Define structure for the information returned from the WSAStartup() function
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
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 structure for host
Public Type hostent
h_name As LongPtr
h_aliases As LongPtr
h_addrtype As Integer
h_length As Integer
h_addr_list As LongPtr
End Type
' Define structure for address
Public Type sockaddr
sin_family As Integer
sin_port As Integer
sin_addr As LongPtr
sin_zero As String * 8
End Type
'Declare Socket functions
#If Win64 Then
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 gethostbyname Lib "wsock32.dll" (ByVal name As String) As LongPtr
Public Declare PtrSafe Function inet_ntoa Lib "wsock32.dll" (ByVal inaddr As LongPtr) As LongPtr
Public Declare PtrSafe Function Socket Lib "wsock32.dll" Alias "socket" (ByVal af As Long, ByVal socktype As Long, ByVal protocol As Long) As Long
Public Declare PtrSafe Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Public Declare PtrSafe Function connect Lib "wsock32.dll" (ByVal s As LongPtr, name As sockaddr, ByVal namelen As Long) As Long
Public Declare PtrSafe Function closesocket Lib "wsock32.dll" (ByVal s As LongPtr) As Long
Public Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare PtrSafe Function Send Lib "ws2_32.dll" Alias "send" (ByVal s As Long, ByVal buf As String, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare PtrSafe Function Recv Lib "ws2_32.dll" Alias "recv" (ByVal s As Long, ByRef buf As String, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare PtrSafe Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Any) As Long
Public Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
#Else
Public Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired As Long, lpWSAData As WSAData) As Long
Public Declare Function WSACleanup Lib "wsock32.dll" () As Long
Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal name As String) As LongPtr
Public Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inaddr As LongPtr) As LongPtr
Public Declare Function Socket Lib "wsock32.dll" Alias "socket" (ByVal af As Long, ByVal socktype As Long, ByVal protocol As Long) As Long
Public Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Public Declare Function connect Lib "wsock32.dll" (ByVal s As LongPtr, name As sockaddr, ByVal namelen As Long) As Long
Public Declare Function closesocket Lib "wsock32.dll" (ByVal s As LongPtr) As Long
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function Send Lib "ws2_32.dll" Alias "send" (ByVal s As Long, ByVal buf As String, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function Recv Lib "ws2_32.dll" Alias "recv" (ByVal s As Long, ByRef buf As String, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Any) As Long
Public Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
#End If
Function GetDataFromServer(ByVal sHostName As String, ByVal iPortNumber As Integer) As Long
Dim lResult As Long ' General variable to be used when checking the status from winsock functions
' Initialise the winsock
Dim CurrentWinsockInfo As WSAData
lResult = WSAStartup(MAKEWORD(2, 2), CurrentWinsockInfo)
If lResult <> 0 Then
Err.Raise GENERAL_ERROR, "WinsockInitInterface", "Unable to initialize Winsock!"
End If
' Get information about the server to connect to.
Dim lHostInfoPointer As LongPtr ' pointer to info about the host computer
lHostInfoPointer = gethostbyname(sHostName & vbNullChar)
If lHostInfoPointer = 0 Then
Err.Raise GENERAL_ERROR, "WinsockOpenTheSocketHostName", "Unable to resolve host!"
End If
' Copy information about the server into the structure.
Dim hostinfo As hostent ' info about the host computer
CopyMemory hostinfo, ByVal lHostInfoPointer, LenB(hostinfo)
If hostinfo.h_addrtype <> AF_INET Then
Err.Raise GENERAL_ERROR, "WinsockOpenTheSocketHostName", "Couldn't get IP address of " & sHostName
End If
' Get the server's IP address out of the structure.
Dim lIPAddressPointer As LongPtr ' pointer to host's IP address
Dim lIPAddress As LongPtr ' host's IP address
CopyMemory lIPAddressPointer, ByVal hostinfo.h_addr_list, LenB(lIPAddressPointer)
CopyMemory lIPAddress, ByVal lIPAddressPointer, LenB(lIPAddress)
' Convert the IP address into a human-readable string.
Dim lIPStringPointer As LongPtr ' pointer to an IP address formatted as a string
Dim sIPString As String ' holds a human-readable IP address string
lIPStringPointer = inet_ntoa(lIPAddress)
sIPString = Space(lstrlen(lIPStringPointer))
lResult = lstrcpy(sIPString, lIPStringPointer)
Debug.Print sHostName & " IP: " & sIPString & " : " & iPortNumber
' Create a new socket
Dim lsocketID As Long
lsocketID = Socket(AF_INET, SOCK_STREAM, 0)
If lsocketID = SOCKET_ERROR Then
Err.Raise GENERAL_ERROR, "WinsockOpenTheSocket", "Unable to create the socket!"
End If
' Setup IP address and Port number
Dim I_SocketAddress As sockaddr
With I_SocketAddress
.sin_family = AF_INET
.sin_port = htons(iPortNumber)
.sin_addr = lIPAddress
.sin_zero = String$(8, 0)
End With
' Connect to the socket
lResult = connect(lsocketID, I_SocketAddress, LenB(I_SocketAddress))
Debug.Print Err.LastDllError
If lResult = SOCKET_ERROR Then
Call closesocket(lsocketID)
Call WSACleanup
Err.Raise GENERAL_ERROR, "WinsockOpenTheSocket", "Unable to connect to the socket!"
End If
MsgBox "Port has now opened", vbCritical, "Please Move On"
End Function
'Sending data to the server
Function SendingData(ByVal Socks As Long, ByVal buffer As String, ByVal bufferlen As Long, ByVal flag As Long) As Long
Dim lResult As Long
lResult = Send(Socks, buffer, bufferlen, flag)
Debug.Print Err.LastDllError
If lResult = SOCKET_ERROR Then
Call closesocket(Socks)
Call WSACleanup
Err.Raise GENERAL_ERROR, "SendingData", "Unable to send data to the server!"
End If
SendingData = lResult
End Function
'Receiving data from the server
Function ReceivingData(ByVal Sockets As Long, ByRef buffer As String, ByVal bufferlen As Long, ByVal flag As Long) As Long
Dim lResult As Long
lResult = Recv(Sockets, buffer, bufferlen, flag)
Debug.Print Err.LastDllError
If lResult = SOCKET_ERROR Then
Call closesocket(Sockets)
Call WSACleanup
Err.Raise GENERAL_ERROR, "ReceivingData", "Unable to receive data from the server!"
End If
ReceivingData = lResult
End Function
Public Function MAKEWORD(ByVal bLow As Byte, ByVal bHigh As Byte) As Integer
MAKEWORD = Val("&H" & Right("00" & Hex(bHigh), 2) & Right("00" & Hex(bLow), 2))
End Function
'Close the socket and transport
Function ClosingNetwork(ByVal Socket As LongPtr) As Long
Call closesocket(Socket)
Call WSACleanup
MsgBox "Port has now closed", vbCritical, "Please Move On"
End Function
Re: Winsock with VBA failing to connect
[You will probably get more responses if you post on this site's sister site https://www.vbforums.com/forumdispla...ce-Development ]
Re: Winsock with VBA failing to connect
Quote:
Originally Posted by
2kaud
Okay I managed to clear within VBA thank you so much for the reply
