Results 1 to 36 of 36

Thread: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

  1. #1

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Resolved [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    I'm using CreateObject("Microsoft.XMLHTTP") to create an object to do a "GET" on a device (CURB monitor) that's on my LAN.

    I'm not necessarily sure I know what its IP address is (as my router possibly re-assigns it when things get restarted). That's not the problem though, as I just do a loop, and query all the possible IP addresses. Here's the code I'm using to do that:

    Code:
    
    
    Private Function bFoundCurbIp(sCurbSerial As String, _
                                  Optional sHtmlOut As String, _
                                  Optional sTheIpOut As String, _
                                  Optional sIpEndOut As String) As Boolean
        ' Returns TRUE if successful.
        ' sTheIpOut is the returned IP.
        '
        ' Get the last IP used.
        Static sPrevIp As String                                                    ' Example: "http://192.168.1.84:80"
        If sPrevIp = vbNullString Then sPrevIp = "http://192.168.1.57:80"           ' If accurately set, it speeds this up.
        moXmlHttp.Open "GET", sPrevIp, True
        On Error Resume Next
            moXmlHttp.Send
            Sleep 2000&
            sHtmlOut = vbNullString
            DoEvents
            sHtmlOut = moXmlHttp.responseText
        On Error GoTo 0
        If bHtmlIsCurb(sHtmlOut, sCurbSerial) Then
            bFoundCurbIp = True
            sTheIpOut = sPrevIp
            Dim sa() As String
            sa = Split(sPrevIp, ".")
            sIpEndOut = sa(3&)
            sa = Split(sIpEndOut, ":")
            sIpEndOut = sa(0&)
            Exit Function
        End If
        '
        ' sPrevIp wasn't it, so search.
        Dim i As Long
        For i = 3& To 253&
            'Debug.Print i
            sPrevIp = "http://192.168.1." & CStr(i) & ":80"
            moXmlHttp.Open "GET", sPrevIp, True
            On Error Resume Next
                moXmlHttp.Send
                Sleep 800&
                sHtmlOut = vbNullString
                DoEvents
                sHtmlOut = moXmlHttp.responseText
            On Error GoTo 0
            If bHtmlIsCurb(sHtmlOut, sCurbSerial) Then
                bFoundCurbIp = True
                sTheIpOut = sPrevIp
                sIpEndOut = CStr(i)
                Exit Function
            End If
        Next
        '
        ' Not found, so we fall out leaving the return as FALSE.
        sHtmlOut = vbNullString
    End Function
    
    
    If I've found it, the HTML text is something I can deal with.

    However, here's my problem, actually possibly two problems.

    First, I'm not sure why, but that CURB monitor doesn't return HTML code every single time you query it. So, my program is falling into that loop more than just the first time it executes. It's not often, but it's often enough to create the second problem.

    Whenever I fall into that loop (searching for the correct IP), I hit another device on my LAN that prompts for a User Name and Password. I typically just cancel that pop-up, but I don't want it at all.

    Any ideas would be greatly appreciated.
    Last edited by Elroy; Jul 11th, 2024 at 02:20 PM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  2. #2
    Frenzied Member VanGoghGaming's Avatar
    Join Date
    Jan 2020
    Location
    Eve Online - Mining, Missions & Market Trading!
    Posts
    1,761

    Question Re: Microsoft.XMLHTTP and searching for an IP

    Have you tried connecting to it by name rather than IP? Usually all devices have a name as well and you should see them in the connected devices list from your router's control panel.

  3. #3

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: Microsoft.XMLHTTP and searching for an IP

    Quote Originally Posted by VanGoghGaming View Post
    Have you tried connecting to it by name rather than IP? Usually all devices have a name as well and you should see them in the connected devices list from your router's control panel.
    Well, Advanced IP Scanner just reports the name as the IP. It does have a manufacturer's name, but I'm not sure I could use that to address it like a DNS name.

    That's it, the highlighted one:

    Name:  CurbIP.jpg
Views: 149
Size:  27.8 KB
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  4. #4
    Frenzied Member VanGoghGaming's Avatar
    Join Date
    Jan 2020
    Location
    Eve Online - Mining, Missions & Market Trading!
    Posts
    1,761

    Re: Microsoft.XMLHTTP and searching for an IP

    When I log into my router's control panel at 192.168.1.1 I can see all connected devices like Desktop PC, phone, tablet, laptop, etc. They all have a friendly name as well as an IP address. The router should be able to accept the friendly name in lieu of the IP address for a connection request.

  5. #5
    PowerPoster jdc2000's Avatar
    Join Date
    Oct 2001
    Location
    Idaho Falls, Idaho USA
    Posts
    2,424

    Re: Microsoft.XMLHTTP and searching for an IP

    You could just assign it a fixed IP address to eliminate that issue.

  6. #6
    PowerPoster jdc2000's Avatar
    Join Date
    Oct 2001
    Location
    Idaho Falls, Idaho USA
    Posts
    2,424

    Re: Microsoft.XMLHTTP and searching for an IP

    You could just assign it a fixed IP address to eliminate that issue.

  7. #7

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: Microsoft.XMLHTTP and searching for an IP

    Quote Originally Posted by VanGoghGaming View Post
    When I log into my router's control panel at 192.168.1.1 I can see all connected devices like Desktop PC, phone, tablet, laptop, etc. They all have a friendly name as well as an IP address. The router should be able to accept the friendly name in lieu of the IP address for a connection request.
    Well, that's a good idea, but I'm on Starlink. I don't know if you have any familiarity with those routers, but their "management" page is extremely terse. They don't even allow things like port forwarding or anything fancy. In fact, there are really only two setting/option when you go there: 1) Park the satellite dish, 2) Reboot the router. And that's it. Nothing like a typical router from Linksys or Netgear.

    Quote Originally Posted by jdc2000 View Post
    You could just assign it a fixed IP address to eliminate that issue.
    Well, I'm not sure I can do that, as it has no "management" page and extremely little documentation. And also, everything else on my LAN has dynamically assigned IPs, so I hate to start mixing. If I could figure out how, I could assign it a high IP (192.168.1.253) and it'd probably be safe, but I'd really rather figure out another answer.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  8. #8

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: Microsoft.XMLHTTP and searching for an IP

    Ok, I fixed it. I just leaned on the ARP command to get the MAC address for the IPs, until I found the MAC address for my Curb device.

    Code:
    
    
    Private Function sCurbHtml(sCurbMacAddress As String) As String
        ' Returns the HTML string.
        '
        ' Find the CURB device.
        Static sCurbIp As String
        If sCurbIp = vbNullString Then
            Dim i As Long
            Set moShell = CreateObject("WScript.Shell")
            For i = 3& To 253&
                sCurbIp = "192.168.1." & CStr(i)
                If sMacAddress(sCurbIp) = sCurbMacAddress Then Exit For
            Next
            Set moShell = Nothing
            If i > 253& Then
                sCurbIp = vbNullString
                Exit Function           ' Not found.
            End If
        End If
        '
        ' We found the CURB device, so "GET" its HTML.
        moXmlHttp.Open "GET", "http://" & sCurbIp & ":80", True
        On Error Resume Next
            moXmlHttp.Send
            Sleep 2000&
            Dim sHtml As String
            DoEvents
            sHtml = moXmlHttp.responseText
            Dim iErr As Long
            iErr = Err.Number
        On Error GoTo 0
        If iErr Then
            Exit Function           ' CURB device didn't reply.
        End If
        '
        ' Return HTML results.
        sCurbHtml = sHtml
    End Function
    
    Private Function sMacAddress(sIpAddress As String) As String
        ' moShell must be instantiated before calling this.
        '
        Dim sMac As String
        sMac = moShell.Exec("arp -a " & sIpAddress).StdOut.ReadAll()
        '
        ' Get fourth line, if we can.
        Dim sa() As String
        sa = Split(sMac, vbCrLf)
        If UBound(sa) < 3& Then Exit Function
        sMac = sa(3&)
        If sMac = vbNullString Then Exit Function
        '
        ' Clean it up.
        Do While InStr(sMac, "  ")
            sMac = Replace$(sMac, "  ", " ")
        Loop
        sMac = Trim$(sMac)          ' Trim it.
        '
        ' Now, space delimited, it'll be the second item.
        sMacAddress = Split(sMac, " ")(1&)
    End Function
    
    
    I'm not 100% happy with it, as it flashed command windows on the screen while it's looping. But it does work, so I'll call it resolved.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  9. #9

  10. #10
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,608

    Re: Microsoft.XMLHTTP and searching for an IP

    Quote Originally Posted by Elroy View Post
    Well, I'm not sure I can do that, as it has no "management" page and extremely little documentation. And also, everything else on my LAN has dynamically assigned IPs, so I hate to start mixing. If I could figure out how, I could assign it a high IP (192.168.1.253) and it'd probably be safe, but I'd really rather figure out another answer.
    If i understood everything correctly, Starlink-Routers run on Linux (via an SD-Card?), so there is a DHCP-server running in the background.

    SSH into it directly, look for the conf-file and set up static address-pool and everything else.....

    But it's just a guess
    Last edited by Zvoni; Tomorrow at 31:69 PM.
    ----------------------------------------------------------------------------------------

    One System to rule them all, One Code to find them,
    One IDE to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    Code is like a joke: If you have to explain it, it's bad

  11. #11

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: Microsoft.XMLHTTP and searching for an IP

    Quote Originally Posted by wqweto View Post
    Ask ChatGPT to rewrite arp -a ip using API calls only.
    Ok, that's a great idea because, the way I've got it, it's flashing terminal screens on my desktop for each IP that's checked. If I could get rid of that, it'd be perfect.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  12. #12
    PowerPoster
    Join Date
    Nov 2017
    Posts
    3,282

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    This was from a larger "network management" related project I wrote many years ago. Most of the code was pulled from public sources at the time. It returns a mac address from a given IP address.

    Code:
    Private Declare Function inet_addr Lib "wsock32.dll" _
      (ByVal s As String) As Long
    
    Private Declare Function SendARP Lib "iphlpapi.dll" _
      (ByVal DestIP As Long, _
       ByVal SrcIP As Long, _
       ByVal pMacAddr As Long, _
       ByVal PhyAddrLen As Long) As Long
    
    Private Declare Sub CopyMemory Lib "kernel32" _
       Alias "RtlMoveMemory" _
      (dst As Any, _
       src As Any, _
       ByVal bcount As Long)
       
    
    Private Function GetRemoteMACAddress(ByVal sRemoteIP As String) As String
       
      Dim tmp As String
          
      Dim lngipvalue As Long
      Dim pulMac(6)  As Byte
      Dim ulLen As Long
      Dim hr As Long
      Dim i As Integer
    
      'convert the string IP into
      'an unsigned long value containing
      'a suitable binary representation
      'of the Internet address given
      lngipvalue = inet_addr(sRemoteIP)
       
      If lngipvalue <> 0 Then
       
       
        'retrive the remote MAC address
          
        ulLen = 6
        hr = SendARP(lngipvalue, 0, VarPtr(pulMac(0)), VarPtr(ulLen))
    
        For i = 0 To 5
          If pulMac(i) = 0 And i = 0 Then
            tmp = "00-"
          ElseIf Len(Hex$(pulMac(i))) = 1 Then
            tmp = tmp & "0" & Hex$(pulMac(i)) & "-"
          Else
            tmp = tmp & Hex$(pulMac(i)) & "-"
          End If
        Next i
          
        'remove the trailing dash
        'added above and return
        GetRemoteMACAddress = Left$(tmp, Len(tmp) - 1)
             
        'Exit Function
      
      Else
       
        GetRemoteMACAddress = "(inet_addr call failed)"
       
      End If  'dwRemoteIP <> 0
       
    End Function

  13. #13

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    haha, I've been working on precisely that.

    Here's my version:

    Code:
    
    Option Explicit
    
    Private Type MacAddress
        bb1 As Byte
        bb2 As Byte
        bb3 As Byte
        bb4 As Byte
        bb5 As Byte
        bb6 As Byte
        unused As Integer
    End Type
    
    Private Declare Function SendARP Lib "iphlpapi.dll" (ByVal DestIP As Long, ByVal SrcIP As Long, ByRef pMacAddr As MacAddress, ByRef PhyAddrLen As Long) As Long
    Private Declare Sub GetMem1 Lib "msvbvm60.dll" (ByRef Source As Any, ByRef Dest As Any)
    
    Private Sub Form_Load()
        Debug.Print MacAddressForIp("192.168.1.57")
    End Sub
    
    Private Function MacAddressForIp(IpV4Address As String) As String
        '
        ' Make the IP a Long.
        Dim sa() As String
        sa = Split(IpV4Address, ".")
        Dim lngIPAddr As Long
        GetMem1 CByte(sa(0)), ByVal VarPtr(lngIPAddr) + 0&
        GetMem1 CByte(sa(1)), ByVal VarPtr(lngIPAddr) + 1&
        GetMem1 CByte(sa(2)), ByVal VarPtr(lngIPAddr) + 2&
        GetMem1 CByte(sa(3)), ByVal VarPtr(lngIPAddr) + 3&
        '
        ' Attempt to get the MAC address.  Return vbNullString if not found.
        Dim uMacAddr As MacAddress
        If SendARP(lngIPAddr, 0&, uMacAddr, LenB(uMacAddr)) = 0& Then
            With uMacAddr
                MacAddressForIp = Right$("0" & Hex$(.bb1), 2&) & ":" & _
                                  Right$("0" & Hex$(.bb2), 2&) & ":" & _
                                  Right$("0" & Hex$(.bb3), 2&) & ":" & _
                                  Right$("0" & Hex$(.bb4), 2&) & ":" & _
                                  Right$("0" & Hex$(.bb5), 2&) & ":" & _
                                  Right$("0" & Hex$(.bb6), 2&)
            End With
        End If
    End Function
    
    
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  14. #14

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    Well crud!

    Each call to SendARP takes about 6 seconds to execute on my computer!

    To check it for ~250 IPs, that amounts to a 25 minute delay!!!

    There's got to be some way to expedite this process, as Advanced IP Scanner doesn't take anywhere near that long to execute. In fact, it does a complete scan of my LAN in about 30 seconds. 30 seconds would be much more reasonable than 25 minutes.

    Also, using the "WScript.Shell" doesn't take anywhere near that long, but I believe it's running asynchronously, so that's how it's doing it faster. Geez, do I need to setup multithreading to get this done?

    Any ideas?
    Last edited by Elroy; Jul 10th, 2024 at 08:38 AM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  15. #15
    Frenzied Member VanGoghGaming's Avatar
    Join Date
    Jan 2020
    Location
    Eve Online - Mining, Missions & Market Trading!
    Posts
    1,761

    Talking Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    This will display all IPs together with their corresponding type and MAC address.

    Code:
    Private Const MAXLEN_PHYSADDR As Long = 8, ERROR_SUCCESS As Long = 0
    
    Private Type MIB_IPNETROW
        dwIndex As Long
        dwPhysAddrLen As Long
        bPhysAddr(0 To MAXLEN_PHYSADDR - 1) As Byte
        dwAddr As Long
        dwType As Long
    End Type
    
    Private Type MIB_IPNETTABLE
        dwNumEntries As Long
        Table(0 To 255) As MIB_IPNETROW
    End Type
    
    Private Type IPv4
        Byte1 As Byte
        Byte2 As Byte
        Byte3 As Byte
        Byte4 As Byte
    End Type
    
    Private Declare Function GetIpNetTable Lib "iphlpapi" (ByVal IpNetTable As Long, SizePointer As Long, ByVal Order As Byte) As Long
    Private Declare Sub PutMem4 Lib "msvbvm60" Alias "#307" (Ptr As Any, ByVal NewVal As Long)
    
    Private Function GetIP(dwAddr As Long) As String
    Dim tIPv4 As IPv4
        PutMem4 ByVal VarPtr(tIPv4), dwAddr
        With tIPv4: GetIP = Join(Array(.Byte1, .Byte2, .Byte3, .Byte4), "."): End With
    End Function
    
    Private Function GetMacAddress(baMAC() As Byte, dwPhysAddrLen As Long) As String
    Dim i As Long
        For i = 0 To dwPhysAddrLen - 1
            GetMacAddress = GetMacAddress & Right$("0" & Hex$(baMAC(i)), 2) & IIf(i < dwPhysAddrLen - 1, ":", vbNullString)
        Next i
    End Function
    
    Public Sub Main()
    Dim lSizePointer As Long, tMIB_IPNETROW As MIB_IPNETROW, tMIB_IPNETTABLE As MIB_IPNETTABLE, i As Long
        GetIpNetTable 0, lSizePointer, 1
        If GetIpNetTable(VarPtr(tMIB_IPNETTABLE), lSizePointer, 1) = ERROR_SUCCESS  Then
            For i = LBound(tMIB_IPNETTABLE.Table) To UBound(tMIB_IPNETTABLE.Table)
                With tMIB_IPNETTABLE.Table(i)
                    If .dwPhysAddrLen Then
                        Debug.Print GetIP(.dwAddr), GetMacAddress(.bPhysAddr, .dwPhysAddrLen), Choose(.dwType, "Other", "INVALID", "DYNAMIC", "STATIC")
                    End If
                End With
            Next i
        End If
    End Sub
    All that remains is to sift through them and pull the IP that corresponds to your desired MAC address!

  16. #16

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    Ok, I was already working on the GetIpNetTable approach. I believe I've got it.

    Here's the gist of the way I managed to get it going:

    Code:
    
    
    Private Function sCurbHtml(sCurbMacAddress As String) As String
        ' Returns the HTML string.
        '
        ' Find the CURB device.
        Static sCurbIp As String
        If sCurbIp = vbNullString Then
            Dim IpNetTable As MIB_IPNETTABLE
            Dim iRet As Long
            iRet = GetIpNetTable(IpNetTable, LenB(IpNetTable), 0&)
            If iRet Then
                MsgBox "Couldn't get the IP Net Table!", vbCritical
                End
            End If
            Dim i As Long
            For i = 0& To IpNetTable.dwNumEntries - 1&
                If sMacAddrToString(IpNetTable.table(i).bPhysAddr) = sCurbMacAddress Then
                    sCurbIp = sLongToIp(IpNetTable.table(i).dwAddr)
                    Exit For
                End If
            Next
            If i = IpNetTable.dwNumEntries Then
                MsgBox "Couldn't find CURB's MAC address!", vbCritical
                End
            End If
        End If
        '
        ' We found the CURB device, so "GET" its HTML.
        moXmlHttp.Open "GET", "http://" & sCurbIp & ":80", True
        On Error Resume Next
            moXmlHttp.Send
            Sleep 2000&
            Dim sHtml As String
            DoEvents
            sHtml = moXmlHttp.responseText
            Dim iErr As Long
            iErr = Err.Number
        On Error GoTo 0
        If iErr Then
            Exit Function           ' CURB device didn't reply.
        End If
        '
        ' Return HTML results.
        sCurbHtml = sHtml
    End Function
    
    Private Function sMacAddrToString(bbMacAddr() As Byte) As String
        sMacAddrToString = Right$("0" & Hex$(bbMacAddr(0)), 2) & "-" & _
                           Right$("0" & Hex$(bbMacAddr(1)), 2) & "-" & _
                           Right$("0" & Hex$(bbMacAddr(2)), 2) & "-" & _
                           Right$("0" & Hex$(bbMacAddr(3)), 2) & "-" & _
                           Right$("0" & Hex$(bbMacAddr(4)), 2) & "-" & _
                           Right$("0" & Hex$(bbMacAddr(5)), 2)
    End Function
    
    Private Function sLongToIp(ByVal dwIP As Long) As String
        sLongToIp = Format$(dwIP And &HFF&) & "." & _
                    Format$((dwIP And &HFF00&) \ &H100&) & "." & _
                    Format$((dwIP And &HFF0000) \ &H10000) & "."
        Dim bb As Byte
        GetMem1 ByVal VarPtr(dwIP) + 3&, bb
        sLongToIp = sLongToIp & Format$(bb)
    End Function
    
    
    And here's a bit of the module header stuff to make that work:

    Code:
    
    Private Type MIB_IPNETROW
        dwIndex As Long
        dwPhysAddrLen As Long
        bPhysAddr(5&) As Byte
        dwAddr As Long
        dwType As Long
    End Type
    Private Type MIB_IPNETTABLE
        dwNumEntries As Long
        table(1023&) As MIB_IPNETROW
    End Type
    '
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function GetIpNetTable Lib "iphlpapi.dll" (ByRef pIpNetTable As Any, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
    Private Declare Sub GetMem1 Lib "msvbvm60.dll" (ByRef Source As Any, ByRef Dest As Any)
    
    
    @VanGogh: That "Table(0 To 255) As MIB_IPNETROW" is a little risky, as my IpNetTable.dwNumEntries returns 273. It returns some stuff outside of the 192.168.1.### range. Not sure what that is, but it's in the table. That's why I went with 1024 table entries.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  17. #17

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    Just for grins, for those interested, I've got 32 solar panels at my place, and this CURB device completely monitors my power production and consumption. It's got 18 CT amperage clamps (of which I use most of them). Two of those are production, and the other 16 are scattered consumption.

    But, I wanted it more consolidated than 18 raw numbers, so I wrote this program.

    Here's an example of what it currently looks like:

    Name:  Curb_Monitoring.png
Views: 85
Size:  25.0 KB

    Next, I need to put it on a computer that always runs, and dump some continuous usage data and see how I'm doing. Around noon on a sunny day, that "Production" number can approach about 7,500 watts, which more than covers the house and one of the HVAC units. My HVAC units are two "package" 5 ton units (all duct work in the crawlspace).

    That 17.6 watts on HVAC#2 is apparently what it uses to run its circuit boards, as the unit wasn't running when I took that screenshot.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  18. #18
    Frenzied Member VanGoghGaming's Avatar
    Join Date
    Jan 2020
    Location
    Eve Online - Mining, Missions & Market Trading!
    Posts
    1,761

    Talking Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    Yeah, you have a lot more IPs in the table than I have, haha! The "GetIpNetTable" function does return how much memory it needs to be allocated although for some reason it seems much more than actually required. This version allocates a byte array of the requested size and then overlaps an array of "MIB_IPNETROW" on top of it so it can address it directly:

    Code:
    Option Explicit
    
    Private Const MAXLEN_PHYSADDR As Long = 8, ERROR_SUCCESS As Long = 0
    
    Private Type MIB_IPNETROW
        dwIndex As Long
        dwPhysAddrLen As Long
        bPhysAddr(0 To MAXLEN_PHYSADDR - 1) As Byte
        dwAddr As Long
        dwType As Long
    End Type
    
    Private Type IPv4
        Byte1 As Byte
        Byte2 As Byte
        Byte3 As Byte
        Byte4 As Byte
    End Type
    
    Private Type tSafeArray
        cDims As Integer
        fFeatures As Integer
        cbElements As Long
        cLocks As Long
        pvData As Long
        cElements1 As Long
        lLBound1 As Long
        cElements2 As Long
        lLBound2 As Long
    End Type
    
    Private Declare Function GetIpNetTable Lib "iphlpapi" (ByVal IpNetTable As Long, SizePointer As Long, ByVal Order As Byte) As Long
    Private Declare Function ArrPtrUDT Lib "msvbvm60" Alias "#644" (Arr() As Any) As Long
    Private Declare Sub GetMem4 Lib "msvbvm60" Alias "#301" (Ptr As Any, RetVal As Long)
    Private Declare Sub PutMem4 Lib "msvbvm60" Alias "#307" (Ptr As Any, ByVal NewVal As Long)
    
    Private Function GetIP(dwAddr As Long) As String
    Dim tIPv4 As IPv4
        PutMem4 ByVal VarPtr(tIPv4), dwAddr
        With tIPv4: GetIP = Join(Array(.Byte1, .Byte2, .Byte3, .Byte4), "."): End With
    End Function
    
    Private Function GetMacAddress(baMAC() As Byte, dwPhysAddrLen As Long) As String
    Dim i As Long
        For i = 0 To dwPhysAddrLen - 1
            GetMacAddress = GetMacAddress & Right$("0" & Hex$(baMAC(i)), 2) & IIf(i < dwPhysAddrLen - 1, ":", vbNullString)
        Next i
    End Function
    
    Private Sub InitSA(SafeArray As tSafeArray, pSA As Long, cbElements As Long, Optional pvData As Long, Optional cElements1 As Long = 1, Optional cElements2 As Long, Optional lLBound1 As Long, Optional lLBound2 As Long)
        With SafeArray
            If .fFeatures = 0 Then PutMem4 ByVal pSA, VarPtr(SafeArray): .fFeatures = &H11: .cLocks = 1: If cElements2 = 0 Then .cDims = 1 Else .cDims = 2 ' FADF_AUTO As Long = &H1, FADF_FIXEDSIZE As Long = &H10
            .pvData = pvData: .cbElements = cbElements: .cElements1 = cElements1: .cElements2 = cElements2: .lLBound1 = lLBound1: .lLBound2 = lLBound2
        End With
    End Sub
    
    Public Sub Main()
    Dim lSizePointer As Long, tSA As tSafeArray, arrMIB_IPNETROW() As MIB_IPNETROW, tMIB_IPNETROW As MIB_IPNETROW, dwNumEntries As Long, baData() As Byte, i As Long, dictIPs As New Dictionary, sMAC As String
        GetIpNetTable 0, lSizePointer, 1: ReDim baData(0 To lSizePointer - 1)
        If GetIpNetTable(VarPtr(baData(0)), lSizePointer, 1) = 0 Then
            GetMem4 baData(0), dwNumEntries
            InitSA tSA, ArrPtrUDT(arrMIB_IPNETROW), LenB(tMIB_IPNETROW), VarPtr(baData(4)), dwNumEntries
            For i = LBound(arrMIB_IPNETROW) To UBound(arrMIB_IPNETROW)
                With arrMIB_IPNETROW(i)
                    If .dwPhysAddrLen Then
                        sMAC = GetMacAddress(.bPhysAddr, .dwPhysAddrLen)
                        If Not dictIPs.Exists(sMAC) Then dictIPs.Add sMAC, GetIP(.dwAddr)
                    End If
                End With
            Next i
        End If
        Debug.Print dictIPs("YourCurbMAC")
    End Sub
    All MAC addresses are added to a "Dictionary" so that you can easily pull the desired IP address.

    Something fishy is still going on though. You can see that the function reports "dwNumEntries" in the table but if you multiply "dwNumEntries * LenB(tMIB_IPNETROW)", the result is much smaller than the initial memory requested ("lSizePointer").

  19. #19

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    I like seeing this, selling power back to the grid:

    Name:  Curb2.png
Views: 80
Size:  24.3 KB
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  20. #20

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    Well crud, I'm still not done.

    Apparently the IP Net Table returned by GetIpNetTable is only populated after the computer calling it has actually interfaced with the various IP addresses. If I call it immediately after a reboot, it has very few entries in it.

    However, if I call it after I run an Advanced IP Scanner (the little utility I have to "see" the IP addresses on my LAN), then it's fully populated.

    So, I'm still at the drawing table.

    I suppose, since this is relatively custom, I could shell to Advanced IP Scanner, executing it, before I call GetIpNetTable.

    However, before I program that kludge, I'll see if y'all have any better ideas. Obviously, Advanced IP Scanner is doing precisely what I want, so it can certainly be done.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  21. #21
    PowerPoster
    Join Date
    Nov 2017
    Posts
    3,282

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    Quote Originally Posted by Elroy View Post
    Well crud, I'm still not done.

    Apparently the IP Net Table returned by GetIpNetTable is only populated after the computer calling it has actually interfaced with the various IP addresses. If I call it immediately after a reboot, it has very few entries in it.

    However, if I call it after I run an Advanced IP Scanner (the little utility I have to "see" the IP addresses on my LAN), then it's fully populated.

    So, I'm still at the drawing table.

    I suppose, since this is relatively custom, I could shell to Advanced IP Scanner, executing it, before I call GetIpNetTable.

    However, before I program that kludge, I'll see if y'all have any better ideas. Obviously, Advanced IP Scanner is doing precisely what I want, so it can certainly be done.
    Yes, good point. Your computer won't have the remote device in its local arp table unless and until you make a connection to it. The snippet of code I posted earlier for getting the MAC address was part of a routine that would first ping an IP via API calls and then check the arp table for the mac address only if the ping was successful.

    I will post the methods I used for the ping. I'm sure it has plenty of warts.

  22. #22
    PowerPoster
    Join Date
    Nov 2017
    Posts
    3,282

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    Module code for ping capability, and some other network api's.

    Code:
    Option Explicit
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Copyright ©1996-2001 VBnet, Randy Birch, All Rights Reserved.
    ' Some pages may also contain other copyrights by the author.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' You are free to use this code within your own applications,
    ' but you are expressly forbidden from selling or otherwise
    ' distributing this source code without prior written consent.
    ' This includes both posting free demo projects made from this
    ' code as well as reproducing the code in text or html format.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    Private Const IP_SUCCESS As Long = 0
    Private Const IP_STATUS_BASE As Long = 11000
    Private Const IP_BUF_TOO_SMALL As Long = (11000 + 1)
    Private Const IP_DEST_NET_UNREACHABLE As Long = (11000 + 2)
    Private Const IP_DEST_HOST_UNREACHABLE As Long = (11000 + 3)
    Private Const IP_DEST_PROT_UNREACHABLE As Long = (11000 + 4)
    Private Const IP_DEST_PORT_UNREACHABLE As Long = (11000 + 5)
    Private Const IP_NO_RESOURCES As Long = (11000 + 6)
    Private Const IP_BAD_OPTION As Long = (11000 + 7)
    Private Const IP_HW_ERROR As Long = (11000 + 8)
    Private Const IP_PACKET_TOO_BIG As Long = (11000 + 9)
    Private Const IP_REQ_TIMED_OUT As Long = (11000 + 10)
    Private Const IP_BAD_REQ As Long = (11000 + 11)
    Private Const IP_BAD_ROUTE As Long = (11000 + 12)
    Private Const IP_TTL_EXPIRED_TRANSIT As Long = (11000 + 13)
    Private Const IP_TTL_EXPIRED_REASSEM As Long = (11000 + 14)
    Private Const IP_PARAM_PROBLEM As Long = (11000 + 15)
    Private Const IP_SOURCE_QUENCH As Long = (11000 + 16)
    Private Const IP_OPTION_TOO_BIG As Long = (11000 + 17)
    Private Const IP_BAD_DESTINATION As Long = (11000 + 18)
    Private Const IP_ADDR_DELETED As Long = (11000 + 19)
    Private Const IP_SPEC_MTU_CHANGE As Long = (11000 + 20)
    Private Const IP_MTU_CHANGE As Long = (11000 + 21)
    Private Const IP_UNLOAD As Long = (11000 + 22)
    Private Const IP_ADDR_ADDED As Long = (11000 + 23)
    Private Const IP_GENERAL_FAILURE As Long = (11000 + 50)
    Private Const MAX_IP_STATUS As Long = (11000 + 50)
    Private Const IP_PENDING As Long = (11000 + 255)
    Private Const PING_TIMEOUT As Long = 500
    Private Const WS_VERSION_REQD As Long = &H101
    Private Const MIN_SOCKETS_REQD As Long = 1
    Private Const SOCKET_ERROR As Long = -1
    Private Const INADDR_NONE As Long = &HFFFFFFFF
    Private Const MAX_WSADescription As Long = 256
    Private Const MAX_WSASYSStatus As Long = 128
    
    Private Const WSADescription_Len = 256
    Private Const WSASYS_Status_Len = 128
    Private Const AF_INET = 2
    
    
    Private Type ICMP_OPTIONS
        Ttl             As Byte
        Tos             As Byte
        Flags           As Byte
        OptionsSize     As Byte
        OptionsData     As Long
    End Type
    
    Public Type ICMP_ECHO_REPLY
        Address         As Long
        status          As Long
        RoundTripTime   As Long
        DataSize        As Long 'formerly 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 Long
       wMaxUDPDG As Long
       dwVendorInfo 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 Long, _
        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 Function gethostbyaddr Lib "wsock32.dll" _
      (haddr As Long, _
       ByVal hnlen As Long, _
       ByVal addrtype As Long) As Long
    
    Private Declare Sub CopyMemory Lib "kernel32" _
       Alias "RtlMoveMemory" _
      (xDest As Any, _
       xSource As Any, _
       ByVal nbytes As Long)
       
    Private Declare Function inet_addr Lib "wsock32.dll" _
       (ByVal s As String) As Long
       
    Private Declare Function lstrlen Lib "kernel32" _
       Alias "lstrlenA" _
       (lpString As Any) As Long
      
       
       
       
        
    
    Public Function GetStatusCode(status As Long) As String
    
       Dim msg As String
       
       Select Case status
          Case IP_SUCCESS:               msg = "REPLY"
          Case INADDR_NONE:              msg = "inet_addr: bad IP format"
          Case IP_BUF_TOO_SMALL:         msg = "ip buf too_small"
          Case IP_DEST_NET_UNREACHABLE:  msg = "ip dest net unreachable"
          Case IP_DEST_HOST_UNREACHABLE: msg = "ip dest host unreachable"
          Case IP_DEST_PROT_UNREACHABLE: msg = "ip dest prot unreachable"
          Case IP_DEST_PORT_UNREACHABLE: msg = "ip dest port unreachable"
          Case IP_NO_RESOURCES:          msg = "ip no resources"
          Case IP_BAD_OPTION:            msg = "ip bad option"
          Case IP_HW_ERROR:              msg = "ip hw_error"
          Case IP_PACKET_TOO_BIG:        msg = "ip packet too_big"
          Case IP_REQ_TIMED_OUT:         msg = "NO REPLY"
          Case IP_BAD_REQ:               msg = "ip bad req"
          Case IP_BAD_ROUTE:             msg = "ip 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 addr 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 addr 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  msg returned"
       End Select
       
       GetStatusCode = CStr(status) & "   [ " & msg & " ]"
       
    End Function
    
    
    
    Public Function Ping(sAddress As String, _
          sDataToSend As String, _
          ECHO As ICMP_ECHO_REPLY) As Long
    
      'If Ping succeeds :
      '.RoundTripTime = 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
      '.Status will be 0
      '
      'If Ping fails .Status will be the error code
       
       Dim hPort As Long
       Dim dwAddress As Long
       
      'convert the address into a long representation
       dwAddress = inet_addr(sAddress)
       
      'if a valid address..
       If dwAddress <> INADDR_NONE Then
       
         'open a port
          hPort = IcmpCreateFile()
          
         'and if successful,
          If hPort Then
          
            'ping it.
             Call IcmpSendEcho(hPort, _
                               dwAddress, _
                               sDataToSend, _
                               Len(sDataToSend), _
                               0, _
                               ECHO, _
                               Len(ECHO), _
                               PING_TIMEOUT)
    
            'return the status as ping succes and close
             Ping = ECHO.status
             Call IcmpCloseHandle(hPort)
          
          End If
          
       Else:
            'the address format was probably invalid
             Ping = INADDR_NONE
             
       End If
      
    End Function
    
    
    Public Function GetHostNameFromIP(ByVal sAddress As String) As String
    
       Dim ptrHosent As Long
       Dim hAddress As Long
       Dim nbytes As Long
       
       If SocketsInitialize() Then
    
         'convert string address to long
          hAddress = inet_addr(sAddress)
          
          If hAddress <> SOCKET_ERROR Then
             
            'obtain a pointer to the HOSTENT structure
            'that contains the name and address
            'corresponding to the given network address.
             ptrHosent = gethostbyaddr(hAddress, 4, AF_INET)
       
             If ptrHosent <> 0 Then
             
               'convert address and
               'get resolved hostname
                CopyMemory ptrHosent, ByVal ptrHosent, 4
                nbytes = lstrlen(ByVal ptrHosent)
             
                If nbytes > 0 Then
                   sAddress = Space$(nbytes)
                   CopyMemory ByVal sAddress, ByVal ptrHosent, nbytes
                   GetHostNameFromIP = sAddress
                End If
             
             Else: 'MsgBox "Call to gethostbyaddr failed."
             End If 'If ptrHosent
          
          'SocketsCleanup
          
          Else: 'MsgBox "String passed is an invalid IP."
          End If 'If hAddress
       
       Else: 'MsgBox "Sockets failed to initialize."
       End If  'If SocketsInitialize
          
    End Function
    
       
    
    Public Sub SocketsCleanup()
       
       If WSACleanup() <> 0 Then
           MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
       End If
        
    End Sub
    
    
    Public Function SocketsInitialize() As Boolean
    
       Dim WSAD As WSADATA
       
       SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
        
    End Function

  23. #23
    PowerPoster
    Join Date
    Nov 2017
    Posts
    3,282

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    Here is the Ping button click method. Note that it contains other stuff, like getting the hostname and computer description as well. I'm just pasting it all as-is.

    Code:
    Private Sub cmdPing_Click()
    
      cmdPing.Enabled = False
      cmdClear.Enabled = False
      cmdExit.Enabled = False
      mnuFile.Enabled = False
      
      lstResult.Clear
      lstHostName.Clear
      lstMacAddress.Clear
      lstComputerDesc.Clear
      
      Dim ECHO As ICMP_ECHO_REPLY
      Dim pos As Long
      Dim success As Long
      Dim tmpHostName As String
      Dim strhost As String
      Dim objWMIService As Object
      Dim colitems As Object
      Dim objItem As Object
        
      If SocketsInitialize() Then
        
        For resp = 0 To lstIPToPing.ListCount - 1
          success = Ping((lstIPToPing.List(resp)), "Ping Echo", ECHO)
          'display the results
          lstResult.AddItem GetStatusCode(success)
            
          If UCase(Mid(lstResult.List(resp), 1, 2)) = "0 " Then
            
            If chkResolveHostName.Value = 1 Then
              tmpHostName = GetHostNameFromIP(lstIPToPing.List(resp))
            Else
              tmpHostName = " "
            End If
            
            If tmpHostName = "" Then
              'Could not resolve host
              lstHostName.AddItem "?????"
            Else
              lstHostName.AddItem tmpHostName
            End If
            
            If chkGetMac.Value = 1 Then
              lstMacAddress.AddItem GetRemoteMACAddress(lstIPToPing.List(resp))
            Else
              lstMacAddress.AddItem " "
            End If
            
              
            If chkGetDesc.Value = 1 Then
              If tmpHostName <> "" And tmpHostName <> " " Then
                On Error Resume Next
                strhost = tmpHostName
                Set objWMIService = GetObject("winmgmts:\\" & strhost & "\root\cimv2")
                Set colitems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem", , 48)
                
                If Err <> 0 Then
                  lstComputerDesc.AddItem "Error obtaining Description"
                  Err = 0
                Else
                  For Each objItem In colitems
                    lstComputerDesc.AddItem objItem.Description
                  Next
                End If
                
              Else
                lstComputerDesc.AddItem " "
              End If
            Else
              lstComputerDesc.AddItem " "
            End If
          
          Else
            lstHostName.AddItem "N/A"
            lstMacAddress.AddItem "N/A"
            lstComputerDesc.AddItem "N/A"
          End If
          
          lstResult.Refresh
          lstHostName.Refresh
          lstMacAddress.Refresh
          lstComputerDesc.Refresh
        
        Next resp
        
        SocketsCleanup
          
      Else
       
        MsgBox "Windows Sockets for 32 bit Windows " & _
               "environments is not successfully responding."
       
      End If
       
      cmdPing.Enabled = True
      cmdClear.Enabled = True
      cmdExit.Enabled = True
      mnuFile.Enabled = True
      txtIPToEnter.SetFocus
      txtIPToEnter.Text = ipHeader
      txtIPToEnter.SelStart = Len(txtIPToEnter.Text)
    
    End Sub

  24. #24

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    Thank you, OptionBase1. I'll take a look at it. This might be the solution ... just ping all the IP usual suspects before I fetch the IP Net Table. I feel like I'm sooo close, but just can't put it to bed.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  25. #25

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    Ok, pinging the IPs worked, but it added about 5 minutes to the time to find the CURB's MAC address. I just pinged about 250 IPs before fetching the IP Net Table.

    Pinging an IP takes about one second. I tried reducing the PING_TIMEOUT, and I also tried using the same handle from IcmpCreateFile for all the pings. But neither of those changes seemed to affect the ping time at all ... still remaining about a second per ping.

    Calls to GetIpNetTable seem to execute quite fast. So maybe I could just ping each IP and then call GetIpNetTable over and over (once for each IP that's pinged). At least, done that way, I'll only need to ping as many IPs as I need to actually find the CURB device.

    Here's the test code I developed from OptionBase1's code:

    Code:
    
    Option Explicit
    Private Type ICMP_OPTIONS_Type
        Ttl             As Byte
        Tos             As Byte
        Flags           As Byte
        OptionsSize     As Byte
        OptionsData     As Long
    End Type
    Private Type ICMP_ECHO_REPLY_Type
        Address         As Long
        status          As Long
        RoundTripTime   As Long
        DataSize        As Long
        DataPointer     As Long
        Options         As ICMP_OPTIONS_Type
        Data            As String * 250
    End Type
    '
    Private Declare Function inet_addr Lib "wsock32.dll" (ByVal sIP As String) As Long
    Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
    Private Declare Function IcmpSendEcho Lib "icmp.dll" (ByVal IcmpHandle As Long, ByVal DestinationAddress As Long, ByVal RequestData As String, ByVal RequestSize As Long, ByVal RequestOptions As Long, ReplyBuffer As ICMP_ECHO_REPLY_Type, ByVal ReplySize As Long, ByVal Timeout As Long) As Long                                '
    Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long
    '
    
    
    Private Sub Form_Click()
        Dim Echo As ICMP_ECHO_REPLY_Type
        Dim i As Long
        For i = 3& To 253&
            Call Ping("192.168.1." & CStr(i))
            Debug.Print "192.168.1." & CStr(i)
        Next
    End Sub
    
    Private Sub Ping(sAddress As String)
        ' Don't care if it succeeds or not.
        ' We just need to ping an IP before we attempt to get its MAC address.
        '
        Dim Echo As ICMP_ECHO_REPLY_Type
        Dim hPort As Long
        Dim dwAddress As Long
    
        ' Convert the address into a Long.
        dwAddress = inet_addr(sAddress)
        '
        ' Open a port.
        hPort = IcmpCreateFile()
        Const PING_TIMEOUT As Long = 500&   ' Milliseconds.
        If hPort Then
            ' Ping it.
            Call IcmpSendEcho(hPort, dwAddress, 0&, 0&, 0&, Echo, LenB(Echo), PING_TIMEOUT)
            Call IcmpCloseHandle(hPort)
        End If
    End Sub
    
    
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  26. #26
    Frenzied Member VanGoghGaming's Avatar
    Join Date
    Jan 2020
    Location
    Eve Online - Mining, Missions & Market Trading!
    Posts
    1,761

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    "IcmpSendEcho2" works asynchronously and returns immediately thus allowing you to ping all addresses very fast although it may be a little more difficult to implement. But probably you don't need to implement all the asynchronous quirks since you are not interested in the ping results in this case.

  27. #27

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    Quote Originally Posted by VanGoghGaming View Post
    "IcmpSendEcho2" works asynchronously and returns immediately thus allowing you to ping all addresses very fast although it may be a little more difficult to implement. But probably you don't need to implement all the asynchronous quirks since you are not interested in the ping results in this case.
    Definitely sounds worth exploring. Although I probably would want to sleep for a couple of seconds after spooling through ~250 IP addresses, just to give them a chance to populate the IP Net Table.

    I'm on it.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  28. #28
    PowerPoster
    Join Date
    Nov 2017
    Posts
    3,282

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    Quote Originally Posted by Elroy View Post
    Ok, pinging the IPs worked, but it added about 5 minutes to the time to find the CURB's MAC address. I just pinged about 250 IPs before fetching the IP Net Table.

    Pinging an IP takes about one second. I tried reducing the PING_TIMEOUT, and I also tried using the same handle from IcmpCreateFile for all the pings. But neither of those changes seemed to affect the ping time at all ... still remaining about a second per ping.
    That isn't at all what I recall happening with that code when I used it. However, in the environment I used it in, the vast majority of the IP's were used/responsive. If you are pinging a 255 IP range and there are only a handful of used IP's, I could see that taking longer. As I recall, an unresponsive IP takes much longer to "process" than one that is used.

    Good luck Elroy, hope you can get to the point where it works "fast enough".

  29. #29
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,351

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    I was wondering is it possible to ping some broadcast address i.e. 192.168.0.255 or 192.168.0.0 so that all available hosts in local segment reply and populate ARP cache on local host.

  30. #30

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    Quote Originally Posted by wqweto View Post
    I was wondering is it possible to ping some broadcast address i.e. 192.168.0.255 or 192.168.0.0 so that all available hosts in local segment reply and populate ARP cache on local host.
    Well, it was definitely worth a shot, but it didn't work.

    Snippet of code:

    Code:
    
    '        ' Ping all possible IP addresses so the IP Net Table is populated.
    '        For i = 3& To 253&
    '            Ping "192.168.1." & CStr(i)
    '        Next
            Ping "192.168.0.0"
            Ping "192.168.0.255"
            '
            ' Now we can get the IP Net Table and search for our MAC address.
            Dim IpNetTable As MIB_IPNETTABLE_Type
            Dim iRet As Long
            iRet = GetIpNetTable(IpNetTable, LenB(IpNetTable), 0&)
            If iRet Then
                MsgBox "Couldn't get the IP Net Table!", vbCritical
                End
            End If
    
            For i = 0& To IpNetTable.dwNumEntries - 1&
                'Debug.Print sLongToIp(IpNetTable.table(i).dwAddr), sMacAddrToString(IpNetTable.table(i).bPhysAddr)
                If sMacAddrToString(IpNetTable.table(i).bPhysAddr) = sCurbMacAddress Then
                    sCurbIp = sLongToIp(IpNetTable.table(i).dwAddr)
                    Exit For
                End If
            Next
            If i = IpNetTable.dwNumEntries Then
                MsgBox "Couldn't find CURB's MAC address!", vbCritical
                End
            End If
        End If
    
    
    I also tried pinging 192.168.1.0 and 192.168.1.255, and it still failed. I also tried it several times, thinking it might be taking a moment to populate the IP table.

    Name:  NoFind.png
Views: 51
Size:  5.5 KB

    I guess I'm still on the path of figuring out how to make IcmpSendEcho2 work in an asynchronous fashion ... after breakfast.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  31. #31
    PowerPoster SamOscarBrown's Avatar
    Join Date
    Aug 2012
    Location
    NC, USA
    Posts
    9,322

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    I just want to interrupt...all this discussion in eons above my understanding, but I did notice something in Post #17 that stuck out to me. You said that you plan to install this program on another computer which 'runs all the time'. So, would not this 'ARP cache' (whatever that is) be populated after a bit. IOW, if the computer has already populated it once, would not all the information then appear in your program?

    Again, I'm a simple man...but just thought maybe all that extra work may not be required?????//
    Sam I am (as well as Confused at times).

  32. #32

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    Quote Originally Posted by SamOscarBrown View Post
    I just want to interrupt...all this discussion in eons above my understanding, but I did notice something in Post #17 that stuck out to me. You said that you plan to install this program on another computer which 'runs all the time'. So, would not this 'ARP cache' (whatever that is) be populated after a bit. IOW, if the computer has already populated it once, would not all the information then appear in your program?

    Again, I'm a simple man...but just thought maybe all that extra work may not be required?????//
    Hi Sam. No problem at all you joining the discussion. And, you're sort of right. Even if my little program took 5 minutes to get going, that'd be fine because it's a one-time thing. And that computer is even on a UPS unit, so it never loses power. (Basically, it's for my POE camera system. And that system has two NIC cards, keeping my cameras on a separate LAN, using a 10.0.0.### IP system.)

    But, I also enjoy running this little program from my Surface that lives on the dinette table, and seeing how things are going. And I do occasionally reboot this surface (which I'm on right now).

    IDK, part of it is just a learning process, and just trying to optimize this little program as best as I can.

    Also, I have a son who lives on Asheville NC who also has solar panels and a similar CURB power monitor. And I'll eventually make him a version of this program. And I don't believe he has any UPS units on computers, so I'd like to make it as user-friendly as possible. Shucks, I might even eventually stick it in the CodeBank. It wouldn't be difficult to design a bit of a "Setup" form for it, with production/consumption/not_used option buttons beside each of the 18 CURB power channels.



    And Sam, just to quickly outline what I'm doing ... I've got this CURB Energy Monitor device in my circuit breaker boxes. It also has an ethernet cable going to it that plugs into a switch which plugs into my StarLink router. It just has 18 inputs and 18 wires that plug into them, with each of those having amperage clamps on the ends of them. You just choose where those clamps go inside the circuit breaker box, hopefully covering everything when you're done (which I do).

    And, from my LAN side, once I know the IP of that CURB device, I can query it with an HTTP GET, and it'll dump an HTML page to me with a log (of about the last 3 hours, with one entry per minute) of what the readings are of those 18 channels. (It actually reports Watts, but that's neither here nor there.)

    It's up to me to understand what those 18 channels mean, but I know that.

    And the problem of this entire thread is how to "quickly" figure out what the IP address is of that CURB device. I do know its MAC address (which doesn't change like the IP can), so I'm using that to get its IP. But, so far, it's a slow process, but I'm hot on the trail of figuring out how to speed that up.
    Last edited by Elroy; Jul 11th, 2024 at 08:18 AM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  33. #33

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: [not yet resolved] Microsoft.XMLHTTP and searching for an IP

    Ok, I think I've got it working. Here's my "test" code in a Form1 with two buttons (cmdPing and cmdGetCurbIP).

    I reboot my computer, and then click those buttons in succession, and it works ... almost instantly returning my CURB's IP. Yayyy.

    Code:
    
    Option Explicit
    '
    Private Type SECURITY_ATTRIBUTES_Type
        nLength                 As Long
        lpSecurityDescriptor    As Long
        bInheritHandle          As Long
    End Type
    '
    Private Type IP_OPTION_INFO_Type
        ttl             As Byte     ' Byte     'Time To Live
        Tos             As Byte     ' Type Of Service
        Flags           As Byte     ' IP header flags
        OptionsSize     As Byte     ' Size in bytes of options data
        OptionsData     As Long     ' Pointer to options data
    End Type
    Private Type ICMP_ECHO_REPLY_Type
        Address         As Long
        Status          As Long
        RoundTripTime   As Long
        datasize        As Long
        DataPointer     As Long
        Options         As IP_OPTION_INFO_Type
        Data            As String * 250
    End Type
    '
    Private Type MIB_IPNETROW_Type
        dwIndex             As Long
        dwPhysAddrLen       As Long
        bPhysAddr(5&)       As Byte
        dwAddr              As Long
        dwType              As Long
    End Type
    Private Type MIB_IPNETTABLE_Type
        dwNumEntries        As Long
        table(1023&)        As MIB_IPNETROW_Type
    End Type
    '
    Private Declare Function inet_addr Lib "wsock32.dll" (ByVal s As String) As Long
    '
    Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
    Private Declare Function IcmpSendEcho2 Lib "icmp.dll" (ByVal IcmpHandle As Long, ByVal hEvent As Long, ByVal ApcRoutine As Any, ByVal ApcContext As Long, ByVal DestinationAddress As Long, ByVal RequestData As String, ByVal RequestSize As Long, ByVal RequestOptions As Long, ByVal ReplyBuffer As Long, ByVal ReplySize As Long, ByVal TimeOut As Long) As Long
    Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long
    '
    Private Declare Function GetIpNetTable Lib "iphlpapi.dll" (ByRef pIpNetTable As Any, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
    '
    Private Declare Function CreateEvent Lib "kernel32.dll" Alias "CreateEventA" (lpEventAttributes As SECURITY_ATTRIBUTES_Type, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long
    Private Declare Function ResetEvent Lib "kernel32.dll" (ByVal hEvent As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
    '
    Private Declare Sub GetMem1 Lib "msvbvm60.dll" (ByRef Source As Any, ByRef Dest As Any)
    '
    Private hPorts()    As Long
    Private hEvents()   As Long
    Private Const IpLo  As Long = 3&
    Private Const IpHi  As Long = 253&
    Private Const msCurbMacAddress  As String = "00-0C-C6-84-06-C1"
    '
    
    
    Private Sub Form_Load()
        Dim i As Long
        '
        ' Create ports for making IcmpSendEcho2 calls.
        ReDim hPorts(IpLo To IpHi)
        For i = IpLo To IpHi
            hPorts(i) = IcmpCreateFile()
        Next
        '
        ' Needed for calls to CreateEvent.
        Dim sd As SECURITY_ATTRIBUTES_Type
        With sd
            .nLength = LenB(sd)
            .lpSecurityDescriptor = 0&
            .bInheritHandle = 0&
        End With
        '
        ' Create events for making IcmpSendEcho2 calls.
        ReDim hEvents(IpLo To IpHi)
        For i = IpLo To IpHi
            hEvents(i) = CreateEvent(sd, True, False, "PING_" & CStr(i))
        Next
        '
        ' At some point, it's advisable to do the following, possibly in a one-time timer:
        'ResetEvent hEvents(i)
        'IcmpCloseHandle hPorts(i)
    End Sub
    
    Private Sub Form_Unload(Cancel As Integer)
        '
        ' Release all our events and ports used for the IcmpSendEcho2 calls.
        Dim i As Long
        For i = IpLo To IpHi
            ResetEvent hEvents(i)
            IcmpCloseHandle hPorts(i)
        Next
    End Sub
    
    Private Sub cmdPing_Click()
        '
        ' Ping all possible CURB IP addresses.
        Dim i As Long
        For i = IpLo To IpHi
            Call PingAsync(i)
        Next
    End Sub
    
    Private Sub cmdGetCurbIP_Click()
        '
        ' See if we can find the CURB IP address.
        Debug.Print "'"; sGetCurbIp(msCurbMacAddress); "'"
    End Sub
    
    Public Sub PingAsync(iIpSuffix As Long)
        ' This does an asychronous ping with the pre-created hPorts and hEvents.
        '
        Const sSendData As String = "TESTMESSAGE"
        Const TimeOut   As Long = 500&
        Dim Buffer      As ICMP_ECHO_REPLY_Type
        Dim sHostIP     As String
        sHostIP = "192.168.1." & CStr(iIpSuffix)
        Call IcmpSendEcho2(hPorts(iIpSuffix), hEvents(iIpSuffix), 0&, 0&, inet_addr(sHostIP), sSendData, Len(sSendData), 0, VarPtr(Buffer), Len(Buffer), TimeOut)
    End Sub
    
    Private Function sGetCurbIp(sCurbMacAddress As String) As String
        '
        ' Get the IP Net Table and search for our MAC address.
        ' This depends on the IP Net Table being populated with the CURB's IP in it.
        Dim IpNetTable As MIB_IPNETTABLE_Type
        Dim iRet As Long
        iRet = GetIpNetTable(IpNetTable, LenB(IpNetTable), 0&)
        If iRet Then
            MsgBox "Couldn't get the IP Net Table!", vbCritical
            Exit Function
        End If
        '
        Dim i As Long
        For i = 0& To IpNetTable.dwNumEntries - 1&
            'Debug.Print sLongToIp(IpNetTable.table(i).dwAddr), sMacAddrToString(IpNetTable.table(i).bPhysAddr)
            If sMacAddrToString(IpNetTable.table(i).bPhysAddr) = sCurbMacAddress Then
                sGetCurbIp = sLongToIp(IpNetTable.table(i).dwAddr)
                Exit Function
            End If
        Next
        If i = IpNetTable.dwNumEntries Then
            MsgBox "Couldn't find CURB's MAC address!", vbCritical
            Exit Function
        End If
    End Function
    
    Private Function sMacAddrToString(bbMacAddr() As Byte) As String
        sMacAddrToString = Right$("0" & Hex$(bbMacAddr(0&)), 2&) & "-" & _
                           Right$("0" & Hex$(bbMacAddr(1&)), 2&) & "-" & _
                           Right$("0" & Hex$(bbMacAddr(2&)), 2&) & "-" & _
                           Right$("0" & Hex$(bbMacAddr(3&)), 2&) & "-" & _
                           Right$("0" & Hex$(bbMacAddr(4&)), 2&) & "-" & _
                           Right$("0" & Hex$(bbMacAddr(5&)), 2&)
    End Function
    
    Private Function sLongToIp(ByVal dwIP As Long) As String
        sLongToIp = Format$(dwIP And &HFF&) & "." & _
                    Format$((dwIP And &HFF00&) \ &H100&) & "." & _
                    Format$((dwIP And &HFF0000) \ &H10000) & "."
        Dim bb As Byte
        GetMem1 ByVal VarPtr(dwIP) + 3&, bb
        sLongToIp = sLongToIp & Format$(bb)
    End Function
    
    
    
    I'm thinking of adding a timer control, and waiting about 5 minutes, and closing all those hEvents() and hPorts() rather than leaving them open until the program shuts down. I believe they have to stay open though so long as an IP hasn't returned from being pinged. And, since that's all now asynchronous, I don't know exactly when that will all settle down.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  34. #34

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: [not yet resolved] Microsoft.XMLHTTP and searching for an IP

    Yayyyyyy!!!!

    It actually works. I've attached it as a project, but all the code is in Form1, and here it is, but it's all designed to "find" this CURB device, which I suspect none of you have. I suppose, if you know a MAC address, it could be fairly easily modified to find the IP for any MAC on your LAN:

    Code:
    Option Explicit
    '
    Private Type CurbLogRecordType
        sDate               As String * 12
        sTime               As String * 10
        sTotalProduction    As String * 8
        sTotalConsumption   As String * 8
        sGainLoss           As String * 8
        sAllButHvac         As String * 8
        sHvac1              As String * 8
        sHvac2              As String * 8
        sCrLf               As String * 2
    End Type
    '
    Private Type CurbInfoType
        dtDate              As Date
        dtTime              As Date
        dValues(1& To 18&)  As Double
    End Type
    '
    Private Type SECURITY_ATTRIBUTES_Type
        nLength                 As Long
        lpSecurityDescriptor    As Long
        bInheritHandle          As Long
    End Type
    '
    Private Type MIB_IPNETROW_Type
        dwIndex             As Long
        dwPhysAddrLen       As Long
        bPhysAddr(5&)       As Byte
        dwAddr              As Long
        dwType              As Long
    End Type
    Private Type MIB_IPNETTABLE_Type
        dwNumEntries        As Long
        table(1023&)        As MIB_IPNETROW_Type
    End Type
    Private Type ICMP_OPTIONS_Type
        ttl             As Byte
        Tos             As Byte
        Flags           As Byte
        OptionsSize     As Byte
        OptionsData     As Long
    End Type
    Private Type ICMP_ECHO_REPLY_Type
        Address         As Long
        Status          As Long
        RoundTripTime   As Long
        datasize        As Long
        DataPointer     As Long
        Options         As ICMP_OPTIONS_Type
        Data            As String * 250
    End Type
    '
    Private Declare Function GetIpNetTable Lib "iphlpapi.dll" (ByRef pIpNetTable As Any, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
    '
    Private Declare Function GetComputerName Lib "kernel32.dll" Alias "GetComputerNameW" (ByVal lpBuffer As Long, nSize As Long) As Long
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function CreateEvent Lib "kernel32.dll" Alias "CreateEventA" (lpEventAttributes As SECURITY_ATTRIBUTES_Type, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long
    Private Declare Function ResetEvent Lib "kernel32.dll" (ByVal hEvent As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
    '
    Private Declare Sub GetMem1 Lib "msvbvm60.dll" (ByRef Source As Any, ByRef Dest As Any)
    '
    Private Declare Function inet_addr Lib "wsock32.dll" (ByVal sIP As String) As Long
    '
    Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
    Private Declare Function IcmpSendEcho2 Lib "icmp.dll" (ByVal IcmpHandle As Long, ByVal hEvent As Long, ByVal ApcRoutine As Any, ByVal ApcContext As Long, ByVal DestinationAddress As Long, ByVal RequestData As String, ByVal RequestSize As Long, ByVal RequestOptions As Long, ByVal ReplyBuffer As Long, ByVal ReplySize As Long, ByVal TimeOut As Long) As Long
    Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long
    '
    Private mhPorts()       As Long
    Private mhEvents()      As Long
    Private Const IpLo      As Long = 3&
    Private Const IpHi      As Long = 253&
    Private moXmlHttp       As Object
    Private mbGettingHtml   As Boolean
    'Private Const msComputerNameToLog   As String = "DESKTOP-TJNP41V"   ' The "cameras" computer.
    Private Const msComputerNameToLog   As String = "TUF-TOWER"
    Private Const msCurbMonitoringFile  As String = "C:\Users\Elroy\Documents\Curb_Monitoring_Log.txt"
    '
    Private Const msCurbMacAddress      As String = "00-0C-C6-84-06-C1"
    '
    
    Private Sub Form_Load()
        Me.Left = (Screen.Width - Me.Width) / 2!
        Me.Top = (Screen.Height - Me.Height) / 3!
    End Sub
    
    Private Sub Form_Activate()
        Set moXmlHttp = CreateObject("Microsoft.XMLHTTP")
        Me.tmrCurbPolling.Interval = 60000  ' The UI's message says we poll every minute, which is what this is.
        Me.tmrCurbPolling.Enabled = True
        Me.tmrClock.Interval = 1000&        ' We update our little clock every second.
        Me.tmrClock.Enabled = True
        CurbTimerProc                       ' Do it once here so we immediately see some results.
    End Sub
    
    Private Sub Form_Unload(Cancel As Integer)
        Set frmCurbMonitoring = Nothing     ' Make sure the Form_Terminate event gets raised.
    End Sub
    
    Private Sub Form_Terminate()
        End                                 ' Make sure this program shuts down.
    End Sub
    
    Private Sub tmrCurbPolling_Timer()
        If mbGettingHtml Then Exit Sub      ' Don't allow the timer to cause recursion if we're slow in getting the CURB's HTML.
        CurbTimerProc                       ' Go poll the CURB device and report.
    End Sub
    
    Private Sub tmrClock_Timer()
        Me.lblTime.Caption = Format$(Time, "h:nn:ss am/pm")
    End Sub
    
    Private Sub UpdateReporting(uCurbRecords() As CurbInfoType)
        '
        ' Get latest record.
        Dim uLatest As CurbInfoType
        uLatest = uCurbRecords(UBound(uCurbRecords))
        '
        ' Times.
        Me.txtTime.Text = Format$(Time, "h:nn:ss am/pm")
        Me.txtLogUpdate.Text = Format$(uLatest.dtTime, "h:nn:ss am/pm")
        '
        ' Calculate production and consumption.
        Dim dProduction As Double
        Dim dConsumption As Double
        Dim dGain As Double
        '
        dProduction = uLatest.dValues(2&) + uLatest.dValues(8&)
        dConsumption = uLatest.dValues(1&) + uLatest.dValues(7&) + _
                       uLatest.dValues(3&) + uLatest.dValues(9&) + _
                       uLatest.dValues(4&) + uLatest.dValues(10&) + _
                       uLatest.dValues(5&) + uLatest.dValues(11&) + _
                       uLatest.dValues(13&) + _
                       uLatest.dValues(14&) + _
                       uLatest.dValues(16&)
        dGain = dProduction - dConsumption
        '
        ' And report it.
        Me.txtProduction.Text = Format$(dProduction, "#,0.0  ")
        Me.txtConsumption.Text = Format$(dConsumption, "#,0.0  ")
        If dGain >= 0# Then
            Me.txtGainLoss.ForeColor = &H8000&
            Me.txtGainLoss.Text = Format$(dGain, "#,0.0  ")
        Else
            Me.txtGainLoss.ForeColor = &HC0&
            Me.txtGainLoss.Text = "(" & Format$(-dGain, "#,0.0") & ") "
        End If
        '
        ' HVAC units.
        Dim dHVAC1 As Double
        Dim dHVAC2 As Double
        dHVAC1 = uLatest.dValues(4&) + uLatest.dValues(10&)
        dHVAC2 = uLatest.dValues(5&) + uLatest.dValues(11&)
        Me.txtHvac1.Text = Format$(dHVAC1, "#,0.0  ")
        Me.txtHvac2.Text = Format$(dHVAC2, "#,0.0  ")
        '
        ' All but HVAC.
        Dim dNoHVAC As Double
        dNoHVAC = dConsumption - (dHVAC1 + dHVAC2)
        Me.txtNoHvac.Text = Format$(dNoHVAC, "#,0.0  ")
        '
        ' And now, update the log if we're on the correct machine.
        ' If we're not on the correct machine, we're done.
        If sMachineName <> msComputerNameToLog Then Exit Sub    ' Only update log on one machine.
        '
        ' Make sure the file exists.  If not, get it started.
        Dim bCurbFileExists As Boolean
        bCurbFileExists = bFileExists(msCurbMonitoringFile)
        Dim hFile As Long
        hFile = FreeFile
        Dim uRecord As CurbLogRecordType
        uRecord.sCrLf = vbCrLf
        Open msCurbMonitoringFile For Random As hFile Len = LenB(uRecord) / 2&
        If Not bCurbFileExists Then
            '
            ' Put header into our new file ... two records.
            uRecord.sDate = "RecordCount="
            uRecord.sTime = "2"                 ' We count the header records, to make math a bit easier.
            uRecord.sTotalProduction = vbNullString
            uRecord.sTotalConsumption = vbNullString
            uRecord.sGainLoss = vbNullString
            uRecord.sAllButHvac = vbNullString
            uRecord.sHvac1 = vbNullString
            uRecord.sHvac2 = vbNullString
            Put #hFile, 1&, uRecord
            uRecord.sDate = "   Date"
            uRecord.sTime = "  Time"
            uRecord.sTotalProduction = "  T_Prod"
            uRecord.sTotalConsumption = "  T_Cons"
            uRecord.sGainLoss = "  Gain_L"
            uRecord.sAllButHvac = "  NoHvac"
            uRecord.sHvac1 = "  HVAC_1"
            uRecord.sHvac2 = "  HVAC_2"
            Put #hFile, 2&, uRecord
        End If
        '
        ' Get the last record and get its date and time.
        Get #hFile, 1&, uRecord
        Dim iRecCount As Long
        iRecCount = CLng(uRecord.sTime)
        Dim dtBottomDate As Date
        Dim dtBottomTime As Date
        If iRecCount > 2& Then
            Get #hFile, iRecCount, uRecord
            dtBottomDate = DateValue(uRecord.sDate)
            dtBottomTime = TimeValue(uRecord.sTime)
        Else
            dtBottomDate = 0#
            dtBottomTime = 0#
        End If
        '
        ' Now, check if our CURB array has values greater than the last date and time.
        Dim i As Long, bAddedRecords As Boolean
        For i = LBound(uCurbRecords) To UBound(uCurbRecords)
            ' 0.0006944 is approximately one minute, as a Date type would store it.
            If uCurbRecords(i).dtDate > dtBottomDate Or (uCurbRecords(i).dtDate = dtBottomDate And (uCurbRecords(i).dtTime - dtBottomTime) > 0.0006944) Then
                uRecord.sDate = Format$(uCurbRecords(i).dtDate, "mm/dd/yyyy")
                uRecord.sTime = Format$(uCurbRecords(i).dtTime, "h:nn am/pm")
                '
                dProduction = uCurbRecords(i).dValues(2&) + uCurbRecords(i).dValues(8&)
                dConsumption = uCurbRecords(i).dValues(1&) + uCurbRecords(i).dValues(7&) + _
                               uCurbRecords(i).dValues(3&) + uCurbRecords(i).dValues(9&) + _
                               uCurbRecords(i).dValues(4&) + uCurbRecords(i).dValues(10&) + _
                               uCurbRecords(i).dValues(5&) + uCurbRecords(i).dValues(11&) + _
                               uCurbRecords(i).dValues(13&) + _
                               uCurbRecords(i).dValues(14&) + _
                               uCurbRecords(i).dValues(16&)
                dGain = dProduction - dConsumption
                dHVAC1 = uCurbRecords(i).dValues(4&) + uCurbRecords(i).dValues(10&)
                dHVAC2 = uCurbRecords(i).dValues(5&) + uCurbRecords(i).dValues(11&)
                dNoHVAC = dConsumption - (dHVAC1 + dHVAC2)
                '
                uRecord.sTotalProduction = Right$(Space$(8&) & Format$(dProduction, "#0"), 8&)
                uRecord.sTotalConsumption = Right$(Space$(8&) & Format$(dConsumption, "#0"), 8&)
                uRecord.sGainLoss = Right$(Space$(8&) & Format$(dGain, "#0"), 8&)
                uRecord.sAllButHvac = Right$(Space$(8&) & Format$(dNoHVAC, "#0"), 8&)
                uRecord.sHvac1 = Right$(Space$(8&) & Format$(dHVAC1, "#0"), 8&)
                uRecord.sHvac2 = Right$(Space$(8&) & Format$(dHVAC2, "#0"), 8&)
                '
                iRecCount = iRecCount + 1&
                Put #hFile, iRecCount, uRecord
                bAddedRecords = True
            End If
        Next
        '
        ' If we added, update header.
        If bAddedRecords Then
            uRecord.sDate = "RecordCount="
            uRecord.sTime = CStr(iRecCount)
            uRecord.sTotalProduction = vbNullString
            uRecord.sTotalConsumption = vbNullString
            uRecord.sGainLoss = vbNullString
            uRecord.sAllButHvac = vbNullString
            uRecord.sHvac1 = vbNullString
            uRecord.sHvac2 = vbNullString
            Put #hFile, 1&, uRecord
        End If
        '
        ' Done, be sure to close our file each/every time.
        Close hFile
    End Sub
    
    Private Sub CurbTimerProc()
        '
        ' Get Curb Monitor HTML dump.
        Dim sHtml As String
        mbGettingHtml = True
        sHtml = sCurbHtml(msCurbMacAddress)
        If sHtml = vbNullString Then
            ' It fails to find it occasionally, but it typically does the next time through.
            mbGettingHtml = False
            Exit Sub
        End If
        mbGettingHtml = False
        '
        ' Trap errors so InStr stuff doesn't fail when the HTML is garbled, which it occasionally is.
        On Error Resume Next
            '
            ' Trim to correct table section.
            sHtml = Mid$(sHtml, InStr(sHtml, "Load controller log"))
            '
            ' Trim all subsequent table sections.
            sHtml = Left$(sHtml, InStr(sHtml, "Monitor log") - 1&)
            '
            ' Remove EOL characters.
            sHtml = Replace$(sHtml, vbCr, vbNullString)
            sHtml = Replace$(sHtml, vbLf, vbNullString)
            '
            ' Make collection of "INFO Load..." entries, parsing the HTML text.
            Dim cInfos As New Collection
            Dim sIa() As String
            sIa = Split(sHtml, "<br>")
            Dim i As Long, j As Long
            For i = LBound(sIa) To UBound(sIa)
                j = InStr(sIa(i), "INFO Load control got aggregated sample")
                If j Then
                    Do
                        j = InStr(sIa(i), "<td>")
                        If j = 0& Then Exit Do
                        sIa(i) = Mid$(sIa(i), j + 1&)
                    Loop
                    cInfos.Add sIa(i)
                End If
            Next
            Erase sIa
            '
            ' Make our UDT from the collection, doing further parsing of the CURB's log rows.
            Dim uCurbRecords() As CurbInfoType
            ReDim uCurbRecords(cInfos.Count - 1&)
            '
            ' Fill UDT with date, time, & WATT values.
            Dim v As Variant
            Dim sDate As String, sTime As String
            Dim sDTa() As String
            Dim sLa() As String
            Dim cnt As Long
            For Each v In cInfos
                ' Date first.
                sDate = Left$(v, InStr(v, "INFO Load") - 2&)
                Do While InStr(sDate, "  ")
                    sDate = Replace$(sDate, "  ", " ")
                Loop
                sDTa = Split(sDate, " ")
                uCurbRecords(cnt).dtDate = DateValue(sDTa(1) & " " & sDTa(2) & ", " & sDTa(4))
                '
                ' And the time of day.  Does NOT adjust for daylight savings time.
                uCurbRecords(cnt).dtTime = TimeValue(sDTa(3&)) - 6# / 24#   ' Adjust for Central STANDARD Time.
                If uCurbRecords(cnt).dtTime < 0# Then uCurbRecords(cnt).dtTime = uCurbRecords(cnt).dtTime + 1#
                '
                ' Get the WATT values.
                sLa = Split(v, """w"":")
                For j = 1& To 18&
                    uCurbRecords(cnt).dValues(j) = CDbl(Left$(sLa(j), InStr(sLa(j), "}") - 1&)) * 60#
                Next
                '
                ' Increment counter.
                cnt = cnt + 1&
            Next
            '
            ' Some cleanup.
            Erase sDTa
            Erase sLa
            Set cInfos = Nothing
            '
            Dim iErr As Long
            iErr = Err.Number
        On Error GoTo 0
        '
        ' Make sure we're ok.
        If iErr Then
            ' Just get out, and let it try again the next time through.
            Exit Sub
        End If
        '
        ' Report the last record.
        UpdateReporting uCurbRecords
    End Sub
    
    Private Function sCurbHtml(sCurbMacAddress As String) As String
        ' Returns the HTML string.
        '
        ' Find the CURB device.
        Dim i As Long
        Static sCurbIp As String
        If sCurbIp = vbNullString Then sCurbIp = sGetCurbIp(sCurbMacAddress)
        If sCurbIp = vbNullString Then Exit Function
        '
        ' We found the CURB device, so "GET" its HTML.
        moXmlHttp.Open "GET", "http://" & sCurbIp & ":80", True
        On Error Resume Next
            moXmlHttp.Send
            Sleep 2000&
            Dim sHtml As String
            DoEvents
            sHtml = moXmlHttp.responseText
            Dim iErr As Long
            iErr = Err.Number
        On Error GoTo 0
        If iErr Then
            Exit Function           ' CURB device didn't reply.
            ' It occasionally doesn't reply, but we don't worry about it, just trying again when called again.
        End If
        '
        ' Return HTML results.
        sCurbHtml = sHtml
    End Function
    
    Private Function sGetCurbIp(sCurbMacAddress As String) As String
        Dim i As Long
        '
        ' Create mhPorts() for making IcmpSendEcho2 calls.
        ReDim mhPorts(IpLo To IpHi)
        For i = IpLo To IpHi
            mhPorts(i) = IcmpCreateFile()
        Next
        '
        ' Needed for calls to CreateEvent.
        Dim sd As SECURITY_ATTRIBUTES_Type
        With sd
            .nLength = LenB(sd)
            .lpSecurityDescriptor = 0&
            .bInheritHandle = 0&
        End With
        '
        ' Create mhEvents() for making IcmpSendEcho2 calls.
        ReDim mhEvents(IpLo To IpHi)
        For i = IpLo To IpHi
            mhEvents(i) = CreateEvent(sd, True, False, "PING_" & CStr(i))
        Next
        '
        ' Ping all possible IP addresses so the IP Net Table is populated.
        For i = IpLo To IpHi
            PingAsync i
        Next
        '
        ' Sleep just a moment so the CURB's IP has a chance to populate the IP Net Table.
        Sleep 2000&
        '
        ' Now we can get the IP Net Table and search for our MAC address.
        Dim IpNetTable As MIB_IPNETTABLE_Type
        Dim iRet As Long
        iRet = GetIpNetTable(IpNetTable, LenB(IpNetTable), 0&)
        '
        ' We now set a timer to close all those mhPorts() and mhEvents().
        tmrClosePortsAndEvents.Interval = 60000    ' 1 minute, which should be plenty.
        tmrClosePortsAndEvents.Enabled = True
        '
        ' Now we should be able to find the CURB's IP.
        If iRet Then
            MsgBox "Couldn't get the IP Net Table!", vbCritical
            End
        End If
        '
        For i = 0& To IpNetTable.dwNumEntries - 1&
            'Debug.Print sLongToIp(IpNetTable.table(i).dwAddr), sMacAddrToString(IpNetTable.table(i).bPhysAddr)
            If sMacAddrToString(IpNetTable.table(i).bPhysAddr) = sCurbMacAddress Then
                sGetCurbIp = sLongToIp(IpNetTable.table(i).dwAddr)
                Exit Function
            End If
        Next
        '
        ' Make sure we didn't fall out, and not find it.
        MsgBox "Couldn't find CURB's MAC address!", vbCritical
        End
    End Function
    
    Public Sub PingAsync(iIpSuffix As Long)
        ' This does an asychronous ping with the pre-created hPorts() and hEvents().
        ' Be sure they're created BEFORE calling this.
        '
        Const sSendData As String = "TESTMESSAGE"
        Const TimeOut   As Long = 500&
        Dim Buffer      As ICMP_ECHO_REPLY_Type
        Dim sHostIP     As String
        sHostIP = "192.168.1." & CStr(iIpSuffix)
        Call IcmpSendEcho2(mhPorts(iIpSuffix), mhEvents(iIpSuffix), 0&, 0&, inet_addr(sHostIP), sSendData, Len(sSendData), 0, VarPtr(Buffer), Len(Buffer), TimeOut)
    End Sub
    
    Private Sub tmrClosePortsAndEvents_Timer()
        '
        ' Release all our events and ports used for the IcmpSendEcho2 calls.
        Dim i As Long
        For i = IpLo To IpHi
            ResetEvent mhEvents(i)
            IcmpCloseHandle mhPorts(i)
        Next
        '
        ' Turn off timer, as this is a one-shot timer.
        tmrClosePortsAndEvents.Enabled = False
        tmrClosePortsAndEvents.Interval = 0&
        '
        ' Cleanup arrays.
        Erase mhEvents
        Erase mhPorts
    End Sub
    
    Private Function sMacAddrToString(bbMacAddr() As Byte) As String
        sMacAddrToString = Right$("0" & Hex$(bbMacAddr(0&)), 2&) & "-" & _
                           Right$("0" & Hex$(bbMacAddr(1&)), 2&) & "-" & _
                           Right$("0" & Hex$(bbMacAddr(2&)), 2&) & "-" & _
                           Right$("0" & Hex$(bbMacAddr(3&)), 2&) & "-" & _
                           Right$("0" & Hex$(bbMacAddr(4&)), 2&) & "-" & _
                           Right$("0" & Hex$(bbMacAddr(5&)), 2&)
    End Function
    
    Private Function sLongToIp(ByVal dwIP As Long) As String
        sLongToIp = Format$(dwIP And &HFF&) & "." & _
                    Format$((dwIP And &HFF00&) \ &H100&) & "." & _
                    Format$((dwIP And &HFF0000) \ &H10000) & "."
        Dim bb As Byte
        GetMem1 ByVal VarPtr(dwIP) + 3&, bb
        sLongToIp = sLongToIp & Format$(bb)
    End Function
    
    Private Function sMachineName() As String
        Const MAX_COMPUTERNAME_LENGTH As Long = 15&
        Dim sBuffer As String
        sBuffer = Space$(MAX_COMPUTERNAME_LENGTH + 1&)
        Dim lSize As Long
        lSize = Len(sBuffer) ' Call to GetComputerName resets this to number of characters in name (not including nulls).
        If GetComputerName(StrPtr(sBuffer), lSize) Then sMachineName = UCase$(Left$(sBuffer, lSize))
    End Function
    
    Private Function bFileExists(fle As String) As Boolean
        On Error GoTo FileExistsError
        ' If no error then something existed.
        bFileExists = (GetAttr(fle) And vbDirectory) = 0
        Exit Function
    FileExistsError:
        bFileExists = False
    End Function
    Attached Files Attached Files
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  35. #35
    Frenzied Member VanGoghGaming's Avatar
    Join Date
    Jan 2020
    Location
    Eve Online - Mining, Missions & Market Trading!
    Posts
    1,761

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    Very nice work, glad to see you got it working asynchronously. Have you tried using a single handle with IcmpCreateFile rather than an array of handles? I was thinking it would be cool if you made your app an ActiveX EXE so that it could spawn an additional thread per each call to IcmpSendEcho2. Then each thread would be able to close its own event handle after being signaled. In the meantime the main thread could keep checking the GetIpNetTable after each thread had been signaled in turn.

    Also the XMLHTTP object has a nice event triggering capability which lets you know the status of the connection request so that you know if it was successful or not without resorting to the classic Sleep/DoEvents combo... Just a few ideas for improvement if you feel like going the extra mile.

  36. #36

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    10,323

    Re: [RESOLVED] Microsoft.XMLHTTP and searching for an IP

    Quote Originally Posted by VanGoghGaming View Post
    Very nice work, glad to see you got it working asynchronously. Have you tried using a single handle with IcmpCreateFile rather than an array of handles? I was thinking it would be cool if you made your app an ActiveX EXE so that it could spawn an additional thread per each call to IcmpSendEcho2. Then each thread would be able to close its own event handle after being signaled. In the meantime the main thread could keep checking the GetIpNetTable after each thread had been signaled in turn.

    Also the XMLHTTP object has a nice event triggering capability which lets you know the status of the connection request so that you know if it was successful or not without resorting to the classic Sleep/DoEvents combo... Just a few ideas for improvement if you feel like going the extra mile.
    Good ideas. I've got the UI working like I want though, and I've got a couple of other things I'm messing with. Not sure I'd ever consider multi-threading, but I might do some other cleanup.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width