怎么用vb实现输入(ip地址,本地端口号,和,远程端口号,)判断出那个程序在使用这个ip地址,本地端口号,和,远程端口号???

时间:2022-02-04 18:13:11
怎么用vb实现输入(ip地址,本地端口号,和,远程端口号,)判断出那个程序在使用这个ip地址,本地端口号,和,远程端口号???
----------------------------------------------------------------------------------------------------
例如:ip地址211.100.26.98 ,输入本地端口号 1912 和 远程端口号80 就能判断出ie程序在使用? 
请高手,专家帮忙解决我的问题,最好有代码例子谢谢:-)

19 个解决方案

#1


陈辉大哥在吗?有人帮我解决一下吗?

#2


这个问题是网络问题
  我给你解释一下吧~!

从1-1023这些端口是系统服务端口
开启什么服务启动什么端口

比如你开启了 FTP服务那么 系统将打开 20.21(一个是控制,一个是传输)

现在总有些人认为我看网页那么也将打开我本机80端口
其实不然
大家可以打开一个网页 在打开CMD  输入 netstat -an
本机并没有80  只是远程主机有80这个端口

好我们的程序分为两部分
一部分判断远程主机
另外一部分判断本机
比如本机打开4000
大于1024的端口你需要自己搜集 在网上找吧 别人已经收集,你自己做成一个表就可以

利用vb写的扫描本机开放端口的小程序.

4个text   两个按钮.和一个Winsock1控件

Dim portnum As Long
Dim start As String
Sub scanningports()
    Dim porttwo As Long
    portnum = Text1.Text
    porttwo = Text2.Text
    Command2.Enabled = True
    On Error GoTo viriio
    Do
    portnum = portnum + 1
    DoEvents
    If start = True Then
    Winsock1.Close
    DoEvents
    Winsock1.LocalPort = portnum
    DoEvents
    Text3.Text = portnum
    Winsock1.Listen
    DoEvents
    Else
    portnum = 0
    Command1.Enabled = True
    Text1.Locked = False
    Text2.Locked = False
    Exit Sub
    End If
    Winsock1.Close
    DoEvents
       Loop Until portnum >= porttwo
    portnum = 0
    Command1.Enabled = True
    logport.Text = logport.Text & vbCrLf & "Scanning Ports Done!" & vbCrLf
    Text1.Locked = False
    Text2.Locked = False
viriio:
    If Err.Number = 10048 Then
    logport.Text = logport.Text & vbCrLf & "端口" & Winsock1.LocalPort & " 开启中"
    Resume Next
    End If

End Sub

Private Sub Command1_Click()
Command2.Enabled = True
If Text1.Text = "" Then
MsgBox "你必须指定开始端口号!"
Exit Sub
End If
If Text2.Text = "" Then
MsgBox "你必须指定一个结束端口号"
Exit Sub
End If

Text1.Locked = True
Text2.Locked = True
Command1.Enabled = False
Winsock1.Close
start = True
Call scanningports
logport.Text = logport.Text & vbCrLf & "端口" & Text1.Text & "- " & Text3.Text & "  已经成功扫描!"

End Sub

Private Sub Command2_Click()
Command2.Enabled = False
start = False
End Sub



#3


我现在能动态的获得ip地址,本地端口号,和,远程端口,那怎么才能通过这些数据判断出那个程序在使用本地端口,例如:QQ使用本地端口6012

#4


还是那个问题 
  服务端口和客户端口的问题
客户端口是随机~!

 你能得到的只能是服务端口 在判断服务~!

QQ本身是服务加客户 服务端用4000  客户端随机

#5


用程序怎么判断呢?就和防火墙提示一样,那个程序在使用你的本地端口,我现在可以动态的获得ip地址,本地端口号,和,远程端口

#6


mark

#7


莫依兄

   怎么不发表点 意见

#8


来了不好意思最近在出差~~不怎么有时间
你参考下我这篇文章虽然是C#的但是转VB是一样的,其中有端口枚举,可以根据PID获取进程路径来判断IE,但是注意的是只能XP和XP以上使用
http://blog.csdn.net/chenhui530/archive/2007/10/02/1809735.aspx

#9


看iphlpapi.dll中的GetTcpTable 函数吧,可有去MSDN上查查

#10


错了,是这个API:GetIfTable
Private Declare Function GetIfTable Lib "IPHLPAPI.DLL" (ByRef pIfRowTable As Any, ByRef pdwSize As Long, ByVal bOrder As Long) As Long

