Başlamadan önce formumuzda 1 adet buton (Command1) 1 adet de listview (Listview1)'e ihtiyacımız olucak.Amacımız bilgisayarımızdaki kullanılan TCP portlarını durumlarıyla beraber listelemek.
'------------------------Tanımlar-------------------------
Option Explicit
Private Type MIB_TCPROW
dwState As Long
dwLocalAddr As Long
dwLocalPort As Long
dwRemoteAddr As Long
dwRemotePort As Long
End Type
Private Const ERROR_SUCCESS As Long = 0
Private Const MIB_TCP_STATE_CLOSED As Long = 1
Private Const MIB_TCP_STATE_LISTEN As Long = 2
Private Const MIB_TCP_STATE_SYN_SENT As Long = 3
Private Const MIB_TCP_STATE_SYN_RCVD As Long = 4
Private Const MIB_TCP_STATE_ESTAB As Long = 5
Private Const MIB_TCP_STATE_FIN_WAIT1 As Long = 6
Private Const MIB_TCP_STATE_FIN_WAIT2 As Long = 7
Private Const MIB_TCP_STATE_CLOSE_WAIT As Long = 8
Private Const MIB_TCP_STATE_CLOSING As Long = 9
Private Const MIB_TCP_STATE_LAST_ACK As Long = 10
Private Const MIB_TCP_STATE_TIME_WAIT As Long = 11
Private Const MIB_TCP_STATE_DELETE_TCB As Long = 12
Private Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable As Any, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dst As Any, src As Any, ByVal bcount As Long)
Private Declare Function lstrcpyA Lib "kernel32" (ByVal RetVal As String, ByVal Ptr As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long
Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal addr As Long) As Long
Private Declare Function ntohs Lib "wsock32.dll" (ByVal addr As Long) As Long
Public Function GetInetAddrStr(Address As Long) As String
GetInetAddrStr = GetString(inet_ntoa(Address))
End Function
'-------Listview1'de oluşacak alanları ekleyelim---------
Private Sub Form_Load()
With ListView1
.View = lvwReport
.ColumnHeaders.Add , , "Yerel IP adresi"
.ColumnHeaders.Add , , "Yerel Port"
.ColumnHeaders.Add , , "Yabancı IP adresi"
.ColumnHeaders.Add , , "Yabancı Port"
.ColumnHeaders.Add , , "Durum "
End With
End Sub'Böylelikle form başlarken listview'de
'alanlar belirlendi.------------------------
'Şimdi'de seçilen kolon ile ilgili bilgileri alıyoruz-------
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As ColumnHeader)
ListView1.SortKey = ColumnHeader.Index - 1
ListView1.SortOrder = Abs(Not ListView1.SortOrder = 1)
ListView1.Sorted = True
End Sub
'-------Fonksiyonun değerlerini alıyoruz-----------------
Public Function GetString(ByVal lpszA As Long) As String
GetString = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal GetString, ByVal lpszA)
End Function
'---------Command1 de yapılacaklar listteleniyor----------
Private Sub Command1_Click()
Dim TcpRow As MIB_TCPROW
Dim buff() As Byte
Dim lngRequired As Long
Dim lngStrucSize As Long
Dim lngRows As Long
Dim lngCnt As Long
Dim strTmp As String
Dim lstLine As ListItem
Call GetTcpTable(ByVal 0&, lngRequired, 1)
If lngRequired > 0 Then
ReDim buff(0 To lngRequired - 1) As Byte
If GetTcpTable(buff(0), lngRequired, 1) = ERROR_SUCCESS Then
lngStrucSize = LenB(TcpRow)
'first 4 bytes indicate the number of entries
CopyMemory lngRows, buff(0), 4
For lngCnt = 1 To lngRows
'moves past the four bytes obtained above
'to get data and cast into a TcpRow stucture
CopyMemory TcpRow, buff(4 + (lngCnt - 1) * lngStrucSize), lngStrucSize
'sends results to the listview
With TcpRow
Set lstLine = ListView1.ListItems.Add(, , GetInetAddrStr(.dwLocalAddr))
lstLine.SubItems(1) = ntohs(.dwLocalPort)
lstLine.SubItems(2) = GetInetAddrStr(.dwRemoteAddr)
lstLine.SubItems(3) = ntohs(.dwRemotePort)
lstLine.SubItems(4) = (.dwState)
Select Case .dwState
Case MIB_TCP_STATE_CLOSED: strTmp = "Kapandı"
Case MIB_TCP_STATE_LISTEN: strTmp = "Dinleniyor"
Case MIB_TCP_STATE_SYN_SENT: strTmp = "Gönderilen"
Case MIB_TCP_STATE_SYN_RCVD: strTmp = "Alınan"
Case MIB_TCP_STATE_ESTAB: strTmp = "Bağlandı"
Case MIB_TCP_STATE_FIN_WAIT1: strTmp = "Sonlandı bekliyor"
Case MIB_TCP_STATE_FIN_WAIT2: strTmp = "Sonlandı bekliyor"
Case MIB_TCP_STATE_CLOSE_WAIT: strTmp = "Kapandı bekliyor"
Case MIB_TCP_STATE_CLOSING: strTmp = "Kapanıyor"
Case MIB_TCP_STATE_LAST_ACK: strTmp = "Son hareket"
Case MIB_TCP_STATE_TIME_WAIT: strTmp = "Bekliyor"
Case MIB_TCP_STATE_DELETE_TCB: strTmp = "TCB silindi"
End Select
lstLine.SubItems(4) = lstLine.SubItems(4) & "( " & strTmp & " )"
strTmp = ""
End With
Next
End If
End If
End Sub
NOT : ALINTIDIR ama denedim kodlar sağlam ve güzeldir.
'------------------------Tanımlar-------------------------
Option Explicit
Private Type MIB_TCPROW
dwState As Long
dwLocalAddr As Long
dwLocalPort As Long
dwRemoteAddr As Long
dwRemotePort As Long
End Type
Private Const ERROR_SUCCESS As Long = 0
Private Const MIB_TCP_STATE_CLOSED As Long = 1
Private Const MIB_TCP_STATE_LISTEN As Long = 2
Private Const MIB_TCP_STATE_SYN_SENT As Long = 3
Private Const MIB_TCP_STATE_SYN_RCVD As Long = 4
Private Const MIB_TCP_STATE_ESTAB As Long = 5
Private Const MIB_TCP_STATE_FIN_WAIT1 As Long = 6
Private Const MIB_TCP_STATE_FIN_WAIT2 As Long = 7
Private Const MIB_TCP_STATE_CLOSE_WAIT As Long = 8
Private Const MIB_TCP_STATE_CLOSING As Long = 9
Private Const MIB_TCP_STATE_LAST_ACK As Long = 10
Private Const MIB_TCP_STATE_TIME_WAIT As Long = 11
Private Const MIB_TCP_STATE_DELETE_TCB As Long = 12
Private Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable As Any, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dst As Any, src As Any, ByVal bcount As Long)
Private Declare Function lstrcpyA Lib "kernel32" (ByVal RetVal As String, ByVal Ptr As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long
Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal addr As Long) As Long
Private Declare Function ntohs Lib "wsock32.dll" (ByVal addr As Long) As Long
Public Function GetInetAddrStr(Address As Long) As String
GetInetAddrStr = GetString(inet_ntoa(Address))
End Function
'-------Listview1'de oluşacak alanları ekleyelim---------
Private Sub Form_Load()
With ListView1
.View = lvwReport
.ColumnHeaders.Add , , "Yerel IP adresi"
.ColumnHeaders.Add , , "Yerel Port"
.ColumnHeaders.Add , , "Yabancı IP adresi"
.ColumnHeaders.Add , , "Yabancı Port"
.ColumnHeaders.Add , , "Durum "
End With
End Sub'Böylelikle form başlarken listview'de
'alanlar belirlendi.------------------------
'Şimdi'de seçilen kolon ile ilgili bilgileri alıyoruz-------
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As ColumnHeader)
ListView1.SortKey = ColumnHeader.Index - 1
ListView1.SortOrder = Abs(Not ListView1.SortOrder = 1)
ListView1.Sorted = True
End Sub
'-------Fonksiyonun değerlerini alıyoruz-----------------
Public Function GetString(ByVal lpszA As Long) As String
GetString = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal GetString, ByVal lpszA)
End Function
'---------Command1 de yapılacaklar listteleniyor----------
Private Sub Command1_Click()
Dim TcpRow As MIB_TCPROW
Dim buff() As Byte
Dim lngRequired As Long
Dim lngStrucSize As Long
Dim lngRows As Long
Dim lngCnt As Long
Dim strTmp As String
Dim lstLine As ListItem
Call GetTcpTable(ByVal 0&, lngRequired, 1)
If lngRequired > 0 Then
ReDim buff(0 To lngRequired - 1) As Byte
If GetTcpTable(buff(0), lngRequired, 1) = ERROR_SUCCESS Then
lngStrucSize = LenB(TcpRow)
'first 4 bytes indicate the number of entries
CopyMemory lngRows, buff(0), 4
For lngCnt = 1 To lngRows
'moves past the four bytes obtained above
'to get data and cast into a TcpRow stucture
CopyMemory TcpRow, buff(4 + (lngCnt - 1) * lngStrucSize), lngStrucSize
'sends results to the listview
With TcpRow
Set lstLine = ListView1.ListItems.Add(, , GetInetAddrStr(.dwLocalAddr))
lstLine.SubItems(1) = ntohs(.dwLocalPort)
lstLine.SubItems(2) = GetInetAddrStr(.dwRemoteAddr)
lstLine.SubItems(3) = ntohs(.dwRemotePort)
lstLine.SubItems(4) = (.dwState)
Select Case .dwState
Case MIB_TCP_STATE_CLOSED: strTmp = "Kapandı"
Case MIB_TCP_STATE_LISTEN: strTmp = "Dinleniyor"
Case MIB_TCP_STATE_SYN_SENT: strTmp = "Gönderilen"
Case MIB_TCP_STATE_SYN_RCVD: strTmp = "Alınan"
Case MIB_TCP_STATE_ESTAB: strTmp = "Bağlandı"
Case MIB_TCP_STATE_FIN_WAIT1: strTmp = "Sonlandı bekliyor"
Case MIB_TCP_STATE_FIN_WAIT2: strTmp = "Sonlandı bekliyor"
Case MIB_TCP_STATE_CLOSE_WAIT: strTmp = "Kapandı bekliyor"
Case MIB_TCP_STATE_CLOSING: strTmp = "Kapanıyor"
Case MIB_TCP_STATE_LAST_ACK: strTmp = "Son hareket"
Case MIB_TCP_STATE_TIME_WAIT: strTmp = "Bekliyor"
Case MIB_TCP_STATE_DELETE_TCB: strTmp = "TCB silindi"
End Select
lstLine.SubItems(4) = lstLine.SubItems(4) & "( " & strTmp & " )"
strTmp = ""
End With
Next
End If
End If
End Sub
NOT : ALINTIDIR ama denedim kodlar sağlam ve güzeldir.
