form1.frm

根据IP地址

   Text1(6) = ""
   
    delay 0.2
    On Error Resume Next
    If IpAddr <> Text2.Text Then
        If FileCheck(GetWinPath + "\temp\_PIPF49A4.bat") Then Kill GetWinPath + "\temp\_PIPF49A4.bat"
        If FileCheck(GetWinPath + "\temp\_PIPF49A4.tmp") Then Kill GetWinPath + "\temp\_PIPF49A4.tmp"
        ShellStr = "ARP -a " & IpAddr & " >" + GetWinPath + "\temp\_PIPF49A4.tmp"
        ShellFile = GetWinPath + "\temp\_PIPF49A4.bat"
        Open ShellFile For Binary Access Write As #1
        Put #1, , ShellStr
        Close #1
        Shell ShellFile, vbHide
    
        delay 0.5
        
        Open GetWinPath + "\temp\_PIPF49A4.tmp" For Input Access Read As #1
        Do While Not EOF(1)
            Line Input #1, Lstr
            Found = False
            If InStr(Lstr, IpAddr & " ") Then
                Lstr = Trim(Lstr)
                If InStr(Lstr, "static") Then
                    Found = True
                    Lstr = Replace(Lstr, "static", "")
                    Lstr = Replace(Lstr, IpAddr, "")
                    Lstr = Replace(Lstr, " ", "")
                    Text1(6) = Lstr
                End If
                If InStr(Lstr, "dynamic") Then
                    Found = True
                    Lstr = Replace(Lstr, "dynamic", "")
                    Lstr = Replace(Lstr, IpAddr, "")
                    Lstr = Replace(Lstr, " ", "")
                    Text1(6) = Lstr
                End If
           End If
        Loop
        Close #1
        If FileCheck(GetWinPath + "\temp\_PIPF49A4.bat") Then Kill GetWinPath + "\temp\_PIPF49A4.bat"
        If FileCheck(GetWinPath + "\temp\_PIPF49A4.tmp") Then Kill GetWinPath + "\temp\_PIPF49A4.tmp"
    Else
        ShellStr = "ipconfig.exe /all >" + GetWinPath + "\temp\_PIPF49A8.tmp"
        ShellFile = GetWinPath + "\temp\_PIPF49A8.bat"
        Open ShellFile For Binary Access Write As #1
        Put #1, , ShellStr
        Close #1
        Shell ShellFile, vbHide
        delay 0.5
        Open GetWinPath + "\temp\_PIPF49A8.tmp" For Input Access Read As #1
        Do While Not EOF(1)
            Line Input #1, Lstr
            If Trim(Lstr) <> "" Then
                Lstr = Replace(Lstr, ". ", "")
                Lstr = Replace(Lstr, ":", "")
                Lstr = Replace(Lstr, " ", "")
                If InStr(Lstr, "PhysicalAddress") Then
                    Lstr = Replace(Lstr, "PhysicalAddress", "")
                    Text1(6) = LCase(Lstr)
                End If
           End If
        Loop
        Close #1
        If FileCheck(GetWinPath + "\temp\_PIPF49A8.bat") Then Kill GetWinPath + "\temp\_PIPF49A8.bat"
        If FileCheck(GetWinPath + "\temp\_PIPF49A8.tmp") Then Kill GetWinPath + "\temp\_PIPF49A8.tmp"
   End If
   If ECHO.DataSize <> 0 Or Found Then List2.AddItem Left(IpAddr & "                 ", 17) & Text1(6)
   IpAddr = ""
   
End Sub

Private Function LocalIPAddress() As String
   
   Dim cbRequired As Long
   Dim buff() As Byte
   Dim ptr1 As Long
   Dim sIPAddr As String
   Dim Adapter As IP_ADAPTER_INFO
   
   Call GetAdaptersInfo(ByVal 0&, cbRequired)

   If cbRequired > 0 Then
    
      ReDim buff(0 To cbRequired - 1) As Byte
      
      If GetAdaptersInfo(buff(0), cbRequired) = ERROR_SUCCESS Then
      
        'get a pointer to the data stored in buff()
         ptr1 = VarPtr(buff(0))

         Do While (ptr1 <> 0)
         
           'copy the data from the pointer to the
           'first adapter into the IP_ADAPTER_INFO type
            CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
         
            With Adapter
                       
              'the DHCP IP address is in the
              'IpAddress.IpAddr member
                 
               sIPAddr = TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode))
                  
               If Len(sIPAddr) > 0 Then Exit Do

               ptr1 = .dwNext
                              
            End With  'With Adapter
            
        'ptr1 is 0 when (no more adapters)
         Loop  'Do While (ptr1 <> 0)

      End If  'If GetAdaptersInfo
   End If  'If cbRequired > 0

  'return any string found
   LocalIPAddress = sIPAddr
   
End Function


Private Function TrimNull(startstr As String) As String

   TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
   