#11


up

#12


''在模块mdlGetNetPid中
Option Explicit
Private Type MIB_TCPROW_OWNER_PID ''这是当TCP_TABLE_CLASS=TCP_TABLE_OWNER_PID_ALL,供GetExtendedTcpTable 用的,
    dwState As Long
    dwLocalAddr As Long
    dwLocalPort As Long
    dwRemoteAddr As Long
    dwRemotePort As Long
    dwOwningPid As Long
End Type
Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal Handle As Long) As Long
Public Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, _
                                                        ByVal bInheritHandle As Long, _
                                                        ByVal dwProcId As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, _
                                                        ByVal hModule As Long, _
                                                        ByVal ModuleName As String, _
                                                        ByVal nSize As Long) As Long
Public Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, _
                                                        ByRef lphModule As Long, _
                                                        ByVal cb As Long, _
                                                        ByRef cbNeeded As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ = 16
Private Const MAX_PATH = 256
Private Const AF_INET6 = 23
Private Const AF_INET = 2
Public Enum TCP_TABLE_CLASS
  TCP_TABLE_BASIC_LISTENER
  TCP_TABLE_BASIC_CONNECTIONS
  TCP_TABLE_BASIC_ALL
  TCP_TABLE_OWNER_PID_LISTENER
  TCP_TABLE_OWNER_PID_CONNECTIONS
  TCP_TABLE_OWNER_PID_ALL
  TCP_TABLE_OWNER_MODULE_LISTENER
  TCP_TABLE_OWNER_MODULE_CONNECTIONS
  TCP_TABLE_OWNER_MODULE_ALL
