Solved

ping button in an Access database

Posted on 1998-07-08
1
230 Views
Last Modified: 2013-11-13
I need to create a button in my Access database that will ping the IP of the selected client field.
0
Comment
Question by:Lozz
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
1 Comment
 
LVL 1

Accepted Solution

by:
Geffl earned 100 total points
ID: 1465210
Hi Lozz!

Paste this code in a module and try the function 'Ping'. The hostname can be the computername or IP-Adress.
The function returns true if ping was successfull.

Public RespondingHost As String
Public TraceRT As Boolean
Public TTL As Integer
Public Const WS_VERSION_MAJOR = &H101 \ &H100 And &HFF&
Public Const WS_VERSION_MINOR = &H101 And &HFF&
Public Const MIN_SOCKETS_REQD = 0
Public Function Ping(Host$) As Boolean

    vbWSAStartup                ' Initialize Winsock
    If Not vbGetHostByName(Host$) Then
        WSACleanup
        Exit Function
    End If

    vbIcmpCreateFile            ' Get ICMP Handle
    pIPo.TTL = 255

    Ping = vbIcmpSendEcho       ' Send the ICMP Echo Request

    vbIcmpCloseHandle           ' Close the ICMP Handle

    vbWSACleanup                ' Close Winsock

End Function
Sub vbWSAStartup()
    iReturn = WSAStartup(&H101, WSAdata)

    If iReturn <> 0 Then    ' If WSock32 error, then tell me about it
        MsgBox "WSock32.dll is not responding!", vbOKOnly, "VB4032-ICMPEcho"
    End If

    If LoByte(WSAdata.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAdata.wVersion) = WS_VERSION_MAJOR And HiByte(WSAdata.wVersion) < WS_VERSION_MINOR) Then
        sHighByte = Trim$(Str$(HiByte(WSAdata.wVersion)))
        sLowByte = Trim$(Str$(LoByte(WSAdata.wVersion)))
        sMsg = "WinSock Version " & sLowByte & "." & sHighByte
        sMsg = sMsg & " is not supported "
        MsgBox sMsg, vbOKOnly, "VB4032-ICMPEcho"
        End
    End If

    If WSAdata.iMaxSockets < MIN_SOCKETS_REQD Then
        sMsg = "This application requires a minimum of "
        sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
        MsgBox sMsg, vbOKOnly, "VB4032-ICMPEcho"
        End
    End If
   
    MaxSockets = WSAdata.iMaxSockets
    If MaxSockets < 0 Then
        MaxSockets = 65536 + MaxSockets
    End If

    MaxUDP = WSAdata.iMaxUdpDg
    If MaxUDP < 0 Then
        MaxUDP = 65536 + MaxUDP
    End If
    Description = ""
   
    For i = 0 To WSADESCRIPTION_LEN
        If WSAdata.szDescription(i) = 0 Then Exit For
        Description = Description + Chr$(WSAdata.szDescription(i))
    Next i
    Status = ""
   
    For i = 0 To WSASYS_STATUS_LEN
        If WSAdata.szSystemStatus(i) = 0 Then Exit For
        Status = Status + Chr$(WSAdata.szSystemStatus(i))
    Next i

End Sub
Private Function vbGetHostByName(ByVal HostName$) As Boolean

    Dim szString As String

    Host = HostName$    ' Set Variable Host to Value in Text1.text

    szString = String(64, &H0)
    Host = Host + Right$(szString, 64 - Len(Host))

    If gethostbyname(Host) = SOCKET_ERROR Then          ' If WSock32 error, then tell me about it
        Exit Function
    Else
        PointerToPointer = gethostbyname(Host)          ' Get the pointer to the address of the winsock hostent structure
        CopyMemory Hostent.h_name, ByVal _
        PointerToPointer, Len(Hostent)                  ' Copy Winsock structure to the VisualBasic structure

        ListAddress = Hostent.h_addr_list               ' Get the ListAddress of the Address List
        CopyMemory ListAddr, ByVal ListAddress, 4       ' Copy Winsock structure to the VisualBasic structure
        CopyMemory IPLong, ByVal ListAddr, 4            ' Get the first list entry from the Address List
        CopyMemory Addr, ByVal ListAddr, 4

        vbGetHostByName = True

    End If

End Function
Sub vbGetHostName()
    
    Host = String(64, &H0)      ' Set Host value to a bunch of spaces
    
    If gethostname(Host, HostLen) = SOCKET_ERROR Then   ' This routine is where we get the host's name
        sMsg = "WSock32 Error" & Str$(WSAGetLastError())    ' If WSOCK32 error, then tell me about it
        MsgBox sMsg, vbOKOnly, "VB4032-ICMPEcho"
    Else
        Host = Left$(Trim$(Host), Len(Trim$(Host)) - 1)     ' Trim up the results
        Text1.Text = Host                                   ' Display the host's name in label1
    End If

End Sub
Private Function vbIcmpSendEcho() As Boolean

    szBuffer = "abcdefghijklmnopqrstuvwabcdefghijklmnopqrstuvwabcdefghijklmnopqrstuvwabcdefghijklmnopqrstuvwabcdefghijklmnopqrstuvwabcdefghijklm"
    szBuffer = Left$(szBuffer, 32)
    DoEvents
    bReturn = IcmpSendEcho(hIP, Addr, szBuffer, Len(szBuffer), pIPo, pIPe, Len(pIPe) + 8, 2700)

    If bReturn Then
        vbIcmpSendEcho = (pIPe.Status = 0)
    End If

End Function
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
Sub vbWSACleanup()
    iReturn = WSACleanup()

    If iReturn <> 0 Then    ' If WSock32 error, then tell me about it.
        sMsg = "WSock32 Error - " & Trim$(Str$(iReturn)) & " occurred in Cleanup"
        MsgBox sMsg, vbOKOnly, "VB4032-ICMPEcho"
        End
    End If

End Sub
Sub vbIcmpCloseHandle()

    bReturn = IcmpCloseHandle(hIP)

    If bReturn = False Then
        MsgBox "ICMP Closed with Error", vbOKOnly, "VB4032-ICMPEcho"
    End If

End Sub
Sub vbIcmpCreateFile()

    hIP = IcmpCreateFile()

End Sub


0

Featured Post

Creating Instructional Tutorials  

For Any Use & On Any Platform

Contextual Guidance at the moment of need helps your employees/users adopt software o& achieve even the most complex tasks instantly. Boost knowledge retention, software adoption & employee engagement with easy solution.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
Viewers will learn how to properly install Eclipse with the necessary JDK, and will take a look at an introductory Java program. Download Eclipse installation zip file: Extract files from zip file: Download and install JDK 8: Open Eclipse and …
In a recent question (https://www.experts-exchange.com/questions/29004105/Run-AutoHotkey-script-directly-from-Notepad.html) here at Experts Exchange, a member asked how to run an AutoHotkey script (.AHK) directly from Notepad++ (aka NPP). This video…

636 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question