home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Secure_Me_398531262001.psc / secureme4sourcecodebuild17 / mdlping.bas < prev   
Encoding:
BASIC Source File  |  2001-10-19  |  3.1 KB  |  78 lines
  1. Attribute VB_Name = "mdlping"
  2. Const SOCKET_ERROR = 0
  3. Private Type WSAdata
  4.     wVersion As Integer
  5.     wHighVersion As Integer
  6.     szDescription(0 To 255) As Byte
  7.     szSystemStatus(0 To 128) As Byte
  8.     iMaxSockets As Integer
  9.     iMaxUdpDg As Integer
  10.     lpVendorInfo As Long
  11. End Type
  12. Private Type Hostent
  13.     h_name As Long
  14.     h_aliases As Long
  15.     h_addrtype As Integer
  16.     h_length As Integer
  17.     h_addr_list As Long
  18. End Type
  19. Private Type IP_OPTION_INFORMATION
  20.     TTL As Byte
  21.     Tos As Byte
  22.     Flags As Byte
  23.     OptionsSize As Long
  24.     OptionsData As String * 128
  25. End Type
  26. Private Type IP_ECHO_REPLY
  27.     Address(0 To 3) As Byte
  28.     Status As Long
  29.     RoundTripTime As Long
  30.     DataSize As Integer
  31.     Reserved As Integer
  32.     data As Long
  33.     Options As IP_OPTION_INFORMATION
  34. End Type
  35. Private Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal hostname As String) As Long
  36. Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As Long
  37. Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
  38. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
  39. Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
  40. Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal HANDLE As Long) As Boolean
  41. Private Declare Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As Long, ByVal DestAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptns As IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, ByVal ReplySize As Long, ByVal TimeOut As Long) As Boolean
  42.  
  43. Function ImaPingJ00(hostname As String, lblreturn As Label) As String
  44.     Dim hFile As Long, lpWSAdata As WSAdata
  45.     Dim hHostent As Hostent, AddrList As Long
  46.     Dim Address As Long, rIP As String
  47.     Dim OptInfo As IP_OPTION_INFORMATION
  48.     Dim EchoReply As IP_ECHO_REPLY
  49.     Call WSAStartup(&H101, lpWSAdata)
  50.     If GetHostByName(hostname + String(64 - Len(hostname), 0)) <> SOCKET_ERROR Then
  51.         CopyMemory hHostent.h_name, ByVal GetHostByName(hostname + String(64 - Len(hostname), 0)), Len(hHostent)
  52.         CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
  53.         CopyMemory Address, ByVal AddrList, 4
  54.     End If
  55.     hFile = IcmpCreateFile()
  56.     If hFile = 0 Then
  57.         lblreturn.Caption = "Ping Reply: Unable to Create File Handle"
  58.         Exit Function
  59.     End If
  60.     OptInfo.TTL = 255
  61.     If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) + 8, 2000) Then
  62.         rIP = CStr(EchoReply.Address(0)) + "." + CStr(EchoReply.Address(1)) + "." + CStr(EchoReply.Address(2)) + "." + CStr(EchoReply.Address(3))
  63.     Else
  64.         lblreturn.Caption = "Ping Reply: Timeout"
  65.     End If
  66.     If EchoReply.Status = 0 Then
  67.         lblreturn.Caption = "Ping Reply: " + Trim$(CStr(EchoReply.RoundTripTime)) + "ms"
  68.     Else
  69.         lblreturn.Caption = "Ping Reply: Failure ..."
  70.     End If
  71.     Call IcmpCloseHandle(hFile)
  72.     Call WSACleanup
  73. End Function
  74.  
  75. Function saveprgsettings()
  76.  
  77. End Function
  78.