IpHelpApi提供了 GetExtendedTcpTable函式獲得TCP連線相關資訊，它的定義如下：     <DllImport("iphlpapi.dll", CharSet:=CharSet.Auto, SetLastError:=True, ExactSpelling:=True)>     Private Shared Function GetExtendedTcpTable(         ByVal pTcpTable As IntPtr,            ByRef dwOutBufLen As Integer,           ByVal sort As Boolean,           ByVal ipVersion As Integer,           ByVal tblClass As TCP_TABLE_CLASS,          ByVal reserved As Integer            ) As Integer     End Function

其中幾個引數的說明：

        pTcpTable：儲存TCP埠連線資訊表，具體結構型別根據ulAF和TableClass引數而定。         dwOutBufLen ：pTcpTable指向的記憶體大小         sort ：返回結果是否排序。         ipVersion ：型別。AF_INET——IPv4; AF_INET6——IPv6。         tblClass ：對應TCP_TABLE_CLASS列舉，傳入相應不同值，返回的pTcpTable中結構型別不同。         reserved：保留，設為0。

TCP_TABLE_CLASS是個列舉型別，定義如下：

    Private 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

當使用的TCP_TABLE_CLASS值不同時，獲得的pTcpTable也就不同。我把TCP_TABLE_CLASS對應的pTcpTable整理如下表：

通過TCP_TABLE_OWNER_PID_ALL獲得MIB_TCPTABLE_OWNER_PID，最後獲得MIB_TCPROW_OWNER_PID，它的成員dwOwningPid就是我們想要獲得的程序ID。由於MIB_TCPTABLE_OWNER_PID結構中含有MIB_TCPROW_OWNER_PID結構陣列，需要對MIB_TCPTABLE_OWNER_PID結構重寫如下：

    <StructLayout(LayoutKind.Sequential)>     Structure MIB_TCPTABLE_OWNER_PID         Dim dwNumEntries As Integer         Dim table As MIB_TCPROW_OWNER_PID     End Structure

MIB_TCPROW_OWNER_PID結構的定義如下：

    Structure MIB_TCPROW_OWNER_PID         Dim dwState As Integer         Dim dwLocalAddr As Integer         Dim dwLocalPort As Integer         Dim dwRemoteAddr As Integer         Dim dwRemotePort As Integer         Dim dwOwningPid As Integer     End Structure

現在回到具體程式碼：

1、GetExtendedTcpTable需要呼叫兩次，第一次dwOutBufLen傳入0，執行後dwOutBufLen會設定為pTcpTable指向的MIB_TCPTABLE_OWNER_PID結構的實際大小。第二次需要將dwOutBufLen設定為實際大小後再次傳入函式，如果呼叫函式成功則返回0。

2、獲得的pTcpTable是一個指標，需要處理後才能最終獲得MIB_TCPROW_OWNER_PID。

3、不再對程序進行列舉，直接使用Process.GetProcessById獲得程序。關於程序，請參看《vb.net 教程 6-1 程序 Process類初探》一節。

下面是具體的程式碼：

    Private Sub btnGetTcpLink_Click(sender As Object, e As EventArgs) Handles btnGetTcpLink.Click


        ListView1.Items.Clear()

        Dim tcpTable As IntPtr = IntPtr.Zero
        Dim outBufLen As Integer = 0
        Dim AF_INET As Integer = 2

        Dim result As Integer
        result = GetExtendedTcpTable(IntPtr.Zero, outBufLen, False, AF_INET, TCP_TABLE_CLASS.TCP_TABLE_OWNER_PID_ALL, 0)
        If result = 0 Then Exit Sub

        tcpTable = Marshal.AllocHGlobal(outBufLen)
        result = GetExtendedTcpTable(tcpTable, outBufLen, False, AF_INET, TCP_TABLE_CLASS.TCP_TABLE_OWNER_PID_ALL, 0)
        If result <> 0 Then Exit Sub

        Try
            Dim mtop As MIB_TCPTABLE_OWNER_PID
            mtop = CType(Marshal.PtrToStructure(tcpTable, GetType(MIB_TCPTABLE_OWNER_PID)), MIB_TCPTABLE_OWNER_PID)

            Dim tablecount As Integer = mtop.dwNumEntries
            Dim pMTr As IntPtr = tcpTable.ToInt32 + Marshal.SizeOf(mtop.dwNumEntries)

            Dim arrTcpRow(tablecount - 1) As MIB_TCPROW_OWNER_PID

            For i As Integer = 0 To tablecount - 1
                Dim tcprow As MIB_TCPROW_OWNER_PID = CType(Marshal.PtrToStructure(pMTr, GetType(MIB_TCPROW_OWNER_PID)), MIB_TCPROW_OWNER_PID)
                arrTcpRow(i) = tcprow
                pMTr = pMTr.ToInt32 + Marshal.SizeOf(tcprow)
            Next

            Dim lstv As ListViewItem
            For i As Integer = 0 To tablecount - 1
                lstv = New ListViewItem()
                lstv.Text = getProInfo(arrTcpRow(i).dwOwningPid)
                lstv.SubItems.Add(arrTcpRow(i).dwOwningPid)
                lstv.SubItems.Add(arrTcpRow(i).dwLocalAddr)
                lstv.SubItems.Add(arrTcpRow(i).dwLocalPort)
                lstv.SubItems.Add(arrTcpRow(i).dwRemoteAddr)
                lstv.SubItems.Add(arrTcpRow(i).dwRemotePort)

                lstv.SubItems.Add(arrTcpRow(i).dwState)
                ListView1.Items.Add(lstv)
            Next

        Catch ex As Exception
            Marshal.FreeHGlobal(tcpTable)
            MessageBox.Show("獲得TCP表出錯")
            Exit Sub
        End Try

        Marshal.FreeHGlobal(tcpTable)

    End Sub

獲得程序的程式碼：

    Private Function getProInfo(ByVal Pid As Integer) As String
        Try
            Dim pro As Process = Process.GetProcessById(Pid)
            Return pro.ProcessName
        Catch ex As Exception
            Return "(No)"
        End Try
    End Function

執行情況如下：

可以看出，確實獲得了相應的程序資訊，但是，反而是IP連線資訊還沒有完善。