我把我以前写的代码你参考一下吧。我也是想的这个方法。
我程序的目的是只允许的客户端连接指定的服务器,非指定的程序就把这个程序给干掉。与你的目的不同。
同理的代码,不解释。
--------调用---------
'运行连接扫描
Shell "cmd /c netstat -n -o > " & path & "tmp.txt", vbHide
Timer4.Enabled = True
'开定时器
-------定时器代码------
On Error Resume Next
Timer4.Enabled = False
Dim pro As Object
Dim obj As Object
Dim B As Boolean
Dim lPHand As Long
Dim TMBack As Long
Set pro = GetObject("winmgmts:\\.\root\cimv2").execquery("select * from win32_process where name='netstat.exe' ")
For Each obj In pro
'Debug.Print LCase(obj.Name)
If LCase(obj.Name) = "netstat.exe" Then
B = True
lPHand = OpenProcess(1&, True, obj.Handle)
'获取进程句柄
TMBack = TerminateProcess(lPHand, 0&)
'关闭进程
'关闭被Kill进程的所以句柄
CloseHandle lPHand
End If
Next
If B Then
'发现有进程后,KILL后重新启动
If Dir(path & "tmp.txt") <> "" Then
Kill path & "tmp.txt"
'删除临时文件
End If
Shell "cmd /c netstat -n -o > " & path & "tmp.txt", vbHide
Timer4.Enabled = True
Else
If Dir(path & "tmp.txt") <> "" Then
Dim s As Variant
Dim fj() As String
Dim fj2() As String
Dim k As Long
Dim TitleStr As String * 255
Dim h As Long
Dim m_Hwnd As Long
s = 打开文件(path & "tmp.txt")
Kill path & "tmp.txt"
fj = Split(s, vbCrLf)
For Each s In fj
s = Trim(s)
If Len(s) > 0 Then
Do
'使用循环继续换,在最前面还是会有一个'
k = Len(s)
s = Replace(s, "
", " ")
Loop While k <> Len(s)
fj2 = Split(s, " ")
If UBound(fj2) = 4 Then
If fj2(2) = serverIP & ":" & 远程端口 Then
'如果连接了远程端口的
If fj2(4) <> "0" Then
Set pro = GetObject("winmgmts:\\.\root\cimv2").execquery("select * from win32_process ")
For Each obj In pro
If obj.Handle = Val(fj2(4)) And LCase(obj.Name) <> LCase(clientname) Then
'但并不是客户端
If 显示消息 Then
Msg "发现非法程序:" & obj.Name, vbCritical, 消息标题
End If
lPHand = OpenProcess(1&, True, obj.Handle)
'获取进程句柄
TMBack = TerminateProcess(lPHand, 0&)
'关闭进程
'关闭被Kill进程的所以句柄
CloseHandle lPHand
End If
Next
End If
End If
End If
End If
Next
Else
'没有找到 tmp.txt 则重新生成
Shell "cmd /c netstat -n -o > " & path & "tmp.txt", vbHide
Timer4.Enabled = True
End If
End If