form1.frm

该小程序是老师布置的一个实验

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6300
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9075
   LinkTopic       =   "Form1"
   ScaleHeight     =   6300
   ScaleWidth      =   9075
   StartUpPosition =   3  '窗口缺省
   Begin VB.ListBox List1 
      Height          =   2760
      ItemData        =   "Form1.frx":0000
      Left            =   5160
      List            =   "Form1.frx":0002
      TabIndex        =   10
      Top             =   2280
      Width           =   3375
   End
   Begin VB.CommandButton Command3 
      Caption         =   "退出程序"
      Height          =   495
      Left            =   3000
      TabIndex        =   5
      Top             =   5280
      Width           =   975
   End
   Begin VB.CommandButton Command2 
      Caption         =   "停止获取"
      Height          =   495
      Left            =   1680
      TabIndex        =   4
      Top             =   5280
      Width           =   975
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   1440
      TabIndex        =   3
      Top             =   3600
      Width           =   2655
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   1440
      TabIndex        =   2
      Top             =   2640
      Width           =   2655
   End
   Begin VB.CommandButton Command1 
      Caption         =   "开始获取"
      Height          =   495
      Left            =   240
      TabIndex        =   0
      Top             =   5280
      Width           =   1095
   End
   Begin VB.Frame Frame1 
      Caption         =   "局域网IP"
      Height          =   2655
      Left            =   120
      TabIndex        =   6
      Top             =   2280
      Width           =   4575
      Begin VB.Label Label3 
         Caption         =   "结束IP："
         Height          =   375
         Left            =   480
         TabIndex        =   9
         Top             =   1320
         Width           =   735
      End
      Begin VB.Label Label2 
         Caption         =   "开始IP："
         Height          =   375
         Index           =   0
         Left            =   480
         TabIndex        =   7
         Top             =   480
         Width           =   735
      End
   End
   Begin VB.Label Label2 
      Caption         =   "开始IP："
      Height          =   375
      Index           =   1
      Left            =   480
      TabIndex        =   8
      Top             =   3600
      Width           =   735
   End
   Begin VB.Label Label1 
      Height          =   1815
      Left            =   600
      TabIndex        =   1
      Top             =   240
      Width           =   7815
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const NO_ERROR = 0
Private Declare Function inet_addr Lib "wsock32.dll" (ByVal s As String) As Long
Private Declare Function inet_ntoa Lib "ws2_32.dll" (ByVal inn As Long) As Long
Private Declare Function SendARP Lib "iphlpapi.dll" (ByVal DestIP As Long, ByVal SrcIP As Long, pMacAddr As Long, PhyAddrLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dst As Any, src As Any, ByVal bcount As Long)





Private Sub Form_load()
 
    Dim strComputer As String
    Dim objWMI      As Object
    Dim colIP       As Object
    Dim IP          As Object
    Dim I           As Integer
    Dim s           As String
    Dim Text        As String
    Dim n
    
    strComputer = "."
    Set objWMI = GetObject("winmgmts://" & strComputer & "/root/cimv2")
    Set colIP = objWMI.ExecQuery _
        ("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
    For Each IP In colIP
        If Not IsNull(IP.IPAddress) Then
           For I = LBound(IP.IPAddress) To UBound(IP.IPAddress)
            s = "本机IP :" & IP.IPAddress(I) & Chr(10) & "网卡类型:" & IP.Description(I) & Chr(10) & "网卡地址:" & IP.Macaddress(I)
            Label1.Caption = s
            n = InStrRev(CStr(IP.IPAddress(I)), ".")
            Text1.Text = Left$(CStr(IP.IPAddress(I)), n) & "0"
            Text2.Text = Left$(CStr(IP.IPAddress(I)), n) & "255"
            
           Next
        End If
    Next
    
End Sub


Private Function GetRemoteMACAddress(ByVal sRemoteIP As String, sRemoteMacAddress As String) As Boolean
  Dim dwRemoteIP  As Long
  Dim pMacAddr    As Long
  Dim bpMacAddr() As Byte
  Dim PhyAddrLen  As Long
  Dim cnt         As Long
  Dim tmp         As String
    

  dwRemoteIP = inet_addr(sRemoteIP)
  If dwRemoteIP <> 0 Then
     PhyAddrLen = 6
     If SendARP(dwRemoteIP, 0&, pMacAddr, PhyAddrLen) = NO_ERROR Then
        If pMacAddr <> 0 And PhyAddrLen <> 0 Then
           ReDim bpMacAddr(0 To PhyAddrLen - 1)
           CopyMemory bpMacAddr(0), pMacAddr, ByVal PhyAddrLen
           For cnt = 0 To PhyAddrLen - 1
              If bpMacAddr(cnt) = 0 Then
                  tmp = tmp & "00-"
                ElseIf bpMacAddr(cnt) < 10 Then
                  tmp = tmp & "0" & Hex$(bpMacAddr(cnt)) & "-"
                Else
                  tmp = tmp & Hex$(bpMacAddr(cnt)) & "-"
              End If
           Next
           If Len(tmp) > 0 Then
              sRemoteMacAddress = Left$(tmp, Len(tmp) - 1)
              GetRemoteMACAddress = True
           End If
           Exit Function
        Else
          GetRemoteMACAddress = False
        End If
     Else
        GetRemoteMACAddress = False
     End If
  Else
    GetRemoteMACAddress = False
  End If
End Function

Private Sub Command1_Click()
   Dim sRemoteIP         As String
   Dim sRemoteMacAddress As String
   Dim count             As Integer
   Dim b                 As Boolean
   
   b = True
   List1.Clear
     n = InStrRev(Text1.Text, ".")
     count = Val(Mid(Text2.Text, n + 1)) - Val(Mid(Text1.Text, n + 1))
     For I = 0 To count - 1 Step 1
        sRemoteIP = Left$(Text1.Text, n) & Val(Mid(Text1.Text, n + 1)) + I
         If GetRemoteMACAddress(sRemoteIP, sRemoteMacAddress) Then
              List1.AddItem sRemoteIP & ":" & sRemoteMacAddress
         
         End If
         Next
End Sub

Private Sub Command3_Click()
End
End Sub
Private Sub Command2_Click()
b = False

End Sub