VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "不停的ping~~~"
   ClientHeight    =   2952
   ClientLeft      =   36
   ClientTop       =   420
   ClientWidth     =   4344
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2952
   ScaleWidth      =   4344
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1 
      Interval        =   60000
      Left            =   360
      Top             =   3600
   End
   Begin VB.Image Image1 
      Height          =   2136
      Left            =   240
      Picture         =   "Form1.frx":038A
      Top             =   360
      Width           =   3720
   End
   Begin VB.Menu rightButtonMenu 
      Caption         =   "aaaa"
      Visible         =   0   'False
      Begin VB.Menu mnuShow 
         Caption         =   "显示"
      End
      Begin VB.Menu mnuHide 
         Caption         =   "隐藏"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出.."
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const SYNCHRONIZE = &H100000
Private Const INFINITE = &HFFFFFFFF
 
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const serverIP = "192.168.2.1"

'---托盘图标
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private Type NOTIFYICONDATA
        cbSize As Long
        hwnd As Long
        uID As Long
        uFlags As Long
        uCallbackMessage As Long
        hIcon As Long
        szTip As String * 64
End Type
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Dim Nid As NOTIFYICONDATA

Private Sub c_Click()

End Sub

Private Sub Form_Load()
    If App.PrevInstance Then Unload Me
    Nid.cbSize = Len(Nid)
    Nid.hwnd = hwnd
    Nid.uID = vbNull
    Nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    Nid.uCallbackMessage = WM_MOUSEMOVE
    Nid.hIcon = Form1.Icon
    Nid.szTip = "ping服务器的小程序" & vbNullChar
    Shell_NotifyIcon NIM_ADD, Nid
    
    '隐藏
    Me.Hide
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim msg As Single
    On Error Resume Next
    msg = X / Screen.TwipsPerPixelX
    Select Case msg
        Case WM_RBUTTONDOWN
        Case WM_RBUTTONUP
            PopupMenu rightButtonMenu '右键显示菜单
        Case WM_LBUTTONDBLCLK
            Form1.Show
    End Select
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Shell_NotifyIcon NIM_DELETE, Nid
End Sub

Private Sub Image1_Click()
    Form1.Hide
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuHide_Click()
    Form1.Hide
End Sub

Private Sub mnuShow_Click()
    Form1.Show
End Sub

Private Sub DoWork()
    Dim lngPId As Long
    Dim lngPHandle As Long
    
    '执行ipconfig
    lngPId = Shell("cmd /c " & "ping " & serverIP & " >c:\pingPLTServer.txt", vbHide)
    lngPHandle = OpenProcess(SYNCHRONIZE, 0, lngPId)
    If lngPHandle <> 0 Then
        Call WaitForSingleObject(lngPHandle, INFINITE) '无限等待，直到程式结束
        Call CloseHandle(lngPHandle)
    End If
    
    content = getFileContent()
    If content <> "" Then
        If InStr(content, "timed out") > 0 Then
            MsgBox ("ping 服务器 " & serverIP & "超时" & vbCrLf & "------------- " & vbCrLf & content), vbSystemModal
        End If
    End If
End Sub

'取得文件内容
Private Function getFileContent()

    getFileContent = ""
    
    '文件路径
    filePath = "c:\pingPLTServer.txt"
    
    '判断文件是否存在
    If Dir(filePath) = "" Then
        Exit Function
    End If
    
    '读入文件内容
    Dim strAll As String
    Dim str As String
    Open filePath For Input As #1
    If LOF(1) > 0 Then '文件长度大于0，才读入
        Do While Not EOF(1)
            Input #1, str
            strAll = strAll & str & vbCrLf
        Loop
    End If
    Close #1
    
    getFileContent = strAll
End Function

Private Sub Timer1_Timer()
    Call DoWork
End Sub