End Enum
Private Declare Function htons Lib "ws2_32.dll" (ByVal dwLong As Long) As Long
Public Declare Function GetExtendedTcpTable Lib "IPHLPAPI.DLL" (pTcpTableEx As Any, lSize As Long, ByVal bOrder As Long, ByVal Flags As Long, ByVal TableClass As TCP_TABLE_CLASS, ByVal bReserved As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private pTablePtr() As Byte
Public nRows As Long
Private pDataRef As Long

Public Function GetRefresh() As Boolean '取得TcpTable,交给RefreshStack
Dim lngSize As Long, nRet As Long
    lngSize = 4
    nRet = GetExtendedTcpTable(0&, lngSize, 1, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0)  'Requires Windows Vista or Windows XP SP2.
    ReDim pTablePtr(lngSize - 1)

    nRet = GetExtendedTcpTable(pTablePtr(0), lngSize, 1, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0)

'    nRet = GetTcpTable(0&, lngSize, 0)
'    ReDim pTablePtr(lngSize - 1)
'    If nRet <> 0 Then nRet = GetTcpTable(pTablePtr(0), lngSize, 0)

    If nRet = 0 Then
        CopyMemory nRows, pTablePtr(0), 4
    Else
        GetRefresh = False
        Exit Function
    End If
    
    If nRows = 0 Or pTablePtr(0) Then
    GetRefresh = False
    Exit Function
    End If



End Function

Public Sub RefreshStack()

Dim i As Long
Dim tcpTable As MIB_TCPROW_OWNER_PID
    pDataRef = 0

For i = 0 To nRows ' read 24 bytes at a time

    CopyMemory tcpTable, pTablePtr(0 + pDataRef + 4), LenB(tcpTable)

        If tcpTable.dwRemoteAddr <> 0 Or GetPort(tcpTable.dwRemotePort) <> 0 Or GetPort(tcpTable.dwLocalPort) <> 0 Then
            Debug.Print "状态:"; c_state(tcpTable.dwState); ",";
            Debug.Print "本地IP:"; GetIPAddress(tcpTable.dwLocalAddr); ",";
            Debug.Print "本地PORT:"; GetPort(tcpTable.dwLocalPort); ",";
            Debug.Print "远程IP:"; tcpTable.dwRemoteAddr; ",";
            Debug.Print "远程PORT:"; GetPort(tcpTable.dwRemotePort); ",";
            Debug.Print "进程ID:"; tcpTable.dwOwningPid; ",";
            Debug.Print "进程名:"; getPidPathName(tcpTable.dwOwningPid)
        End If
        pDataRef = pDataRef + LenB(tcpTable)
        DoEvents
Next i
End Sub
Public Function GetPort(ByVal dwPort As Long) As Long
'端口号是两字节,用htons可以转换为long型
    GetPort = htons(dwPort)
End Function
Public Function GetIPAddress(dwAddr As Long) As String
    Dim arrIpParts(3) As Byte
    CopyMemory arrIpParts(0), dwAddr, 4
    GetIPAddress = CStr(arrIpParts(0)) & "." & _
    CStr(arrIpParts(1)) & "." & _
    CStr(arrIpParts(2)) & "." & _
    CStr(arrIpParts(3))
End Function
Function c_state(s) As String
  Select Case s
  Case "0": c_state = "UNKNOWN"
  Case "1": c_state = "CLOSED"
  Case "2": c_state = "LISTENING"
  Case "3": c_state = "SYN_SENT"
  Case "4": c_state = "SYN_RCVD"
  Case "5": c_state = "ESTABLISHED"
  Case "6": c_state = "FIN_WAIT1"
  Case "7": c_state = "FIN_WAIT2"
  Case "8": c_state = "CLOSE_WAIT"
  Case "9": c_state = "CLOSING"
  Case "10": c_state = "LAST_ACK"
  Case "11": c_state = "TIME_WAIT"
  Case "12": c_state = "DELETE_TCB"
  End Select
End Function

Public Function getPidPathName(pid As Long) As String
Dim cbNeeded As Long
Dim Modules(1 To 200) As Long
Dim nSize As Long
Dim lRet As Long
Dim ModuleName As String
Dim hProcess As Long
If pid = 0 Then getPidPathName = "[System Idle Process]": Exit Function
If pid = 4 Then getPidPathName = "[System]": Exit Function

 hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, pid)
 If hProcess <> 0 Then
     lRet = EnumProcessModules(hProcess, Modules(1), 200, cbNeeded)
    If lRet <> 0 Then
        ModuleName = Space(MAX_PATH)
        nSize = MAX_PATH
        lRet = GetModuleFileNameExA(hProcess, Modules(1), ModuleName, nSize)
        If CBool(InStr(1, (Left(ModuleName, lRet)), "", vbTextCompare)) Then '''ModuleName是定长字符串,如果为空它不等于“”,但用此方法可以检查其为空
            getPidPathName = Left(ModuleName, lRet)
        End If
    End If
End If
lRet = CloseHandle(hProcess)
End Function
''在form中
Option Explicit

Private Sub Command1_Click()
GetRefresh
RefreshStack
End Sub

#13


本代码主要改自一“很专业的防火墙”

#14


//莫依兄

"莫依兄"是个MM呀

#15


偶写过这段代码,但是回这个帖前开会去了。就先mark准备晚上回.

晚上回了家,电信调线路弄得我家ADSL2天拨不上号 

最近实在太忙,白天抽不了时间.

等今天线路好了再上来看zzyong已经回了嘛

楼主可以结帖了

#16


我哪个有一点点错误,就是
Debug.Print "远程IP:"; tcpTable.dwRemoteAddr; ",";
====>Debug.Print "远程IP:"; GetIPAddress(tcpTable.dwRemoteAddr); ",";

#17


............................................

#18


  100分。。。  


下面是模块代码:

Option Explicit
Public Type Tcp '自定结构 方便使用
     State As String
     LocalAddr As String
     LocalPort As Long
     RemoteAddr As String
     RemotePort As Long
     ProcessId As Long
End Type

Public Type Udp '自定结构方便使用
     LocalAddr As String
     LocalPort As Long
     ProcessId As Long
End Type

Private Type MIB_TCPROW_EX
     dwState As Long
     dwLocalAddr As Long
     dwLocalPort As Long
     dwRemoteAddr As Long
     dwRemotePort As Long
     dwProcessId As Long
End Type
Private Type MIB_TCPTABLE_EX
     dwNumEntries As Long
     Table() As MIB_TCPROW_EX
End Type

Private Type MIB_UDPROW_EX
     dwLocalAddr As Long
     dwLocalPort As Long
     dwProcessId As Long
End Type
Private Type MIB_UDPTABLE_EX
    dwNumEntries As Long
    Table(150) As MIB_UDPROW_EX
End Type

Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function AllocateAndGetTcpExTableFromStack Lib "iphlpapi.dll" (ByRef pTcpTable As Long, ByVal bOrder As Boolean, ByVal hAllocHeap As Long, ByVal dwAllocFlags As Long, ByVal dwProtocolVersion As Long) As Long
Private Declare Function AllocateAndGetUdpExTableFromStack Lib "iphlpapi.dll" (ByRef pUdpTable As Long, ByVal bOrder As Boolean, ByVal hAllocHeap As Long, ByVal dwAllocFlags As Long, ByVal dwProtocolVersion As Long) As Long

Private Declare Function ntohs Lib "WSOCK32.DLL" (ByVal netshort As Long) As Long
Private Declare Function inet_addr Lib "WSOCK32.DLL" (ByVal CP As String) As Long
Private Declare Function inet_ntoa Lib "WSOCK32.DLL" (ByVal inn As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
Private Declare Function lstrlen Lib "kernel32" (ByVal lpString As Any) As Integer

Private Function GetIp(ByVal inn As Long) As String
Dim nStr As Integer
Dim pStr As Long
Dim RetString As String, newIP As String

    pStr = inet_ntoa(inn)
    nStr = lstrlen(pStr)
    RetString = Space(nStr)
    CopyMemory ByVal RetString, ByVal pStr, nStr
    GetIp = RetString
End Function


Public Function GetTcp(MyTcp() As Tcp)'数组当参数传入是为了兼容VB5,因为数组是以传址方式传入Dim Tcp As MIB_TCPTABLE_EX, i As Integer, j As Integer, ptcp As Long

    AllocateAndGetTcpExTableFromStack ptcp, True, GetProcessHeap, 2, 2
    CopyMemory Tcp.dwNumEntries, ByVal ptcp, 4
    ReDim Tcp.Table(1 To Tcp.dwNumEntries)
    CopyMemory Tcp.Table(1), ByVal ptcp + 4, Len(Tcp.Table(1)) * Tcp.dwNumEntries
    
    For i = 1 To Tcp.dwNumEntries
        j = i - 1
        ReDim Preserve MyTcp(j)
        MyTcp(j).RemoteAddr = GetIp(Tcp.Table(i).dwRemoteAddr)
        MyTcp(j).LocalAddr = GetIp(Tcp.Table(i).dwLocalAddr)
        MyTcp(j).RemotePort = ntohs(Tcp.Table(i).dwRemotePort)
        MyTcp(j).LocalPort = ntohs(Tcp.Table(i).dwLocalPort)
        MyTcp(j).ProcessId = Tcp.Table(i).dwProcessId
        
        Select Case Tcp.Table(i).dwState
            Case 1: MyTcp(j).State = "已经关闭"
            Case 2: MyTcp(j).State = "等待连接"
            Case 8: MyTcp(j).State = "等待关闭"
            Case 9: MyTcp(j).State = "在关闭中"
        End Select
        
    Next i
End Function

Public Function GetUdp(MyUdp() As Udp)
Dim pUdp As Long, i As Integer
Dim Udp As MIB_UDPTABLE_EX

    AllocateAndGetUdpExTableFromStack pUdp, True, GetProcessHeap, 2, 2
    CopyMemory Udp, ByVal pUdp, Len(Udp)
    
        For i = 0 To Udp.dwNumEntries - 1
            ReDim Preserve MyUdp(i)
            MyUdp(i).LocalAddr = GetIp(Udp.Table(i).dwLocalAddr)
            MyUdp(i).LocalPort = ntohs(Udp.Table(i).dwLocalPort)
            MyUdp(i).ProcessId = Udp.Table(i).dwProcessId
        Next i
End Function

 


窗体代码:

Private Sub Form_Load()
Dim MyTcp() As Tcp, MyUdp() As Udp
Dim strTCP As String, strUDP As String
Dim i As Integer, TcpCount As Integer, UdpCount As Integer

Call GetTcp(MyTcp)
Call GetUdp(MyUdp)

TcpCount = UBound(MyTcp)
UdpCount = UBound(MyUdp)

strTCP = "TCP(" & TcpCount + 1 & "个)" & vbCrLf
For i = 0 To TcpCount
    strTCP = strTCP & "本地地址:" & MyTcp(i).LocalAddr & " 本地端口:" & MyTcp(i).LocalPort & " 远程地址:" & MyTcp(i).RemoteAddr & " 远程端口:" & MyTcp(i).RemotePort & " 状态:" & MyTcp(i).State & " PID:" & MyTcp(i).ProcessId & vbCrLf
Next

strUDP = "UDP(" & UdpCount + 1 & "个)" & vbCrLf
For i = 0 To UdpCount
    strUDP = strUDP & "本地地址:" & MyUdp(i).LocalAddr & " 本地端口:" & MyUdp(i).LocalPort & " PID:" & MyUdp(i).ProcessId & vbCrLf
Next

MsgBox strTCP & vbCrLf & strUDP
End Sub


自己网上搜索下 可以很简单的找到 打开端口的PID

#19


我想问一下,如何获得远程主机的端口号???谢谢!!1

#1


陈辉大哥在吗?有人帮我解决一下吗?

#2


这个问题是网络问题
  我给你解释一下吧~!

从1-1023这些端口是系统服务端口
开启什么服务启动什么端口

比如你开启了 FTP服务那么 系统将打开 20.21(一个是控制,一个是传输)

现在总有些人认为我看网页那么也将打开我本机80端口
其实不然
大家可以打开一个网页 在打开CMD  输入 netstat -an
本机并没有80  只是远程主机有80这个端口

好我们的程序分为两部分
一部分判断远程主机
另外一部分判断本机
比如本机打开4000
大于1024的端口你需要自己搜集 在网上找吧 别人已经收集,你自己做成一个表就可以

利用vb写的扫描本机开放端口的小程序.

4个text   两个按钮.和一个Winsock1控件

Dim portnum As Long
Dim start As String
Sub scanningports()
    Dim porttwo As Long
    portnum = Text1.Text
    porttwo = Text2.Text
    Command2.Enabled = True
    On Error GoTo viriio
    Do
    portnum = portnum + 1
    DoEvents
    If start = True Then
    Winsock1.Close
    DoEvents
    Winsock1.LocalPort = portnum
    DoEvents
    Text3.Text = portnum
    Winsock1.Listen
    DoEvents
    Else
    portnum = 0
    Command1.Enabled = True
    Text1.Locked = False
    Text2.Locked = False
    Exit Sub
    End If
    Winsock1.Close
    DoEvents
       Loop Until portnum >= porttwo
    portnum = 0
    Command1.Enabled = True
    logport.Text = logport.Text & vbCrLf & "Scanning Ports Done!" & vbCrLf
    Text1.Locked = False
    Text2.Locked = False
viriio:
    If Err.Number = 10048 Then
    logport.Text = logport.Text & vbCrLf & "端口" & Winsock1.LocalPort & " 开启中"
    Resume Next
    End If

End Sub

Private Sub Command1_Click()
Command2.Enabled = True
If Text1.Text = "" Then
MsgBox "你必须指定开始端口号!"
Exit Sub
End If
If Text2.Text = "" Then
MsgBox "你必须指定一个结束端口号"
Exit Sub
End If

Text1.Locked = True
Text2.Locked = True
Command1.Enabled = False
Winsock1.Close
start = True
Call scanningports
logport.Text = logport.Text & vbCrLf & "端口" & Text1.Text & "- " & Text3.Text & "  已经成功扫描!"

End Sub

Private Sub Command2_Click()
Command2.Enabled = False
start = False
End Sub



#3


我现在能动态的获得ip地址,本地端口号,和,远程端口,那怎么才能通过这些数据判断出那个程序在使用本地端口,例如:QQ使用本地端口6012

#4


还是那个问题 
  服务端口和客户端口的问题
客户端口是随机~!

 你能得到的只能是服务端口 在判断服务~!

QQ本身是服务加客户 服务端用4000  客户端随机

#5


用程序怎么判断呢?就和防火墙提示一样,那个程序在使用你的本地端口,我现在可以动态的获得ip地址,本地端口号,和,远程端口

#6


mark

#7


莫依兄

   怎么不发表点 意见

#8


来了不好意思最近在出差~~不怎么有时间
你参考下我这篇文章虽然是C#的但是转VB是一样的,其中有端口枚举,可以根据PID获取进程路径来判断IE,但是注意的是只能XP和XP以上使用
http://blog.csdn.net/chenhui530/archive/2007/10/02/1809735.aspx

#9


看iphlpapi.dll中的GetTcpTable 函数吧,可有去MSDN上查查

#10


错了,是这个API:GetIfTable
Private Declare Function GetIfTable Lib "IPHLPAPI.DLL" (ByRef pIfRowTable As Any, ByRef pdwSize As Long, ByVal bOrder As Long) As Long

#11


up

#12


''在模块mdlGetNetPid中
Option Explicit
Private Type MIB_TCPROW_OWNER_PID ''这是当TCP_TABLE_CLASS=TCP_TABLE_OWNER_PID_ALL,供GetExtendedTcpTable 用的,
    dwState As Long
    dwLocalAddr As Long
    dwLocalPort As Long
    dwRemoteAddr As Long
    dwRemotePort As Long
    dwOwningPid As Long
End Type
Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal Handle As Long) As Long
Public Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, _
                                                        ByVal bInheritHandle As Long, _
                                                        ByVal dwProcId As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, _
                                                        ByVal hModule As Long, _
                                                        ByVal ModuleName As String, _
                                                        ByVal nSize As Long) As Long
Public Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, _
                                                        ByRef lphModule As Long, _
                                                        ByVal cb As Long, _
                                                        ByRef cbNeeded As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ = 16
Private Const MAX_PATH = 256
Private Const AF_INET6 = 23
Private Const AF_INET = 2
Public Enum TCP_TABLE_CLASS
  TCP_TABLE_BASIC_LISTENER
  TCP_TABLE_BASIC_CONNECTIONS
  TCP_TABLE_BASIC_ALL
  TCP_TABLE_OWNER_PID_LISTENER
  TCP_TABLE_OWNER_PID_CONNECTIONS
  TCP_TABLE_OWNER_PID_ALL
  TCP_TABLE_OWNER_MODULE_LISTENER
  TCP_TABLE_OWNER_MODULE_CONNECTIONS
  TCP_TABLE_OWNER_MODULE_ALL
End Enum
Private Declare Function htons Lib "ws2_32.dll" (ByVal dwLong As Long) As Long
Public Declare Function GetExtendedTcpTable Lib "IPHLPAPI.DLL" (pTcpTableEx As Any, lSize As Long, ByVal bOrder As Long, ByVal Flags As Long, ByVal TableClass As TCP_TABLE_CLASS, ByVal bReserved As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private pTablePtr() As Byte
Public nRows As Long
Private pDataRef As Long

Public Function GetRefresh() As Boolean '取得TcpTable,交给RefreshStack
Dim lngSize As Long, nRet As Long
    lngSize = 4
    nRet = GetExtendedTcpTable(0&, lngSize, 1, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0)  'Requires Windows Vista or Windows XP SP2.
    ReDim pTablePtr(lngSize - 1)

    nRet = GetExtendedTcpTable(pTablePtr(0), lngSize, 1, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0)

'    nRet = GetTcpTable(0&, lngSize, 0)
'    ReDim pTablePtr(lngSize - 1)
'    If nRet <> 0 Then nRet = GetTcpTable(pTablePtr(0), lngSize, 0)

    If nRet = 0 Then
        CopyMemory nRows, pTablePtr(0), 4
    Else
        GetRefresh = False
        Exit Function
    End If
    
    If nRows = 0 Or pTablePtr(0) Then
    GetRefresh = False
    Exit Function
    End If



End Function

Public Sub RefreshStack()

Dim i As Long
Dim tcpTable As MIB_TCPROW_OWNER_PID
    pDataRef = 0

For i = 0 To nRows ' read 24 bytes at a time

    CopyMemory tcpTable, pTablePtr(0 + pDataRef + 4), LenB(tcpTable)

        If tcpTable.dwRemoteAddr <> 0 Or GetPort(tcpTable.dwRemotePort) <> 0 Or GetPort(tcpTable.dwLocalPort) <> 0 Then
            Debug.Print "状态:"; c_state(tcpTable.dwState); ",";
            Debug.Print "本地IP:"; GetIPAddress(tcpTable.dwLocalAddr); ",";
            Debug.Print "本地PORT:"; GetPort(tcpTable.dwLocalPort); ",";
            Debug.Print "远程IP:"; tcpTable.dwRemoteAddr; ",";
            Debug.Print "远程PORT:"; GetPort(tcpTable.dwRemotePort); ",";
            Debug.Print "进程ID:"; tcpTable.dwOwningPid; ",";
            Debug.Print "进程名:"; getPidPathName(tcpTable.dwOwningPid)
        End If
        pDataRef = pDataRef + LenB(tcpTable)
        DoEvents
Next i
End Sub
Public Function GetPort(ByVal dwPort As Long) As Long
'端口号是两字节,用htons可以转换为long型
    GetPort = htons(dwPort)
End Function
Public Function GetIPAddress(dwAddr As Long) As String
    Dim arrIpParts(3) As Byte
    CopyMemory arrIpParts(0), dwAddr, 4
    GetIPAddress = CStr(arrIpParts(0)) & "." & _
    CStr(arrIpParts(1)) & "." & _
    CStr(arrIpParts(2)) & "." & _
    CStr(arrIpParts(3))
End Function
Function c_state(s) As String
  Select Case s
  Case "0": c_state = "UNKNOWN"
  Case "1": c_state = "CLOSED"
  Case "2": c_state = "LISTENING"
  Case "3": c_state = "SYN_SENT"
  Case "4": c_state = "SYN_RCVD"
  Case "5": c_state = "ESTABLISHED"
  Case "6": c_state = "FIN_WAIT1"
  Case "7": c_state = "FIN_WAIT2"
  Case "8": c_state = "CLOSE_WAIT"
  Case "9": c_state = "CLOSING"
  Case "10": c_state = "LAST_ACK"
  Case "11": c_state = "TIME_WAIT"
  Case "12": c_state = "DELETE_TCB"
  End Select
End Function

Public Function getPidPathName(pid As Long) As String
Dim cbNeeded As Long
Dim Modules(1 To 200) As Long
Dim nSize As Long
Dim lRet As Long
Dim ModuleName As String
Dim hProcess As Long
If pid = 0 Then getPidPathName = "[System Idle Process]": Exit Function
If pid = 4 Then getPidPathName = "[System]": Exit Function

 hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, pid)
 If hProcess <> 0 Then
     lRet = EnumProcessModules(hProcess, Modules(1), 200, cbNeeded)
    If lRet <> 0 Then
        ModuleName = Space(MAX_PATH)
        nSize = MAX_PATH
        lRet = GetModuleFileNameExA(hProcess, Modules(1), ModuleName, nSize)
        If CBool(InStr(1, (Left(ModuleName, lRet)), "", vbTextCompare)) Then '''ModuleName是定长字符串,如果为空它不等于“”,但用此方法可以检查其为空
            getPidPathName = Left(ModuleName, lRet)
        End If
    End If
