![]() |
#2
lianyicq2015-02-09 08:26
|

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Const PROCESS_QUERY_INFORMATION = &H400
Const STILL_ALIVE = &H103
'...........................
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (lpszSoundName As Any, ByVal uFlags As Long) As Long
Const SND_ASYNC = &H1
Const SND_MEMORY = &H4
Dim ifConnect As Boolean
Private Sub Form_Load()
Text3.Text = "30810"
Timer1.Interval = 3000
Dim Toms() As Byte
Toms = LoadResData(101, "CUSTOM")
sndPlaySound Toms(0), SND_MEMORY Or SND_ASYNC
End Sub
Private Sub Timer1_Timer()
Dim pId As Long, pHnd As Long
If Dir("C:\temp.txt") <> "" Then Kill "C:\temp.txt"
pId = Shell("cmd /c netstat -an>>C:\temp.txt", vbMinimizedFocus)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pId)
Do
Call GetExitCodeProcess(hProcess, ExitCode)
DoEvents
Loop While ExitCode = STILL_ALIVE
Call CloseHandle(hProcess)
Close #1
Command1_Click
Timer1.Interval = 0
Timer2.Interval = 3000
End Sub
Private Sub Command1_Click()
Open "c:\temp.txt" For Input As #1
While Not EOF(1)
Line Input #1, s
p = InStr(s, Text1.Text) '在text1中输入查找关键字
If p <> 0 Then Text2 = Text2 & vbCrLf & Mid(s, p + Len(Text1.Text) + 1, 5) '& vbCrLf
Wend
Close
End Sub
Private Sub Timer2_Timer()
If Text3.Text = Text2.Text Then
Label1.Caption = "网络良好,通讯正常!"
Else
Dim Toms() As Byte
Toms = LoadResData(102, "CUSTOM")
sndPlaySound Toms(0), SND_MEMORY Or SND_ASYNC
Form3.Caption = "通讯中断"
Label1.Caption = "通讯中断"
End If
Timer2.Interval = 0
Timer3.Interval = 3000
End Sub
Private Sub Timer3_Timer()
Text2.Text = ""
Timer1.Interval = 3000
Timer3.Interval = 0
End Sub
在调试时老是Timer2_Timer的判断出现错误,在判断中,明明text2.text = text3.text 运行时老是说不相等,百思不得其解。改变成这样就对,If Text2.Text = "30810"Then ,但是也有弊端,如果在C:\temp.txt 查不到相关内容,程序就会报错。Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Const PROCESS_QUERY_INFORMATION = &H400
Const STILL_ALIVE = &H103
'...........................
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (lpszSoundName As Any, ByVal uFlags As Long) As Long
Const SND_ASYNC = &H1
Const SND_MEMORY = &H4
Dim ifConnect As Boolean
Private Sub Form_Load()
Text3.Text = "30810"
Timer1.Interval = 3000
Dim Toms() As Byte
Toms = LoadResData(101, "CUSTOM")
sndPlaySound Toms(0), SND_MEMORY Or SND_ASYNC
End Sub
Private Sub Timer1_Timer()
Dim pId As Long, pHnd As Long
If Dir("C:\temp.txt") <> "" Then Kill "C:\temp.txt"
pId = Shell("cmd /c netstat -an>>C:\temp.txt", vbMinimizedFocus)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pId)
Do
Call GetExitCodeProcess(hProcess, ExitCode)
DoEvents
Loop While ExitCode = STILL_ALIVE
Call CloseHandle(hProcess)
Close #1
Command1_Click
Timer1.Interval = 0
Timer2.Interval = 3000
End Sub
Private Sub Command1_Click()
Open "c:\temp.txt" For Input As #1
While Not EOF(1)
Line Input #1, s
p = InStr(s, Text1.Text) '在text1中输入查找关键字
If p <> 0 Then Text2 = Text2 & vbCrLf & Mid(s, p + Len(Text1.Text) + 1, 5) '& vbCrLf
Wend
Close
End Sub
Private Sub Timer2_Timer()
If Text3.Text = Text2.Text Then
Label1.Caption = "网络良好,通讯正常!"
Else
Dim Toms() As Byte
Toms = LoadResData(102, "CUSTOM")
sndPlaySound Toms(0), SND_MEMORY Or SND_ASYNC
Form3.Caption = "通讯中断"
Label1.Caption = "通讯中断"
End If
Timer2.Interval = 0
Timer3.Interval = 3000
End Sub
Private Sub Timer3_Timer()
Text2.Text = ""
Timer1.Interval = 3000
Timer3.Interval = 0
End Sub
请各位看看是怎么回事。

Private Sub Command1_Click()
Open "c:\temp.txt" For Input As #1
While Not EOF(1)
Line Input #1, s
p = InStr(s, Text1.Text) '在text1中输入查找关键字
If p <> 0 Then Text2 = Text2 & vbCrLf & Mid(s, p + Len(Text1.Text) + 1, 5) '& vbCrLf
Wend
Close
End Sub
估计是这段出现错误,是不是读取到text2.text里面的值与text3.text设定值有区别,但是观察是一致,Open "c:\temp.txt" For Input As #1
While Not EOF(1)
Line Input #1, s
p = InStr(s, Text1.Text) '在text1中输入查找关键字
If p <> 0 Then Text2 = Text2 & vbCrLf & Mid(s, p + Len(Text1.Text) + 1, 5) '& vbCrLf
Wend
Close
End Sub
[ 本帖最后由 lzb3158 于 2015-2-8 23:36 编辑 ]