form1.frm

本文件包含200个visual baisc实例

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "ping对方计算机"
   ClientHeight    =   3930
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5700
   LinkTopic       =   "Form1"
   ScaleHeight     =   3930
   ScaleWidth      =   5700
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   435
      Left            =   150
      TabIndex        =   15
      Top             =   3345
      Width           =   5325
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Ping"
      Height          =   615
      Left            =   3630
      TabIndex        =   9
      Top             =   225
      Width           =   1740
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   990
      TabIndex        =   1
      Text            =   "192.168.1.1"
      Top             =   135
      Width           =   2295
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   990
      TabIndex        =   0
      Text            =   "255.255.255.0"
      Top             =   525
      Width           =   2295
   End
   Begin VB.Label Label4 
      Height          =   345
      Index           =   4
      Left            =   1920
      TabIndex        =   14
      Top             =   2925
      Width           =   3495
   End
   Begin VB.Label Label4 
      Height          =   345
      Index           =   3
      Left            =   1920
      TabIndex        =   13
      Top             =   2475
      Width           =   3495
   End
   Begin VB.Label Label4 
      Height          =   345
      Index           =   2
      Left            =   1920
      TabIndex        =   12
      Top             =   1995
      Width           =   3495
   End
   Begin VB.Label Label4 
      Height          =   345
      Index           =   1
      Left            =   1920
      TabIndex        =   11
      Top             =   1545
      Width           =   3495
   End
   Begin VB.Label Label4 
      Height          =   345
      Index           =   0
      Left            =   1950
      TabIndex        =   10
      Top             =   1065
      Width           =   3495
   End
   Begin VB.Label Label1 
      Caption         =   "IP地址："
      Height          =   375
      Left            =   255
      TabIndex        =   8
      Top             =   195
      Width           =   780
   End
   Begin VB.Label Label2 
      Caption         =   "子网掩码："
      Height          =   375
      Left            =   150
      TabIndex        =   7
      Top             =   600
      Width           =   990
   End
   Begin VB.Label Label3 
      Caption         =   "测试状态："
      Height          =   360
      Index           =   0
      Left            =   150
      TabIndex        =   6
      Top             =   1065
      Width           =   1695
   End
   Begin VB.Label Label3 
      Caption         =   "地址："
      Height          =   360
      Index           =   1
      Left            =   150
      TabIndex        =   5
      Top             =   1545
      Width           =   1695
   End
   Begin VB.Label Label3 
      Caption         =   "延迟时间："
      Height          =   360
      Index           =   2
      Left            =   150
      TabIndex        =   4
      Top             =   1995
      Width           =   1695
   End
   Begin VB.Label Label3 
      Caption         =   "数据包大小"
      Height          =   360
      Index           =   3
      Left            =   150
      TabIndex        =   3
      Top             =   2475
      Width           =   1695
   End
   Begin VB.Label Label3 
      Caption         =   "数据点："
      Height          =   360
      Index           =   4
      Left            =   150
      TabIndex        =   2
      Top             =   2925
      Width           =   1695
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const WS_VERSION_REQD As Long = &H101
Private Const INADDR_NONE As Long = &HFFFFFFFF
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Const PING_TIMEOUT As Long = 500

Private Type ICMP_OPTIONS
  Ttl             As Byte
  Tos             As Byte
  Flags           As Byte
  OptionsSize     As Byte
  OptionsData     As Long
End Type

Private Type ICMP_ECHO_REPLY
  Address         As Long
  status          As Long
  RoundTripTime   As Long
  DataSize        As Long
  DataPointer     As Long
  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 WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, _
    lpWSADATA As WSADATA) As Long
    
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHost As String, _
    ByVal dwHostLen As Long) As Long
    
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHost As String) As Long

Private Declare Sub 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 Sub Command1_Click()   'ping网络计算机
  Dim ECHO As ICMP_ECHO_REPLY
  Dim pos As Long
  Dim success As Long
  Dim WSAD As WSADATA
  Dim aa As Boolean
  Dim mystr As String
  
  aa = WSAStartup(WS_VERSION_REQD, WSAD) = 0
  If aa Then
     Dim hPort As Long
     mystr = inet_addr(Text1.Text)
     If mystr <> INADDR_NONE Then
        hPort = IcmpCreateFile()
        If hPort Then
           Call IcmpSendEcho(hPort, mystr, Text2.Text, Len(Text2.Text), _
                             0, ECHO, Len(ECHO), PING_TIMEOUT)    '发送回响请求报文，返回回响应答报文
           Call IcmpCloseHandle(hPort)
        End If
        If ECHO.status = 0 Then Label4(0).Caption = "ping成功" Else Label4(0).Caption = "ping失败"
        Label4(1).Caption = ECHO.Address    '显示网络计算机地址
        Label4(2).Caption = ECHO.RoundTripTime & " ms"   '显示网络链接延迟时间
        Label4(3).Caption = ECHO.DataSize & " bytes  '显示数据包大小"
        Label4(4).Caption = ECHO.DataPointer
     End If
  End If
End Sub

Private Sub Command2_Click()
  End
End Sub