End If
lRet = CloseHandle(hProcess)
End Function
''在form中
Option Explicit

Private Sub Command1_Click()
GetRefresh
RefreshStack
End Sub

#13


本代码主要改自一“很专业的防火墙”

#14


//莫依兄

"莫依兄"是个MM呀

#15


偶写过这段代码,但是回这个帖前开会去了。就先mark准备晚上回.

晚上回了家,电信调线路弄得我家ADSL2天拨不上号 

最近实在太忙,白天抽不了时间.

等今天线路好了再上来看zzyong已经回了嘛

楼主可以结帖了

#16


我哪个有一点点错误,就是
Debug.Print "远程IP:"; tcpTable.dwRemoteAddr; ",";
====>Debug.Print "远程IP:"; GetIPAddress(tcpTable.dwRemoteAddr); ",";

#17


............................................

#18


  100分。。。  


下面是模块代码:

Option Explicit
Public Type Tcp '自定结构 方便使用
     State As String
     LocalAddr As String
     LocalPort As Long
     RemoteAddr As String
     RemotePort As Long
     ProcessId As Long
End Type

Public Type Udp '自定结构方便使用
     LocalAddr As String
     LocalPort As Long
     ProcessId As Long
End Type

Private Type MIB_TCPROW_EX
     dwState As Long
     dwLocalAddr As Long
     dwLocalPort As Long
     dwRemoteAddr As Long
     dwRemotePort As Long
     dwProcessId As Long
