vb实现ping
来源:互联网 发布:网络精灵国语版 编辑:程序博客网 时间:2024/05/01 18:26
'改良了下
'原来4秒刷一次,现在0.3秒刷一次
'现在只返回毫秒了
'你是不是为了玩山口山啊?
'2个TextBox :
Text1 - 输入ip
Text2 - 显示结果
'1个Timer : Timer1
'1个CommandButton : Command1
Option Explicit
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESTDHANDLES = &H100&
Private Const STARTF_USESHOWWINDOW = &H1
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const FLAG = SWP_NOMOVE Or SWP_NOSIZE
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const HWND_TOP = 0
Const HWND_BOTTOM = 1
Dim Proc As PROCESS_INFORMATION '进程信息
Dim Start As STARTUPINFO '启动信息
Dim SecAttr As SECURITY_ATTRIBUTES '安全属性
Dim hReadPipe As Long '读取管道句柄
Dim hWritePipe As Long '写入管道句柄
Dim lngBytesRead As Long '读出数据的字节数
Dim strBuffer As String * 256 '读取管道的字符串buffer
Dim Command As String 'DOS命令
Dim ret As Long 'API函数返回值
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, _
ByVal y As Long, ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Sub Command1_Click()
If Not InitPipe Then
Exit Sub
Else
'init
Dim s As String
s = ReadPipe
'Me.Text2.Text = s
Me.Timer1.Enabled = True
End If
End Sub
Private Sub Form_Load()
Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAG)
Me.Command1.Caption = "Start"
Me.Timer1.Enabled = False
Me.Timer1.Interval = 300
Me.Text1.Text = "222.210.27.114"
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
ClosePipe
End Sub
Private Sub Timer1_Timer()
Dim strPipe As String
On Error Resume Next
strPipe = ReadPipe()
If Len(strPipe) > 0 Then
If InStr(1, strPipe, "time") > 0 Then
Dim lPosStart As Long
Dim lPosEnd As Long
Dim sMS As String
lPosStart = InStr(strPipe, "time=")
lPosEnd = InStr(strPipe, "ms")
sMS = Mid(strPipe, lPosStart + 5, lPosEnd - lPosStart - 5)
'Text2.Text = Now & "==============>" & vbCrLf & strPipe & vbCrLf & Text2.Text
Text2.Text = sMS & vbCrLf & Text2.Text
End If
End If
End Sub
Private Function InitPipe() As Boolean
'设置安全属性
With SecAttr
.nLength = LenB(SecAttr)
.bInheritHandle = True
.lpSecurityDescriptor = 0
End With
'创建管道
ret = CreatePipe(hReadPipe, hWritePipe, SecAttr, 0)
If ret = 0 Then
MsgBox "无法创建管道", vbExclamation, "错误"
GoTo ErrHdr
End If
'设置进程启动前的信息
With Start
.cb = LenB(Start)
.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
.hStdOutput = hWritePipe '设置输出管道
.hStdError = hWritePipe '设置错误管道
End With
'启动进程
Command = "c:\windows\system32\ping.exe -t " & Me.Text1.Text 'DOS进程以ipconfig.exe为例
ret = CreateProcess(vbNullString, Command, SecAttr, SecAttr, True, NORMAL_PRIORITY_CLASS, ByVal 0, vbNullString, Start, Proc)
If ret = 0 Then
MsgBox "无法启动新进程", vbExclamation, "错误"
ret = CloseHandle(hWritePipe)
ret = CloseHandle(hReadPipe)
GoTo ErrHdr
End If
If False Then
ErrHdr:
InitPipe = False
Exit Function
End If
InitPipe = True
End Function
Private Function ReadPipe() As String
Dim lpOutputs As String
'因为无需写入数据,所以先关闭写入管道。而且这里必须关闭此管道,否则将无法读取数据
ret = CloseHandle(hWritePipe)
'从输出管道读取数据,每次最多读取256字节
ret = ReadFile(hReadPipe, strBuffer, 256, lngBytesRead, ByVal 0)
lpOutputs = lpOutputs & Left(strBuffer, lngBytesRead)
ReadPipe = lpOutputs
End Function
Private Sub ClosePipe()
On Error Resume Next
'读取操作完成,关闭各句柄
ret = CloseHandle(Proc.hProcess)
ret = CloseHandle(Proc.hThread)
ret = CloseHandle(hReadPipe)
End Sub
**************************************************
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Command1_Click()
Dim i As Integer
Dim q As String
Shell "cmd.exe /c ping 10.2.31.1 -t > c:\1.txt", vbHide
On Error Resume Next
For i = 1 To 100
List1.Clear
Open "c:\1.txt" For Input As #1
If Err.Number = 0 Then
While Not EOF(1)
Line Input #1, q
If Trim(q) <> "" Then List1.AddItem q ' Text1.Text = Text1.Text & vbCrLf & q
Wend
End If
Close #1
Err.Clear
DoEvents
Sleep 500
Next i
Kill "c:\1.txt"
End Sub
- vb实现ping
- vb实现ping
- VB实现ping指定IP
- VB中Ping功能的实现
- VB中使用ping
- ping实现
- ping实现
- vb.net做的ping
- 用vb来Ping的源代码
- 用jni实现ping
- Socket API实现PING
- C#中实现Ping
- java 实现ping功能
- ping简单实现
- C#实现Ping
- 用delphi实现ping
- php实现ping
- C# 实现Ping
- Iphone 监测网络状态,经测试是可行的
- Android组件之ListView(列表视图)
- vb实现ping
- 使用PIVOT运算符实现交叉表
- 批量添加用户
- vb实现ping
- mini2440的pwm驱动程序和测试程序详解
- asp.net cookie 获取时中文乱码问题
- (转)图形图像处理-之-高质量的快速的图像缩放 上篇 近邻取样插值和其速度优化
- 基于S3C2440和linux的多路步进电机驱动设计
- (转)图形图像处理-之-高质量的快速的图像缩放 中篇 二次线性插值和三次卷积插值
- flex调用js写文件时,传递的参数包含中文,读取乱码问题
- 实例解析linux内核I2C体系结构(1)
- PHP性能优化