form1.frm

根据IP地址

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Ping"
   ClientHeight    =   3645
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9915
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3645
   ScaleWidth      =   9915
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   5040
      Top             =   600
   End
   Begin VB.Frame Frame1 
      Height          =   3615
      Left            =   1680
      TabIndex        =   0
      Top             =   0
      Width           =   4575
      Begin VB.TextBox Text2 
         Height          =   270
         Left            =   1080
         TabIndex        =   18
         Top             =   240
         Width           =   2175
      End
      Begin VB.CommandButton Command5 
         Caption         =   "开始扫描"
         Height          =   375
         Left            =   960
         TabIndex        =   17
         ToolTipText     =   "开始扫描"
         Top             =   3120
         Width           =   980
      End
      Begin VB.CommandButton Command4 
         Caption         =   "保存结果"
         Height          =   375
         Left            =   3360
         TabIndex        =   12
         ToolTipText     =   "保存扫描结果"
         Top             =   3120
         Width           =   980
      End
      Begin VB.TextBox Text1 
         Height          =   315
         Index           =   6
         Left            =   120
         TabIndex        =   11
         Text            =   "MAC"
         Top             =   2760
         Width           =   4335
      End
      Begin VB.CommandButton Command3 
         Caption         =   "重建列表"
         Height          =   375
         Left            =   3360
         TabIndex        =   10
         ToolTipText     =   "重建IP扫描列表"
         Top             =   160
         Width           =   980
      End
      Begin VB.CommandButton Command2 
         Caption         =   "停止扫描"
         Height          =   375
         Left            =   2160
         TabIndex        =   9
         ToolTipText     =   "停止扫描"
         Top             =   3120
         Width           =   980
      End
      Begin VB.CommandButton Command1 
         Caption         =   "Ping"
         Height          =   375
         Left            =   120
         TabIndex        =   7
         ToolTipText     =   "双击列表，开始扫描"
         Top             =   3120
         Width           =   735
      End
      Begin VB.TextBox Text1 
         Height          =   315
         Index           =   0
         Left            =   120
         TabIndex        =   6
         Text            =   "status"
         Top             =   660
         Width           =   4335
      End
      Begin VB.TextBox Text1 
         Height          =   315
         Index           =   1
         Left            =   120
         TabIndex        =   5
         Text            =   "Address"
         Top             =   1500
         Width           =   4335
      End
      Begin VB.TextBox Text1 
         Height          =   315
         Index           =   2
         Left            =   120
         TabIndex        =   4
         Text            =   "RoundTripTime"
         Top             =   1080
         Width           =   2055
      End
      Begin VB.TextBox Text1 
         Height          =   315
         Index           =   3
         Left            =   120
         TabIndex        =   3
         Text            =   "DataSize"
         Top             =   1920
         Width           =   4335
      End
      Begin VB.TextBox Text1 
         Height          =   315
         Index           =   4
         Left            =   2400
         TabIndex        =   2
         Text            =   "Data"
         Top             =   1080
         Width           =   2055
      End
      Begin VB.TextBox Text1 
         Height          =   315
         Index           =   5
         Left            =   120
         TabIndex        =   1
         Text            =   "DataPointer"
         Top             =   2340
         Width           =   4335
      End
      Begin VB.Label Label2 
         Caption         =   "本机地址："
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   240
         Width           =   975
      End
   End
   Begin VB.Frame Frame3 
      Caption         =   "扫描结果"
      Height          =   3615
      Left            =   6240
      TabIndex        =   15
      Top             =   0
      Width           =   3615
      Begin VB.ListBox List2 
         Height          =   3300
         Left            =   120
         TabIndex        =   16
         Top             =   200
         Width           =   3375
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "扫描列表"
      Height          =   3615
      Left            =   0
      TabIndex        =   13
      Top             =   0
      Width           =   1695
      Begin VB.ListBox List1 
         Height          =   3300
         Left            =   50
         TabIndex        =   14
         ToolTipText     =   "双击列表，开始扫描"
         Top             =   200
         Width           =   1575
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
   Dim IpAddr As String
Private Const ERROR_SUCCESS As Long = 0
Private Const MAX_ADAPTER_NAME_LENGTH As Long = 256
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 128
Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8

Private Type IP_ADDRESS_STRING
   IpAddr(0 To 15) As Byte
End Type

Private Type IP_MASK_STRING
   IpMask(0 To 15) As Byte
End Type

Private Type IP_ADDR_STRING
   dwNext As Long
   IpAddress As IP_ADDRESS_STRING
   IpMask As IP_MASK_STRING
   dwContext As Long
End Type

Private Type IP_ADAPTER_INFO
   dwNext As Long
   ComboIndex As Long  'reserved
   sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3)) As Byte
   sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte
   dwAddressLength As Long
   sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1)) As Byte
   dwIndex As Long
   uType As Long
   uDhcpEnabled As Long
   CurrentIpAddress As Long
   IpAddressList As IP_ADDR_STRING
   GatewayList As IP_ADDR_STRING
   DhcpServer As IP_ADDR_STRING
   bHaveWins As Long
   PrimaryWinsServer As IP_ADDR_STRING
   SecondaryWinsServer As IP_ADDR_STRING
   LeaseObtained As Long
   LeaseExpires As Long
End Type

Private Declare Function GetAdaptersInfo Lib "iphlpapi.dll" (pTcpTable As Any, pdwSize As Long) As Long
   
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dst As Any, src As Any, ByVal bcount As Long)

Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long

Private Sub Command1_Click()
   
   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

   If IpAddr = "" Then IpAddr = InputBox("Input the IP address to ping:", , "127.0.0.1")
   If IpAddr = "" Then Exit Sub
   
   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