Cómo implementar ping en VB

Descripción: No es el comando ping de cmd, está completamente integrado.

Uso: PingIP("202.108.22.142", TTL (opcional, el valor predeterminado es 10), TimeOut (opcional, el valor predeterminado es 1000)), tiempo de retardo de retorno

Nota: No se puede hacer ping nombre de dominio.

TTL y tiempo de espera personalizables.

Esta es una modificación de la versión extranjera. La versión original era demasiado larga. Está simplificado ahora.

Se desconoce el autor original.

El siguiente es el código del módulo Ping:

Opción explícita

'Módulo Ping, uso: PingIP("202.108.22.142", TTL(opcional , predeterminado 10 ), TimeOut (opcional, predeterminado 1000)), longitud de tiempo de espera de retorno

' Nota: No se puede hacer ping al dominio.

Tipo privado ip_option_information

TTL como byte 'Tiempo de vida

Tos como byte 'Tipo de servicio

Banderas como byte 'IP header flags.p>

OptionsSize As Byte 'El tamaño en bytes de los datos de la opción

OptionsData As Long 'Puntero de datos de la opción

Tipo de fin

Tipo privado icmp_ echoo_reply

Dirección tan larga 'Dirección de respuesta

Estado tan larga 'Responder a IP_STATUS, el valor se define como arriba

RoundTripTime As Long 'RTT, unidad Milisegundos

Tamaño de datos como entero 'Tamaño de datos de respuesta en bytes

Reservado como entero 'Reservado para uso del sistema

Puntero de datos como largo 'Puntero de datos de respuesta

p>

Opciones como ip_option_information 'Opciones de respuesta

Datos como cadena * 250 'Los datos de respuesta deben ser una copia de la cadena enviada, terminada en NULL.

Copia de la cadena enviada, terminada en NULL

'Este campo debe ser lo suficientemente grande como para contener la cadena enviada

Tipo de finalización

CurIp privado siempre

CurIpDes privado como cadena

Const privado WSADESCRIPTION_LEN =256

Const privado WSASYSSTATUS_LEN = 256

Const privado WSADESCRIPTION_LEN_1 = WSADESCRIPTION_LEN 1

p>

Const privada WSASYSSTATUS_LEN_1 = WSASYSSTATUS_LEN 1

Const privada SOCKET_ ERROR = -1

Etiqueta de tipo privadoWSAData

wVersion como entero

wHighVersion como entero

szDescription como cadena * WSADESCRIPTION_LEN_1

szSystemStatus como cadena * WSASYSSTATUS_LEN_1WSASYSSTATUS_LEN_1

iMaxSockets como entero

iMaxUdpDg como entero

lpVendorInfo As String * 200

Tipo de finalización

Función de declaración privada IcmpCreateFile Lib "icmp.dll" () Siempre

Privada Declarar función IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle mientras sea largo)

Privado Declarar función IcmpSendEcho Lib "icmp.dll" (ByVal IcmpHandle mientras sea largo, ByVal DestinationAddress mientras sea largo, ByVal RequestData como cadena, ByVal RequestSize como entero, RequestOptions como ip_option_ Information, ReplyBuffer como icmp_echo_reply, ByVal ReplySize como largo, ByVal TimeOut como largo)

Función de declaración privada WSAStartup Lib "wsock32" (ByVal wVersionRequested como entero, lpWSADATA como tagWSAData ) Como entero

Función de declaración privada WSACleanup Lib "wsock32" () Como entero

Función pública PingIP(ByVal strIPAddress

Como cadena, opcional ByVal lngTTL As Long = 10, opcional ByVal lngTimeOut As Long = 1000) Como cadena

Dim hFile As Long 'El identificador del puerto icmp abierto

Dim lRet As Long 'Guarde el valor de retorno según sea necesario

Dim liIPAddress As Long

Dim strMessage As String

DimpOptions As ip_option_information

Dim pReturn As icmp_echo_reply

Dim iVal As Integer

Dim lPingRet As Long

Dim pWsaData As tagWSAData

strMessage = "Hacer eco de esta cadena de datos"

iVal = WSAStartup(amp.H101, pWsaData H101, pWsaData)

ConvertirIPAddressToLong strIPAddress

lIPAddress = CurIp

hFile = IcmpCreateFile()

pOptions.TTL = lngTTL

lRet = IcmpSendEcho(hFile, lIPAddress, strMessage, Len(strMessage), pOptions, pReturn, Len(pReturn), lngTimeOut )

Si lRet = 0 Entonces

PingIP = "Fail"

De lo contrario

Si pReturn.RoundTripTime gt; / p>

PingIP = "TimeOut"

Finalizar si

Finalizar si

lRet = IcmpCloseHandle(hFile)

iVal = WSACleanup()

Finalizar función

Sub privada ConvertIPAddressToLong(ByVal strIPAddress As String)

En caso de error, reanudar siguiente

Atenuar strTemp como String, lAddress As Long, iValCount As Integer, lDotValues(1 To 4) As String

strTemp = strIPAddress 'Crea espacio de almacenamiento inicial y contador

iValCount = 0

Do While InStr(strTemp, ".") gt; 0 'Continuar mientras todavía haya puntos en la cadena

iValCount = iValCount 1 'Calcular la cantidad

lDotValues(iValCount) ) = Medio(strTemp, ".") 1, InSt

r(strTemp, ".") - 1) 'Eliminar y convertir

strTemp = Mid(strTemp, InStr(strTemp, ".") 1) 'Eliminar y convertir

strTemp = Mid(strTemp, ".") 1) 'Eliminar números y puntos

Loop

iValCount = iValCount 1 'Ahora solo queda el último número en la cadena

lDotValues( iValCount) = strTemp

If iValCount lt;gt; 4 Then 'Si no obtenemos 4 valores, entonces la dirección IP es inútil

CurIp = 0

Salir Sub

End If

' obtiene 4 valores, hexadecimales, rellenos con 2 dígitos para formar una cadena hexadecimal y luego convierte todo el código confuso en un retorno de cadena larga

lDirección = Val("H" y Derecha("00" y Hex(lDotValues(4)), 2) y Derecha("00" y Hex(lDotValues(3)), 2 ) & Right("00" & Hex(lDotValues(2)), 2) & Right("00" & Hex(lDotValues(1)), 2))

CurIp = lAddress 'Establecer valor de retorno

CurIpDes = strIPAddress

End Sub