Título: Escáner IP
Publicado por: HJZR4 en 8 Noviembre 2007, 21:23 pm
Pues vamos a ver. "He hecho" (lo pongo entre comillas porque los créditos no son sólo mios) un escaneador de ips de redes. Y me preguntaba si se podría averiguar alguna cosa de una IP escaneada, cualquier cosa, ya sea el sistema operativo o nose... lo que sea... El programa, básicamente, envía un ping en un bucle a un rango de IPs que introduzcas, si el ping se realiza correctamente, añade una ip a la lista de IPs. Simple. El módulo de clase "cPing.cls" es de un tal José Rubí, desconozco de donde lo saqué, estaba por mi disco duro... Si aparece decidlo. Expongo el código. Módulo mdlGeneral.bas:Public StopScan As Boolean Public NumeroIPs As Integer
Sub Iniciar() StopScan = False ' Configura el ListView1 With Form1.lstMaquinas .LabelEdit = False .View = lvwReport .ColumnHeaders.Add 1, , "IP" ' Columna IP. .GridLines = True End With ' Establece los commands Form1.Command1.Enabled = True Form1.Command2.Enabled = False End Sub
Sub IPScan(Desde As String, Hasta As String) Dim i As Integer Dim sstartIP() As String Dim sendIP() As String Dim startIP As String Dim endIP As String
sstartIP = Split(Desde, ".") sendIP = Split(Hasta, ".") ' comprueba que las IPs introducidas son del mismo tipo. If sstartIP(0) = sendIP(0) Then If sstartIP(1) = sendIP(1) Then If sstartIP(2) = sendIP(2) Then If sstartIP(3) < "1" Then MsgBox "El formato de IP introducido no es correcto." Else If sstartIP(3) > "255" Then MsgBox "El formato de IP introducido no es correcto." Else If sendIP(3) < "1" Then MsgBox "El formato de IP introducido no es correcto." Else If sendIP(3) > "255" Then MsgBox "El formato de IP introducido no es correcto." Else NumeroIPs = 0 ' Configura la barra de progreso. With Form1.pbScan .Min = sstartIP(3) .Max = sendIP(3) .Value = sstartIP(3) End With ' Desactiva los commands Form1.Command1.Enabled = False Form1.Command2.Enabled = True ' Inicia el bucle. For i = sstartIP(3) To sendIP(3) If StopScan = True Then GoTo PararScan Else Form1.Label3.Caption = "Estado: Escaneando IPs (" & i & "/" & sendIP(3) & ")" Form1.pbScan.Value = i Call HacerPing(sstartIP(0) & "." & sstartIP(1) & "." & sstartIP(2) & "." & i) End If Next i GoTo FinScan End If End If End If End If Else MsgBox "Las IPs no son del mismo tipo." End If Else MsgBox "Las IPs no son del mismo tipo." End If Else MsgBox "Las IPs no son del mismo tipo." End If Exit Sub
' Acciones al terminar el scan. FinScan: MsgBox "Encontradas " & NumeroIPs & " IP's." Form1.pbScan.Value = sstartIP(3) Form1.Label3.Caption = "Estado: Desocupado." Form1.Command1.Enabled = True Form1.Command2.Enabled = False StopScan = False Exit Sub ' Acciones si se cancela el scan. PararScan: Form1.pbScan.Value = sstartIP(3) Form1.Label3.Caption = "Estado: Desocupado." Form1.Command1.Enabled = True Form1.Command2.Enabled = False StopScan = False Exit Sub End Sub Sub HacerPing(IP As String) Dim Item As ListItem Dim Ping As cPing Set Ping = New cPing
Ping.IPDestino = IP Ping.LongitudDatos = 1 Ping.Ping
DoEvents If Ping.Descripcion = "" Then Set Item = Form1.lstMaquinas.ListItems.Add(, , IP) NumeroIPs = NumeroIPs + 1 End If End Sub
Módulo de clase cPing.cls:'Programado por José Rubí ' Option Explicit
'variables locales que contienen valores de propiedad Private mvarIPDestino As String 'copia local Private mvarLongitudDatos As Long 'copia local Private mvarTimeOut As Long 'copia local Private mvarEstado As Long 'copia local Private mvarDescripcion As String 'copia local Private mvarTiempo As Long 'copia local
'códigos de error Private Const IP_STATUS_BASE = 11000 Private Const IP_SUCCESS = 0 Private Const IP_BUF_TOO_SMALL = (11000 + 1) Private Const IP_DEST_NET_UNREACHABLE = (11000 + 2) Private Const IP_DEST_HOST_UNREACHABLE = (11000 + 3) Private Const IP_DEST_PROT_UNREACHABLE = (11000 + 4) Private Const IP_DEST_PORT_UNREACHABLE = (11000 + 5) Private Const IP_NO_RESOURCES = (11000 + 6) Private Const IP_BAD_OPTION = (11000 + 7) Private Const IP_HW_ERROR = (11000 + 8) Private Const IP_PACKET_TOO_BIG = (11000 + 9) Private Const IP_REQ_TIMED_OUT = (11000 + 10) Private Const IP_BAD_REQ = (11000 + 11) Private Const IP_BAD_ROUTE = (11000 + 12) Private Const IP_TTL_EXPIRED_TRANSIT = (11000 + 13) Private Const IP_TTL_EXPIRED_REASSEM = (11000 + 14) Private Const IP_PARAM_PROBLEM = (11000 + 15) Private Const IP_SOURCE_QUENCH = (11000 + 16) Private Const IP_OPTION_TOO_BIG = (11000 + 17) Private Const IP_BAD_DESTINATION = (11000 + 18) Private Const IP_ADDR_DELETED = (11000 + 19) Private Const IP_SPEC_MTU_CHANGE = (11000 + 20) Private Const IP_MTU_CHANGE = (11000 + 21) Private Const IP_UNLOAD = (11000 + 22) Private Const IP_ADDR_ADDED = (11000 + 23) Private Const IP_GENERAL_FAILURE = (11000 + 50) Private Const IP_WROUNG = (11000 + 50) '//////Variable nueva Private Const MAX_IP_STATUS = 11000 + 50 Private Const IP_PENDING = (11000 + 255) Private Const PING_TIMEOUT = 200 Private Const WS_VERSION_REQD = &H101 Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF& Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF& Private Const MIN_SOCKETS_REQD = 1 Private Const SOCKET_ERROR = -1 Private Const MAX_WSADescription = 256 Private Const MAX_WSASYSStatus = 128 'estructuras Private Type ICMP_OPTIONS Ttl As Byte Tos As Byte Flags As Byte OptionsSize As Byte OptionsData As Long End Type Private ICMPOPT As ICMP_OPTIONS Private Type ICMP_ECHO_REPLY Address As Long status As Long RoundTripTime As Long DataSize As Integer Reserved As Integer DataPointer As Long Options As ICMP_OPTIONS Data As String * 250 End Type Private Type WSADATA wVersion As Integer wHighVersion As Integer szDescription(0 To MAX_WSADescription) As Byte szSystemStatus(0 To MAX_WSASYSStatus) As Byte wMaxSockets As Integer wMaxUDPDG As Integer dwVendorInfo As Long End Type
'funciones del api Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long Private Declare Function IcmpCloseHandle Lib "icmp.dll" _ (ByVal IcmpHandle As Long) As Long Private Declare Function IcmpSendEcho Lib "icmp.dll" _ (ByVal IcmpHandle As Long, ByVal DestinationAddress As Long, _ ByVal RequestData As String, ByVal RequestSize As Integer, _ ByVal RequestOptions As Long, ReplyBuffer As ICMP_ECHO_REPLY, _ ByVal ReplySize As Long, ByVal Timeout As Long) As Long Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long Private Declare Function WSAStartup Lib "WSOCK32.DLL" _ (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Function AddressStringToLong(ByVal tmp As String) As Long Dim i As Integer Dim parts(1 To 4) As String i = 0 'we have to extract each part of the '123.456.789.123 string, delimited by 'a period While InStr(tmp, ".") > 0 i = i + 1 parts(i) = Mid(tmp, 1, InStr(tmp, ".") - 1) tmp = Mid(tmp, InStr(tmp, ".") + 1) Wend i = i + 1 parts(i) = tmp If i <> 4 Then AddressStringToLong = 0 Exit Function End If 'build the long value out of the 'hex of the extracted strings AddressStringToLong = Val("&H" & Right("00" & Hex(parts(4)), 2) & _ Right("00" & Hex(parts(3)), 2) & _ Right("00" & Hex(parts(2)), 2) & _ Right("00" & Hex(parts(1)), 2))
End Function
Private Function HiByte(ByVal wParam As Integer) HiByte = wParam \ &H100 And &HFF& End Function
Private Function LoByte(ByVal wParam As Integer) LoByte = wParam And &HFF& End Function
Private Function SocketsCleanup() As Boolean Dim X As Long X = WSACleanup() If X <> 0 Then MsgBox "Windows Sockets error " & Trim$(Str$(X)) & _ " occurred in Cleanup.", vbExclamation SocketsCleanup = False Else SocketsCleanup = True End If End Function
Private Function SocketsInitialize() As Boolean Dim WSAD As WSADATA Dim X As Integer Dim szLoByte As String, szHiByte As String, szBuf As String X = WSAStartup(WS_VERSION_REQD, WSAD) If X <> 0 Then MsgBox "Windows Sockets for 32 bit Windows " & _ "environments is not successfully responding." SocketsInitialize = False Exit Function End If If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _ HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then szHiByte = Trim$(Str$(HiByte(WSAD.wVersion))) szLoByte = Trim$(Str$(LoByte(WSAD.wVersion))) szBuf = "Windows Sockets Version " & szLoByte & "." & szHiByte szBuf = szBuf & " is not supported by Windows " & _ "Sockets for 32 bit Windows environments." MsgBox szBuf, vbExclamation SocketsInitialize = False Exit Function End If If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then szBuf = "This application requires a minimum of " & _ Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets." MsgBox szBuf, vbExclamation SocketsInitialize = False Exit Function End If SocketsInitialize = True End Function
Public Sub Ping() Dim hPort As Long Dim dwAddress As Long Dim sDataToSend As String Dim iOpt As Long Dim ECHO As ICMP_ECHO_REPLY Dim res As Boolean res = SocketsInitialize If res Then sDataToSend = String$(mvarLongitudDatos, "A") dwAddress = AddressStringToLong(mvarIPDestino) hPort = IcmpCreateFile() If IcmpSendEcho(hPort, dwAddress, sDataToSend, Len(sDataToSend), _ 0, ECHO, Len(ECHO), mvarTimeOut) Then 'the ping succeeded,.Status will be 0 '.RoundTripTime is the time in ms for the ping to complete, '.Data is the data returned (NULL terminated) '.Address is the Ip address that actually replied '.DataSize is the size of the string in .Data mvarEstado = 0 mvarTiempo = ECHO.RoundTripTime Else mvarTiempo = 0 mvarEstado = Abs(ECHO.status) If mvarEstado = 0 Then mvarEstado = IP_GENERAL_FAILURE End If Call IcmpCloseHandle(hPort) res = SocketsCleanup Else mvarEstado = IP_GENERAL_FAILURE mvarTiempo = 0 End If mvarDescripcion = GetStatusCode(mvarEstado) End Sub
Private Function GetStatusCode(status As Long) As String Dim msg As String
Select Case status Case IP_SUCCESS: msg = "" Case IP_BUF_TOO_SMALL: msg = "Buffer demasiado pequeño" Case IP_DEST_NET_UNREACHABLE: msg = "Red de destino no encontrada" Case IP_DEST_HOST_UNREACHABLE: msg = "Host destino no encontrado" Case IP_DEST_PROT_UNREACHABLE: msg = "Dest prot unreachable" Case IP_DEST_PORT_UNREACHABLE: msg = "Puerto destino no encontrado" Case IP_NO_RESOURCES: msg = "Sin recursos" Case IP_BAD_OPTION: msg = "Opción inválida" Case IP_HW_ERROR: msg = "Error hardware" Case IP_PACKET_TOO_BIG: msg = "Paquete demasiado grande" Case IP_REQ_TIMED_OUT: msg = "El tiempo de espera se ha agotado" Case IP_BAD_REQ: msg = "Respuesta incorrecta" Case IP_BAD_ROUTE: msg = "Ruta inválida" Case IP_TTL_EXPIRED_TRANSIT: msg = "Ttl finalizado" Case IP_TTL_EXPIRED_REASSEM: msg = "Ttl expired reassem" Case IP_PARAM_PROBLEM: msg = "Error en parámetros" Case IP_SOURCE_QUENCH: msg = "Source quench" Case IP_OPTION_TOO_BIG: msg = "Opción demasiado grande" Case IP_BAD_DESTINATION: msg = "Destino incorrecto" Case IP_ADDR_DELETED: msg = "addr deleted" Case IP_SPEC_MTU_CHANGE: msg = "spec mtu change" Case IP_MTU_CHANGE: msg = "ip mtu_change" Case IP_UNLOAD: msg = "unload" Case IP_ADDR_ADDED: msg = "addr added" Case IP_GENERAL_FAILURE: msg = "Fallo general" Case IP_PENDING: msg = "Pendiente" Case PING_TIMEOUT: msg = "Ping timeout" Case Else: msg = "Recibido mensaje desconocido" End Select GetStatusCode = msg End Function
Public Property Get Tiempo() As Long 'se usa cuando se asigna un valor a una propiedad, en el lado derecho de la asignación. 'Syntax: Debug.Print X.Tiempo Tiempo = mvarTiempo End Property
Public Property Get Descripcion() As String 'se usa cuando se asigna un valor a una propiedad, en el lado derecho de la asignación. 'Syntax: Debug.Print X.Descripcion Descripcion = mvarDescripcion End Property
Public Property Get Estado() As Long 'se usa cuando se asigna un valor a una propiedad, en el lado derecho de la asignación. 'Syntax: Debug.Print X.Estado Estado = mvarEstado End Property
Public Property Let Timeout(ByVal vData As Long) 'se usa cuando se asigna un valor a una propiedad, en el lado izquierdo de la asignación. 'Syntax: X.TimeOut = 5 mvarTimeOut = vData If mvarTimeOut < 1 Then mvarTimeOut = 1 End Property
Public Property Get Timeout() As Long 'se usa cuando se asigna un valor a una propiedad, en el lado derecho de la asignación. 'Syntax: Debug.Print X.TimeOut Timeout = mvarTimeOut End Property
Public Property Let LongitudDatos(ByVal vData As Long) 'se usa cuando se asigna un valor a una propiedad, en el lado izquierdo de la asignación. 'Syntax: X.LongitudDatos = 5 mvarLongitudDatos = vData If mvarLongitudDatos > 250 Then mvarLongitudDatos = 250 If mvarLongitudDatos < 1 Then mvarLongitudDatos = 1 End Property
Public Property Get LongitudDatos() As Long 'se usa cuando se asigna un valor a una propiedad, en el lado derecho de la asignación. 'Syntax: Debug.Print X.LongitudDatos LongitudDatos = mvarLongitudDatos End Property
Public Property Let IPDestino(ByVal vData As String) 'se usa cuando se asigna un valor a una propiedad, en el lado izquierdo de la asignación. 'Syntax: X.IPDestino = 5 mvarIPDestino = vData End Property
Public Property Get IPDestino() As String 'se usa cuando se asigna un valor a una propiedad, en el lado derecho de la asignación. 'Syntax: Debug.Print X.IPDestino IPDestino = mvarIPDestino End Property
Private Sub Class_Initialize() mvarLongitudDatos = 32 mvarTimeOut = 1500 End Sub
Formulario Form1.frm:Private Sub Command1_Click() ' Text1 y Text2 son el rango de IPs Call IPScan(Text1.Text, Text2.Text) End Sub
Private Sub Command2_Click() StopScan = True End Sub
Private Sub Command3_Click() Call HacerPing(Text2.Text) End Sub
Private Sub Form_Load() Call Iniciar End Sub
Y eso es. Pues eso, que si alguien puede decirme hasta donde es capaz de llegar Winsock.ocx sin necesidar de usar aplicaciones cliente/servidor.
|