End Type
Private Type MIB_TCPTABLE_EX
     dwNumEntries As Long
     Table() As MIB_TCPROW_EX
End Type

Private Type MIB_UDPROW_EX
     dwLocalAddr As Long
     dwLocalPort As Long
     dwProcessId As Long
End Type
Private Type MIB_UDPTABLE_EX
    dwNumEntries As Long
    Table(150) As MIB_UDPROW_EX
End Type

Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function AllocateAndGetTcpExTableFromStack Lib "iphlpapi.dll" (ByRef pTcpTable As Long, ByVal bOrder As Boolean, ByVal hAllocHeap As Long, ByVal dwAllocFlags As Long, ByVal dwProtocolVersion As Long) As Long
Private Declare Function AllocateAndGetUdpExTableFromStack Lib "iphlpapi.dll" (ByRef pUdpTable As Long, ByVal bOrder As Boolean, ByVal hAllocHeap As Long, ByVal dwAllocFlags As Long, ByVal dwProtocolVersion As Long) As Long

Private Declare Function ntohs Lib "WSOCK32.DLL" (ByVal netshort As Long) As Long
Private Declare Function inet_addr Lib "WSOCK32.DLL" (ByVal CP As String) As Long
Private Declare Function inet_ntoa Lib "WSOCK32.DLL" (ByVal inn As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
Private Declare Function lstrlen Lib "kernel32" (ByVal lpString As Any) As Integer

Private Function GetIp(ByVal inn As Long) As String
Dim nStr As Integer
Dim pStr As Long
Dim RetString As String, newIP As String

    pStr = inet_ntoa(inn)
    nStr = lstrlen(pStr)
    RetString = Space(nStr)
    CopyMemory ByVal RetString, ByVal pStr, nStr
    GetIp = RetString
End Function


Public Function GetTcp(MyTcp() As Tcp)'数组当参数传入是为了兼容VB5,因为数组是以传址方式传入Dim Tcp As MIB_TCPTABLE_EX, i As Integer, j As Integer, ptcp As Long

    AllocateAndGetTcpExTableFromStack ptcp, True, GetProcessHeap, 2, 2
    CopyMemory Tcp.dwNumEntries, ByVal ptcp, 4
    ReDim Tcp.Table(1 To Tcp.dwNumEntries)
    CopyMemory Tcp.Table(1), ByVal ptcp + 4, Len(Tcp.Table(1)) * Tcp.dwNumEntries
    
    For i = 1 To Tcp.dwNumEntries
        j = i - 1
        ReDim Preserve MyTcp(j)
        MyTcp(j).RemoteAddr = GetIp(Tcp.Table(i).dwRemoteAddr)
        MyTcp(j).LocalAddr = GetIp(Tcp.Table(i).dwLocalAddr)
        MyTcp(j).RemotePort = ntohs(Tcp.Table(i).dwRemotePort)
        MyTcp(j).LocalPort = ntohs(Tcp.Table(i).dwLocalPort)
        MyTcp(j).ProcessId = Tcp.Table(i).dwProcessId
        
        Select Case Tcp.Table(i).dwState
            Case 1: MyTcp(j).State = "已经关闭"
            Case 2: MyTcp(j).State = "等待连接"
            Case 8: MyTcp(j).State = "等待关闭"
            Case 9: MyTcp(j).State = "在关闭中"
        End Select
        
    Next i
End Function

Public Function GetUdp(MyUdp() As Udp)
Dim pUdp As Long, i As Integer
Dim Udp As MIB_UDPTABLE_EX

    AllocateAndGetUdpExTableFromStack pUdp, True, GetProcessHeap, 2, 2
    CopyMemory Udp, ByVal pUdp, Len(Udp)
    
        For i = 0 To Udp.dwNumEntries - 1
            ReDim Preserve MyUdp(i)
            MyUdp(i).LocalAddr = GetIp(Udp.Table(i).dwLocalAddr)
            MyUdp(i).LocalPort = ntohs(Udp.Table(i).dwLocalPort)
            MyUdp(i).ProcessId = Udp.Table(i).dwProcessId
        Next i
End Function

 


窗体代码:

Private Sub Form_Load()
Dim MyTcp() As Tcp, MyUdp() As Udp
Dim strTCP As String, strUDP As String
Dim i As Integer, TcpCount As Integer, UdpCount As Integer

Call GetTcp(MyTcp)
Call GetUdp(MyUdp)

TcpCount = UBound(MyTcp)
UdpCount = UBound(MyUdp)

strTCP = "TCP(" & TcpCount + 1 & "个)" & vbCrLf
For i = 0 To TcpCount
    strTCP = strTCP & "本地地址:" & MyTcp(i).LocalAddr & " 本地端口:" & MyTcp(i).LocalPort & " 远程地址:" & MyTcp(i).RemoteAddr & " 远程端口:" & MyTcp(i).RemotePort & " 状态:" & MyTcp(i).State & " PID:" & MyTcp(i).ProcessId & vbCrLf
Next

strUDP = "UDP(" & UdpCount + 1 & "个)" & vbCrLf
For i = 0 To UdpCount
    strUDP = strUDP & "本地地址:" & MyUdp(i).LocalAddr & " 本地端口:" & MyUdp(i).LocalPort & " PID:" & MyUdp(i).ProcessId & vbCrLf
Next

MsgBox strTCP & vbCrLf & strUDP
End Sub


自己网上搜索下 可以很简单的找到 打开端口的PID

#19


我想问一下,如何获得远程主机的端口号???谢谢!!1

#20