troubleshooting Question

Challenges to connect to IP address with VBA in Ms Access

Avatar of Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.ScFlag for Zambia asked on
Microsoft AccessVBA
8 Comments1 Solution12 ViewsLast Modified:
Please do not get me wrong here, we have a working COM port system well loved by everyone, now what I trying to do is to try and use the serial gadget to be accessed by multiple users via TCP/IP protocol so that the users do not need to be necessarily physically connected to the gadget as is the case now. 
First let me say the VBA code below is not mine, I simply modified it to work on both 64- & 32-BIT situations. Finally, the code is able to compile as Bas module standalone function.

Option Compare Database


Option Explicit


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
'Programs
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" (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, ByValbuf 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" (ByValwVersionRequired 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)


Sub StartIt()
    Dim StartUpInfo As WSAData
    'Version 1.1 (1*256 + 1) = 257
    'version 2.0 (2*256 + 0) = 512
    'Get WinSock version
    Sheets("Sheet1").Select
    Range("C2").Select
Version = ActiveCell.FormulaR1C1
    'Initialize Winsock DLL
    x = WSAStartup(Version, StartUpInfo)
End Sub



Open in new window

Now the challenges is to make the following functions work as well:
  1. Open Socket
  2. Send Command
  3. Receive Command
  4. Close Connection 
  5. Clean Up
 
Help required
  1. Unfortunately, they are not compiling that is where I need your help if possible.
  2. How to bring the IP address  , example 192.168.8.101 and Port number 8.8.8.8
  3. Suppose the business logic is represented by strData, then how do I factor it in the code

'OpenSocket
Function OpenSocket(ByVal Hostname As String, ByVal PortNumber As Integer) As Integer
    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                       '
        Exit Function                                    '
    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                                '
        Exit Function                                             '
    End If                                                        '
    OpenSocket = socketId


End Function


'SendCommand
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
        Exit Function
    End If
    SendCommand = NO_ERROR
End Function


'RecvAscii
Function RecvAscii(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)                           '
            Exit Function                               '
        End If                                          '
        If c = Chr$(10) Then                            '
           dataBuf = dataBuf + Chr$(0)                  '............(2)
           RecvAscii = NO_ERROR                         '
           Exit Function                                '
        End If                                          '
        length = length + Count                         '............(3)
        dataBuf = dataBuf + c                           '
    Wend
    RecvAscii = RECV_ERROR


End Function


'CloseConnection
Sub CloseConnection()
    x = closesocket(socketId)
    If x = SOCKET_ERROR Then
        MsgBox ("ERROR: closesocket = " + Str$(x))
        Exit Sub
    End If
End Sub


  EndIt
Sub EndIt()
    'Shutdown Winsock DLL
    x = WSACleanup()
End Sub



Open in new window


ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 1 Answer and 8 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 8 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros