Solved

Detect Remote IP address Using VB

Posted on 2000-03-25
17
447 Views
Last Modified: 2006-11-17
How can I detect The IP address of all computers connected to  my LANs using VB6
0
Comment
Question by:anasexpert
  • 7
  • 6
  • 2
  • +2
17 Comments
 
LVL 14

Expert Comment

by:mcrider
ID: 2656485
Well, you could use the following code to ping all of the addresses on your network. Add the following to a MODULE and then you can do this:

   Dim iVal As Long
   For iVal = 0 to 255
      If IsHostAlive("207.19.203."+CStr(iVal))=True Then
          Debug.Print 207.19.203."+CStr(iVal)+" Is Alive"
      End If
   Next iVal



Cheers!®©


THE CODE:


    Option Explicit
    Private Const WS32_NOT_ENOUGH_SOCKETS = -4
    Private Const WS32_NOT_SUPPORTED = -3
    Private Const WS32_NOT_RESPONDING = -2
    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 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 WSADescription_Len = 256
    Private Const WSASYS_Status_Len = 128
    Private Type ICMP_OPTIONS
        Ttl             As Byte
        Tos             As Byte
        Flags           As Byte
        OptionsSize     As Byte
        OptionsData     As Long
    End Type
    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 HOSTENT
        hName As Long
        hAliases As Long
        hAddrType As Integer
        hLength As Integer
        hAddrList As Long
    End Type
    Public Type LHOSTENTRY
        hName As String
        hAddress As String
        hStatus As String
    End Type
    Private Type WSADATA
        wversion As Integer
        wHighVersion As Integer
        szDescription(0 To WSADescription_Len) As Byte
        szSystemStatus(0 To WSASYS_Status_Len) As Byte
        iMaxSockets As Integer
        iMaxUdpDg As Integer
        lpszVendorInfo As Long
    End Type
    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 Declare Function gethostname Lib "WSOCK32.DLL" _
       (ByVal szHost As String, ByVal dwHostLen As Long) As Long
    Private Declare Function gethostbyname Lib "WSOCK32.DLL" _
       (ByVal szHost As String) As Long
    Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, _
        ByVal hpvSource As Long, ByVal cbCopy As Long)
    Private G_lhEntry As LHOSTENTRY
   
    Public Function GetHostInfo(lHost As String) As LHOSTENTRY
        Dim WSAD As WSADATA
        Dim rVal As Long
        Dim hostname As String * 256
        Dim hostent_addr As Long
        Dim host As HOSTENT
        Dim hostip_addr As Long
        Dim temp_ip_address() As Byte
        Dim iVal As Integer
        Dim ip_address As String
       
        rVal = WSAStartup(WS_VERSION_REQD, WSAD)
        If rVal <> 0 Then
            GetHostInfo.hStatus = WS32_NOT_RESPONDING
            Exit Function
        End If
        If CvtLoByte(WSAD.wversion) < WS_VERSION_MAJOR Or _
           (CvtLoByte(WSAD.wversion) = WS_VERSION_MAJOR And _
            CvtHiByte(WSAD.wversion) < WS_VERSION_MINOR) Then
            GetHostInfo.hStatus = WS32_NOT_SUPPORTED
            WSACleanup
            Exit Function
        End If
        If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
            GetHostInfo.hStatus = WS32_NOT_ENOUGH_SOCKETS
            WSACleanup
            Exit Function
        End If
       
        GetHostInfo.hStatus = SOCKET_ERROR
        GetHostInfo.hName = Trim$(LCase$(lHost))
        hostname = Left$(lHost + String(256, Chr$(0)), 256)
        hostent_addr = gethostbyname(hostname)
        If hostent_addr = 0 Then
            WSACleanup
            Exit Function
        End If
        RtlMoveMemory host, hostent_addr, LenB(host)
        RtlMoveMemory hostip_addr, host.hAddrList, 4
        ReDim temp_ip_address(1 To host.hLength)
        RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
        For iVal = 1 To host.hLength
            ip_address = ip_address & temp_ip_address(iVal) & "."
        Next
        ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
        GetHostInfo.hAddress = ip_address
        GetHostInfo.hStatus = IP_SUCCESS
        WSACleanup
    End Function
   
    Public Function GetPingMsg(status As Long) As String
        Dim msg As String
        Select Case status
            Case WS32_NOT_ENOUGH_SOCKETS:  msg = "Not enough sockets available"
            Case WS32_NOT_SUPPORTED:       msg = "Socket version not supported"
            Case WS32_NOT_RESPONDING:      msg = "Winsock 32 not responding"
            Case IP_SUCCESS:               msg = "OK"
            Case IP_BUF_TOO_SMALL:         msg = "IP buf too small"
            Case IP_DEST_NET_UNREACHABLE:  msg = "Destination network unreachable"
            Case IP_DEST_HOST_UNREACHABLE: msg = "Destination host unreachable"
            Case IP_DEST_PROT_UNREACHABLE: msg = "Destination protocol unreachable"
            Case IP_DEST_PORT_UNREACHABLE: msg = "Destination port unreachable"
            Case IP_NO_RESOURCES:          msg = "IP no resources"
            Case IP_BAD_OPTION:            msg = "IP bad option"
            Case IP_HW_ERROR:              msg = "IP hardware error"
            Case IP_PACKET_TOO_BIG:        msg = "IP packet too big"
            Case IP_REQ_TIMED_OUT:         msg = "Request timed out"
            Case IP_BAD_REQ:               msg = "Bad request"
            Case IP_BAD_ROUTE:             msg = "Bad route"
            Case IP_TTL_EXPIRED_TRANSIT:   msg = "IP TTL expired transit"
            Case IP_TTL_EXPIRED_REASSEM:   msg = "IP TTL expired reassem"
            Case IP_PARAM_PROBLEM:         msg = "IP param problem"
            Case IP_SOURCE_QUENCH:         msg = "IP source quench"
            Case IP_OPTION_TOO_BIG:        msg = "IP option too big"
            Case IP_BAD_DESTINATION:       msg = "IP bad destination"
            Case IP_ADDR_DELETED:          msg = "IP address deleted"
            Case IP_SPEC_MTU_CHANGE:       msg = "IP spec mtu change"
            Case IP_MTU_CHANGE:            msg = "IP mtu change"
            Case IP_UNLOAD:                msg = "IP unload"
            Case IP_ADDR_ADDED:            msg = "IP address added"
            Case IP_GENERAL_FAILURE:       msg = "IP general failure"
            Case IP_PENDING:               msg = "IP pending"
            Case PING_TIMEOUT:             msg = "Ping timeout"
            Case Else:                     msg = "Unknown message returned"
        End Select
        GetPingMsg = msg
    End Function
   
   
    Private Function CvtHiByte(ByVal wParam As Integer)
        CvtHiByte = wParam \ &H100 And &HFF&
    End Function
   
   
    Private Function CvtLoByte(ByVal wParam As Integer)
        CvtLoByte = wParam And &HFF&
    End Function
   
   
    Public Function IsHostAlive(lHost As String) As Boolean
        Dim ECHO As ICMP_ECHO_REPLY
        Dim pos As Integer
        IsHostAlive = False
        SysPing lHost, ECHO
        If ECHO.status = IP_SUCCESS Then IsHostAlive = True
    End Function
   
    Public Function GetPingString(lHost As String) As String
        Dim ECHO As ICMP_ECHO_REPLY
        Dim pos As Integer
        SysPing lHost, ECHO
        If ECHO.status = IP_SUCCESS Then
            GetPingString = "Reply from " & G_lhEntry.hAddress & ": bytes=" & Trim$(CStr(ECHO.DataSize)) _
                & " time=" & Trim$(CStr(ECHO.RoundTripTime)) & "ms TTL=" _
                & Trim$(CStr(ECHO.Options.Ttl))
        Else
            GetPingString = GetPingMsg(ECHO.status)
        End If
    End Function
   
    Private Function SysPing(lhostname As String, ECHO As ICMP_ECHO_REPLY, Optional EchoString As String) As Long
        Dim WSAD As WSADATA
        Dim hPort As Long
        Dim dwAddr As Long
        Dim iOpt As Long
        Dim rVal As Long
        Dim eString As String
        Dim szLoByte As String
        Dim szHiByte As String
        Dim szBuf As String
        eString = "ABCDEFGHIJKLMNOPQRSTUVWXYZ012345": If Not EchoString = "" Then eString = EchoString
        G_lhEntry = GetHostInfo(lhostname)
        If Not G_lhEntry.hStatus = 0 Then
            SysPing = IP_BAD_DESTINATION
            ECHO.status = IP_BAD_DESTINATION
            Exit Function
        End If
        dwAddr = CvtIPAddrClng(G_lhEntry.hAddress)
        If dwAddr = 0 Then
            SysPing = IP_BAD_DESTINATION
            ECHO.status = IP_BAD_DESTINATION
            Exit Function
        End If
        rVal = WSAStartup(WS_VERSION_REQD, WSAD)
        If rVal <> 0 Then
            SysPing = WS32_NOT_RESPONDING
            ECHO.status = WS32_NOT_RESPONDING
            Exit Function
        End If
        If CvtLoByte(WSAD.wversion) < WS_VERSION_MAJOR Or _
           (CvtLoByte(WSAD.wversion) = WS_VERSION_MAJOR And _
            CvtHiByte(WSAD.wversion) < WS_VERSION_MINOR) Then
            SysPing = WS32_NOT_SUPPORTED
            ECHO.status = WS32_NOT_SUPPORTED
            WSACleanup
            Exit Function
        End If
        If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
            SysPing = WS32_NOT_ENOUGH_SOCKETS
            ECHO.status = WS32_NOT_ENOUGH_SOCKETS
            WSACleanup
            Exit Function
        End If
        hPort = IcmpCreateFile()
        rVal = IcmpSendEcho(hPort, dwAddr, eString, Len(eString), 0, ECHO, Len(ECHO), PING_TIMEOUT)
        If rVal = 1 Then
            SysPing = IP_SUCCESS
        Else
            If ECHO.status = 0 Then ECHO.status = IP_DEST_NET_UNREACHABLE
            SysPing = ECHO.status * -1
        End If
        IcmpCloseHandle hPort
        WSACleanup
    End Function
    Private Function CvtIPAddrClng(ByVal tmp As String) As Long
        Dim iVal As Integer
        Dim IpWord(4) As String
        CvtIPAddrClng = 0: iVal = 0
        While InStr(tmp, ".") > 0
            iVal = iVal + 1
            IpWord(iVal) = Mid(tmp, 1, InStr(tmp, ".") - 1)
            tmp = Mid(tmp, InStr(tmp, ".") + 1)
        Wend
        iVal = iVal + 1
        IpWord(iVal) = tmp
        If iVal <> 4 Then Exit Function
        CvtIPAddrClng = Val("&H" & Right("00" & Hex(IpWord(4)), 2) & _
            Right("00" & Hex(IpWord(3)), 2) & Right("00" & Hex(IpWord(2)), 2) & _
            Right("00" & Hex(IpWord(1)), 2))
    End Function
0
 
LVL 5

Expert Comment

by:aminerd
ID: 2656731
You could also have each computer on the network running a small app that broadcasts a message to the other hosts notifying them of it's IP address. I have a sample if you want to see it.
0
 
LVL 3

Expert Comment

by:wpsjr1
ID: 2657016
You might want to check the VBAdmin page for more network code.  Check under WindowsNT - Resource

http://www.netfokus.dk/vbadmincode/
0
 

Author Comment

by:anasexpert
ID: 2658055
Notice That VB6 under win98
0
 
LVL 14

Expert Comment

by:mcrider
ID: 2658314
My comment will work on VB6/Win98...
0
 

Author Comment

by:anasexpert
ID: 2660352
Dear mcride
i have complier error  invalid outside procedure ((rVal = WSAStartup(WS_VERSION_REQD, WSAD)
        If rVal <> 0 Then
            GetHostInfo.hStatus = WS32_NOT_RESPONDING
            Exit Function
        End If))
0
 

Author Comment

by:anasexpert
ID: 2660467
mcride

i have problem  when i run module system
crash
0
 

Expert Comment

by:JimmieToo
ID: 2661648
mcride:

Works fine on my LAN: VB6 sp3, WIN98, Novell sys.

Jim
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 14

Expert Comment

by:mcrider
ID: 2661964
It works perfectly on my systems... NT4.0/Win98/Win95...  Copy the code again and paste it into a MODULE...


Cheers!®©
0
 

Author Comment

by:anasexpert
ID: 2663003
mcride:
 I copied code again  and problem stil exist when  I run module ht e project is not responding I run module step step i found not responding at procedure
 named : GetHostInfo
0
 
LVL 14

Expert Comment

by:mcrider
ID: 2664919
I tested the code again on 4 different systems... It works.  However, the way I told you to call it is missing a quote... it should look like this:


    Dim iVal As Long
    For iVal = 0 To 255
        If IsHostAlive("207.19.203." + CStr(iVal)) = True Then
            Debug.Print "207.19.203." + CStr(iVal) + " Is Alive"
        End If
    Next iVal


Remember to replace "207.19.203." above with the first 3 octets of you IP address...


Cheers!®©
0
 

Author Comment

by:anasexpert
ID: 2695650
mcride:
 I copied code again  and problem stil exist when  I run module ,project is not responding, I run module step step i found not responding at procedure
 named : GetHostInfo .
When i called GetHostInfo  project not responding

0
 
LVL 14

Expert Comment

by:mcrider
ID: 2696361
Do you have VB Service Pack 3 installed? If not, you really should.  There are several fixes to winsock in it...

This code *Does* work...  It has been accepted as the answer in similar questions.


Cheers!®©
0
 
LVL 5

Expert Comment

by:aminerd
ID: 2700472
Are you using an incorrect IP address? Make sure you are not using the IP Address for your PPP adapter, this would be going out to the internet and not the local network.
0
 

Author Comment

by:anasexpert
ID: 2703650
thanks for all spec. mcrider
at least how can I remotehost name

 I will accept your anwser
0
 
LVL 14

Accepted Solution

by:
mcrider earned 70 total points
ID: 2703683
Posting for points... ;-)


Cheers!®©
0
 
LVL 14

Expert Comment

by:mcrider
ID: 2711351
Thanks for the points! Glad I could help!


Cheers!®©
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

747 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

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now