How to implement Socket Programming using MS Access VBA

This article explains fundamental concept to implement socket programming. Article assumes readers should have good knowledge of VBA coding skills. In order to complete this task we first create a form along with basic controls on it as shown below in figure Fig 1.1 form includes a button with caption IP/Host Details and a Label above that button.

This article demonstrates how to obtain the host IP address of the local machine by using the GetHostByName API of the Windows Sockets dll, Wsock32.dll. To obtain the host IP address, you must use GetHostByName in conjunction with GetHostName.When user click on button shown on from named getipthrfrm first Host Name of local machine show .Same has been depicted in picture mention below in figure Fig-1.2.

Then subsequently IP address of local machine shown .Details has been shown in figure Fig-1.3.

VBA Code for IP/Host Details:

Now we will associate VBA code with On Click event of button cmdgetip.

Private Const WS_VER_REQ = &H101
Private Const WS_VER_MAJ = WS_VER_REQ \ &H100 And &HFF&
Private Const WS_VER_MIN = WS_VER_REQ And &HFF&
Private Const MIN_SOCKS_REQ = 1
Private Const SOCKET_ERR = -1
Private Const WSADesc_len = 256
Private Const WSAsys_Stat_len = 128
Private Type HOSTWITHARK
hnm As Long
hAli As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type
Private Type ARKDATA
arkver As Integer
arkHighver As Integer
szDesc(0 To WSADesc_len) As Byte
szSystemStatus(0 To WSAsys_Stat_len) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpszVendorInfo As Long
End Type
Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal _ arkverRequired As Integer, lpARKDATA As ARKDATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal hostname$, _ ByVal HostLen As Long) As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal _ hostname$) As Long
Private Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, ByVal _ hpvSource&, ByVal cbCopy&)

Sub SocketsInitialize()
Dim WSAD As ARKDATA
Dim iReturn As Integer
Dim sLowByte As String, sHighByte As String, sMsg As String

iReturn = WSAStartup(WS_VER_REQ, WSAD)
If iReturn <> 0 Then
MsgBox "Winsock.dll is not responding."
End
End If
If lobyte(WSAD.arkver) < WS_VER_MAJ Or (lobyte(WSAD.arkver) = _ WS_VER_MAJ And hibyte(WSAD.arkver) < WS_VER_MIN) Then
sHighByte = Trim$(Str$(hibyte(WSAD.arkver)))
sLowByte = Trim$(Str$(lobyte(WSAD.arkver)))
sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
sMsg = sMsg & " is not supported by winsock.dll "
MsgBox sMsg
End
End If
'iMaxSockets is not used in winsock 2. So the following check is only
'necessary for winsock 1. If winsock 2 is requested,
'the following check can be skipped.
If WSAD.iMaxSockets < MIN_SOCKS_REQ Then
sMsg = "This application requires a minimum of "
sMsg = sMsg & Trim$(Str$(MIN_SOCKS_REQ)) & " supported sockets."
MsgBox sMsg
End
End If
End Sub
Sub SocketsCleanup()
Dim lReturn As Long
lReturn = WSACleanup()
If lReturn <> 0 Then
MsgBox "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup "
End
End If
End Sub
Sub Form_Load()
SocketsInitialize
End Sub
Private Sub Form_Unload(Cancel As Integer)
SocketsCleanup
End Sub
Private Sub cmdgetip_Click()
Dim hostname As String * 256
Dim HOSTWITHARK_addr As Long
Dim host As HOSTWITHARK
Dim hostip_addr As Long
Dim temp_ip_address() As Byte
Dim i As Integer
Dim ip_address As String
If gethostname(hostname, 256) = SOCKET_ERR Then
MsgBox "Windows Sockets error " & Str(WSAGetLastError())
Exit Sub
Else
hostname = Trim$(hostname)
End If
HOSTWITHARK_addr = gethostbyname(hostname)
If HOSTWITHARK_addr = 0 Then
MsgBox "Winsock.dll is not responding."
Exit Sub
End If
RtlMoveMemory host, HOSTWITHARK_addr, LenB(host)
RtlMoveMemory hostip_addr, host.hAddrList, 4
MsgBox hostname, vbOKOnly, "Host Name"
'get all of the IP address if machine is multi-homed
Do
ReDim temp_ip_address(1 To host.hLength)
RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
For i = 1 To host.hLength
ip_address = ip_address & temp_ip_address(i) & "."
Next
ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)v MsgBox ip_address, vbOKOnly, "IP Address"
ip_address = ""
host.hAddrList = host.hAddrList + LenB(host.hAddrList)
RtlMoveMemory hostip_addr, host.hAddrList, 4
Loop While (hostip_addr <> 0)
End Sub

'We will also create a module named mdlforipandhost. VBA Code containing procedures within this modules has been shown below.
Option Compare Database

Function hibyte(ByVal wParam As Integer)
hibyte = wParam \ &H100 And &HFF&
End Function
Function lobyte(ByVal wParam As Integer)
lobyte = wParam And &HFF&
End Function