End Function

Private Sub Command2_Click()
Timer1.Enabled = False
End Sub

Private Sub Command3_Click()
Dim sip As String
Dim i As Integer
List1.Clear
List2.Clear
sip = Mid(Text2, 1, InStrRev(Text2, "."))
For i = 1 To 254
List1.AddItem sip & CStr(i)
Next i

End Sub

Private Sub Command4_Click()
Dim i As Integer
    If FileCheck(App.Path & "\ComputerMAC.txt") Then Kill App.Path & "\ComputerMAC.txt"
    Open App.Path & "\ComputerMAC.txt" For Binary Access Write As #1
    For i = 0 To List2.ListCount - 1
        Put #1, , List2.List(i) & vbCrLf
    Next i
    Close #1
MsgBox "计算机IP和MAC已保存完毕", vbInformation, "提示信息"
    Shell "notepad " & App.Path & "\ComputerMAC.txt", vbNormalFocus
End Sub

Private Sub Command5_Click()
    If List1.ListIndex < 0 Then List1.ListIndex = 0
    IpAddr = List1.List(List1.ListIndex)
    Command1_Click
    Timer1.Enabled = True
End Sub

Private Sub Form_Load()
Dim sip As String
Dim i As Integer
Text2.Text = LocalIPAddress()
sip = Mid(Text2, 1, InStrRev(Text2, "."))
For i = 1 To 254
List1.AddItem sip & CStr(i)
Next i

End Sub

Private Sub Form_Unload(Cancel As Integer)
    Timer1.Enabled = False
    End
End Sub

Private Sub List1_Click()
   IpAddr = List1.List(List1.ListIndex)
End Sub
Private Sub List1_dblClick()
   IpAddr = List1.List(List1.ListIndex)
    Command1_Click
    Timer1.Enabled = True
End Sub

Private Sub List2_dblClick()
Dim IpAddr As String
   Dim ECHO As ICMP_ECHO_REPLY
   Dim pos As Integer
    Dim ShellFile As String
    Dim ShellStr As String
    Dim Lstr As String
     Dim Found As Boolean
 'ping an ip address, passing the
  'address and the ECHO structure
  
   IpAddr = Trim(Left(List2.List(List2.ListIndex), 17))

   Call Ping(IpAddr, ECHO)
   Me.Caption = "Ping - " & IpAddr
  'display the results from the ECHO structure
   Text1(0) = GetStatusCode(ECHO.status)
   Text1(1) = ECHO.Address
   Text1(2) = ECHO.RoundTripTime & " ms"
   Text1(3) = ECHO.DataSize & " bytes"
   
   If Left$(ECHO.Data, 1) <> Chr$(0) Then
      pos = InStr(ECHO.Data, Chr$(0))
      Text1(4) = Left$(ECHO.Data, pos - 1)
   End If

   Text1(5) = ECHO.DataPointer
   Text1(6) = ""
   
    delay 0.2
    On Error Resume Next
    ShellStr = "ARP -a " & IpAddr & " >" + GetWinPath + "\temp\_PIPF49A3.tmp"
    ShellFile = GetWinPath + "\temp\_PIPF49A3.bat"
    Open ShellFile For Binary Access Write As #1
    Put #1, , ShellStr
    Close #1
    Shell ShellFile, vbHide

    delay 0.5
    
    Open GetWinPath + "\temp\_PIPF49A3.tmp" For Input Access Read As #1
    Do While Not EOF(1)
        Line Input #1, Lstr
        Found = False
        If InStr(Lstr, IpAddr & " ") Then
            Lstr = Trim(Lstr)
            If InStr(Lstr, "static") Then
                Found = True
                Lstr = Replace(Lstr, "static", "")
                Lstr = Replace(Lstr, IpAddr, "")
                Lstr = Replace(Lstr, " ", "")
                Text1(6) = Lstr
            End If
            If InStr(Lstr, "dynamic") Then
                Found = True
                Lstr = Replace(Lstr, "dynamic", "")
                Lstr = Replace(Lstr, IpAddr, "")
                Lstr = Replace(Lstr, " ", "")
                Text1(6) = Lstr
            End If
       End If
    Loop
    Close #1
    If FileCheck(GetWinPath + "\temp\_PIPF49A3.bat") Then Kill GetWinPath + "\temp\_PIPF49A3.bat"
    If FileCheck(GetWinPath + "\temp\_PIPF49A3.tmp") Then Kill GetWinPath + "\temp\_PIPF49A3.tmp"

   If ECHO.DataSize <> 0 Or Found Then List2.List(List2.ListIndex) = Left(IpAddr & "                 ", 17) & Text1(6)
End Sub

Private Sub Timer1_Timer()
    If List1.ListIndex < List1.ListCount - 1 Then
        List1.ListIndex = List1.ListIndex + 1
        IpAddr = List1.List(List1.ListIndex)
        Command1_Click
    End If
End Sub