Hallo und herzlich willkommen zum IP Monitor Workshop. Heute wollen wir Ihnen zeigen, wie Sie mit wenig Aufwand ein kleines Programm entwickeln können, das alle IP Verbindungen Ihrer vorhandenen Netzwerkkarten protokolliert. Dazu benötigen wir erst einmal einige Deklarationen, die in unserem Programm den meisten Platz verschlingen. Die folgenden Deklarationen müssen in ein öffentliches Modul kopiert werden: Option Explicit ' Benötigte API-Deklarationen: Winsocket Public Declare Function WSAStartup Lib "wsock32.dll" ( _ ByVal wVersionRequired As Integer, _ ByRef lpWSAData As WSADATA) As Long Public Declare Function WSACleanup Lib "wsock32.dll" () As Long Public Declare Function WSAAsyncSelect Lib "wsock32.dll" ( _ ByVal s As Long, _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal lEvent As AsyncEvents) As Long Public Declare Function socket Lib "wsock32.dll" ( _ ByVal af As Long, _ ByVal lType As Long, _ ByVal Protocol As Long) As Long Public Declare Function closesocket Lib "wsock32.dll" ( _ ByVal s As Long) As Long Public Declare Function WSAIoctl Lib "ws2_32.dll" ( _ ByVal s As Long, _ ByVal dwIoControlCode As Long, _ ByRef lpvInBuffer As Any, _ ByVal cbInBuffer As Long, _ ByRef lpvOutBuffer As Any, _ ByVal cbOutBuffer As Long, _ ByRef lpcbBytesReturned As Long, _ ByRef lpOverlapped As Any, _ ByRef lpCompletionRoutine As Any) As Long Public Declare Function htons Lib "wsock32.dll" ( _ ByVal hostshort As Long) As Long Public Declare Function bind Lib "wsock32.dll" ( _ ByVal s As Long, _ ByRef addr As sockaddr, _ ByVal namelen As Long) As Long Public Declare Function recv Lib "wsock32.dll" ( _ ByVal s As Long, _ buf As Any, ByVal lLen As Long, _ ByVal flags As Long) As Long Public Declare Function inet_ntoa Lib "wsock32.dll" ( _ ByRef lIn As Any) As Long ' Weitere API-Deklarationen Public Declare Function GetDesktopWindow Lib "user32.dll" () As Long Public Declare Function DestroyWindow Lib "user32.dll" ( _ ByVal hwnd As Long) As Long Public Declare Function CreateWindowEx Lib "user32.dll" _ Alias "CreateWindowExA" ( _ ByVal dwExStyle As Long, _ ByVal lpClassName As String, _ ByVal lpWindowName As String, _ ByVal dwStyle As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByVal nWidth As Long, _ ByVal nHeight As Long, _ ByVal hWndParent As Long, _ ByVal hMenu As Long, _ ByVal hInstance As Long, _ ByRef lpParam As Any) As Long Public Declare Function GetWindowLong Lib "user32.dll" _ Alias "GetWindowLongA" ( _ ByVal hwnd As Long, _ ByVal nIndex As WindowLongFlags) As Long Public Declare Function SetWindowLong Lib "user32.dll" _ Alias "SetWindowLongA" ( _ ByVal hwnd As Long, _ ByVal nIndex As WindowLongFlags, _ ByVal dwNewLong As Long) As Long Public Declare Function CallWindowProc Lib "user32.dll" _ Alias "CallWindowProcA" ( _ ByVal lpPrevWndFunc As Long, _ ByVal hwnd As Long, _ ByVal msg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Public Declare Function SetProp Lib "user32.dll" _ Alias "SetPropA" ( _ ByVal hwnd As Long, _ ByVal lpString As String, _ ByVal hData As Long) As Long Public Declare Function RemoveProp Lib "user32.dll" _ Alias "RemovePropA" ( _ ByVal hwnd As Long, _ ByVal lpString As String) As Long Public Declare Function GetProp Lib "user32.dll" _ Alias "GetPropA" ( _ ByVal hwnd As Long, _ ByVal lpString As String) As Long Public Declare Function GlobalUnlock Lib "kernel32.dll" ( _ ByVal hMem As Long) As Long Public Declare Function GlobalAlloc Lib "kernel32.dll" ( _ ByVal wFlags As GMEMFlags, _ ByVal dwBytes As Long) As Long Public Declare Function GlobalFree Lib "kernel32.dll" ( _ ByVal hMem As Long) As Long Public Declare Function GlobalLock Lib "kernel32.dll" ( _ ByVal hMem As Long) As Long Public Declare Function lstrlen Lib "kernel32.dll" _ Alias "lstrlenA" ( _ lpString As Any) As Long Public Declare Sub CopyMemory Lib "kernel32.dll" _ Alias "RtlMoveMemory" ( _ Destination As Any, _ Source As Any, _ ByVal Length As Long) Public Enum GMEMFlags GMEM_FIXED = &H0 GMEM_MOVEABLE = &H2 GMEM_ZEROINIT = &H40 End Enum Public Enum WindowLongFlags GWL_EXSTYLE = -20 GWL_STYLE = -16 GWL_WNDPROC = -4 End Enum Public Enum AsyncEvents FD_READ = &H1 FD_WRITE = &H2 FD_CONNECT = &H10 FD_CLOSE = &H20 FD_ACCEPT = &H8 FD_MAX_EVENTS = 1023 End Enum Public Type WSADATA wVersion As Integer wHighVersion As Integer szDescription As String * 11 szSystemStatus As String * 129 iMaxSockets As Integer iMaxUdpDg As Integer lpVendorInfo As Long End Type Public Type ip_hdr hlv As Byte tos As Byte tot_len As Integer id As Integer frag_off As Integer ttl As Byte Protocol As Byte check As Integer saddr As Long daddr As Long End Type Public Type icmp_hdr type As Byte code As Byte checksum As Integer id As Integer sequence As Integer End Type Public Type tcp_hdr Source As Integer dest As Integer seq As Long ack_seq As Long unused As Byte flags As Byte window As Integer check As Integer urp_ptr As Integer End Type Public Type udp_hdr Source As Integer dest As Integer len As Integer check As Integer End Type Public Type sockaddr sin_family As Integer sin_port As Integer sin_addr As Long sin_zero(7) As Byte End Type Public Type SOCKET_ADDRESS lpSockaddr As sockaddr iSockaddrLength As Integer End Type Public Type SOCKET_ADDRESS_LIST iAddressCount As Integer Address() As SOCKET_ADDRESS End Type Public Const AF_INET = 2 Public Const IPPROTO_IP = 0 Public Const SOCK_RAW = 3 Public Const SIO_ADDRESS_LIST_QUERY = &H48000016 Public Const SIO_RCVALL = &H98000001 Public Const WM_USER = &H400 Public Const WM_WSOCK = WM_USER + &HFF Public Const ClassPtr = "clsWSockPtr" Public Const OldProc = "WskOldProc" Subclassing der Winsock-Nachrichten Wie Sie sicher schon aus der Deklaration entnehmen konnten, verwendet unser Programm SubClassing. Dies ist nötig, um Ereignisse von den Windows-Sockets zu erhalten und ist um einiges agiler als z. B. eine fortlaufende Schleife. Das SubClassing erfordert noch einige Prozeduren, die uns dabei behilflich sind, innerhalb der Fensterprozedur unsere Klasse (IPMon) wieder zu finden. Dazu schreiben wir folgende Prozedur ebenfalls in das öffentliche Modul: ' Einem Fenster eine neue Eigenschaft "spendieren" Private Function PropAdd(ByVal hwnd As Long, ByVal PropName As String, _ ByVal Prop As Long) Dim hMem As Long Dim pMem As Long PropRem hwnd, PropName hMem = GlobalAlloc(GMEM_FIXED Or GMEM_ZEROINIT, 4) If hMem <> 0 Then pMem = GlobalLock(hMem) CopyMemory ByVal pMem, Prop, 4 Call GlobalUnlock(hMem) Call SetProp(hwnd, PropName, hMem) End If End Function ' Wert der zusätzlich hinzugefügten Fenster-Eigenschaft auslesen Private Function PropGet(ByVal hwnd As Long, ByVal PropName As String) As Long Dim hMem As Long Dim pMem As Long hMem = GetProp(hwnd, PropName) If hMem <> 0 Then pMem = GlobalLock(hMem) If pMem <> 0 Then CopyMemory PropGet, ByVal pMem, 4 Call GlobalUnlock(hMem) End If End If End Function ' Hinzugefügte Fenster-Eigenschaft wieder entfernen Private Function PropRem(ByVal hwnd As Long, ByVal PropName As String) As Long Dim hMem As Long Dim pMem As Long hMem = RemoveProp(hwnd, PropName) If hMem <> 0 Then pMem = GlobalLock(hMem) If pMem <> 0 Then CopyMemory PropRem, ByVal pMem, 4 Call GlobalUnlock(hMem) Call GlobalFree(hMem) End If End If End Function ' bestimmtes Fenster subclassen und die Fensternachrichten ' an unsere eigene WindowProc-Prozedur umleiten Public Function SubClass(ByVal hwnd As Long, ByVal bSubClass As Boolean, _ Optional ByVal ClassObjPtr As Long) Dim TmpProc As Long If bSubClass Then TmpProc = GetWindowLong(hwnd, GWL_WNDPROC) Call PropAdd(hwnd, OldProc, TmpProc) Call PropAdd(hwnd, ClassPtr, ClassObjPtr) Call SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc) Else TmpProc = PropGet(hwnd, OldProc) If TmpProc <> 0 Then Call SetWindowLong(hwnd, GWL_WNDPROC, TmpProc) Call PropRem(hwnd, OldProc) Call PropRem(hwnd, ClassPtr) End If End If End Function ' Über diese Prozedur können wir alle Winsock-Nachrichten auswerten Public Function WindowProc(ByVal hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Dim IM As IPMon Dim TmpPtr As Long Dim TmpProc As Long Dim Buffer() As Byte Dim BufferLen As Long Dim Retval As Long Dim IP As ip_hdr Dim src As sockaddr Dim dst As sockaddr Dim TCP As tcp_hdr Dim UDP As udp_hdr Dim ICMP As icmp_hdr Dim SIP As String Dim DIP As String TmpProc = PropGet(hwnd, OldProc) Select Case wMsg Case WM_WSOCK TmpPtr = PropGet(hwnd, ClassPtr) If TmpPtr <> 0 Then CopyMemory IM, TmpPtr, 4 Select Case CLng("&H" & Right(Right("00000000" & Hex(lParam), 8), 4)) Case FD_READ BufferLen = 4096 ReDim Buffer(BufferLen - 1) Retval = recv(wParam, Buffer(0), BufferLen, 0) If Retval <> -1 Then CopyMemory IP, Buffer(0), Len(IP) src.sin_addr = IP.saddr dst.sin_addr = IP.daddr SIP = Space$(lstrlen(ByVal inet_ntoa(ByVal src.sin_addr))) & vbNullChar CopyMemory ByVal SIP, ByVal inet_ntoa(ByVal src.sin_addr), Len(SIP) SIP = Trim$(Left$(SIP, Len(SIP) - 1)) DIP = Space$(lstrlen(ByVal inet_ntoa(ByVal dst.sin_addr))) & vbNullChar CopyMemory ByVal DIP, ByVal inet_ntoa(ByVal dst.sin_addr), Len(DIP) DIP = Trim$(Left$(DIP, Len(DIP) - 1)) Select Case IP.Protocol Case 6 ' TCP CopyMemory TCP, Buffer(Len(IP)), Len(TCP) IM.ConArrived ProtocolType.TCP, SIP, htons(TCP.Source), DIP, htons(TCP.dest) Case 7 ' UDP CopyMemory UDP, Buffer(Len(IP)), Len(UDP) IM.ConArrived ProtocolType.UDP, SIP, htons(UDP.Source), DIP, htons(UDP.dest) Case 8 ' ICMP CopyMemory ICMP, Buffer(Len(IP)), Len(ICMP) IM.ConArrived ProtocolType.ICMP, SIP, htons(ICMP.type), DIP, htons(ICMP.code) Case Else ' Unkwnown IM.ConArrived ProtocolType.Unknwon, SIP, 0, DIP, 0 End Select End If End Select CopyMemory IM, 0&, 4 End If End Select WindowProc = CallWindowProc(TmpProc, hwnd, wMsg, wParam, lParam) End Function Die IP-Monitor-Klasse Nun geht's es auch schon los mit unserer Klasse "IPMon". Beim Initialisieren der Klasse müssen wir zunächst die vorhandenen Adapter des Systems ermitteln. Dies machen wir mittels Winsock und einem Raw-Socket. Ein Raw-Socket empfängt keine Daten die über Winsock gesendet / empfangen werden, sondern nur Informationen über einen Verbindungsaufbau. Die empfangenen Daten entsprechen immer einer gewissen Struktur, beginnend mit einem "IP-Header". In dem IP-Header sind dann Einstellungen lesbar, die beschreiben, welche Daten außerdem empfangen wurden. Unser Programm unterstützt dazu TCP, UDP und ICMP. Außer dem Ermitteln aller Adapter, wird beim Initialisieren der Klasse ein Fenster per API erstellt und das SubClassing für dieses Fenster gestartet. Wir könnten auch unsere Form dazu verwenden, externe Fenster sind aber um einiges leichter zu debuggen. Nun wollen wir auch gleich folgenden Code in die IPMon Klasse einfügen: Option Explicit Public Enum ProtocolType TCP = 0 UDP = 1 ICMP = 2 Unknwon = 3 End Enum Public Event ConnectionDetected( _ ByVal Protocol As ProtocolType, _ ByVal SrcIP As String, _ ByVal SrcPort As Long, _ ByVal DestIP As String, _ ByVal DestPort As Long) Private SockList As SOCKET_ADDRESS_LIST Private AIndex As Integer Private hSock As Long Private hSockWnd As Long Private Sub Class_Initialize() Dim Retval As Long Dim i As Long Dim WD As WSADATA Dim Buffer() As Byte Dim BufferLen As Long Dim BuffRet As Long Dim BuffOffset As Long ' Winsocket initialisieren Retval = WSAStartup(&H202, WD) If Retval <> 0 Then MsgBox "Error: can't initialise Winsock 2.2" Exit Sub End If BufferLen = 4096 ReDim Buffer(BufferLen - 1) hSock = socket(AF_INET, SOCK_RAW, IPPROTO_IP) If hSock = -1 Then MsgBox "Error, can't create socket" GoTo ErrOut End If ' alle Netzwerk-Adapter in Erfahrung bringen Retval = WSAIoctl(hSock, SIO_ADDRESS_LIST_QUERY, ByVal 0&, 0&, Buffer(0), _ BufferLen, BuffRet, ByVal 0&, ByVal 0&) If Retval <> 0 Then MsgBox "Error, can't set Sock options" GoTo ErrOut End If CopyMemory SockList.iAddressCount, Buffer(0), 4 If SockList.iAddressCount > 0 Then ReDim SockList.Address(SockList.iAddressCount - 1) BuffOffset = 4 For i = 0 To SockList.iAddressCount - 1 BuffOffset = BuffOffset + 4 CopyMemory SockList.Address(i).iSockaddrLength, Buffer(BuffOffset), 2 BuffOffset = BuffOffset + 4 Next i For i = 0 To SockList.iAddressCount - 1 CopyMemory SockList.Address(i).lpSockaddr, Buffer(BuffOffset), _ SockList.Address(i).iSockaddrLength BuffOffset = BuffOffset + Len(SockList.Address(i).lpSockaddr) Next i End If ' Socket schließen Call closesocket(hSock) hSock = 0 ' temporäres Fenster für's Subclassing erstellen hSockWnd = CreateWindowEx(0, "Edit", "WSockMsgWnd", 0, 10, 10, 10, 10, _ GetDesktopWindow, 0, App.hInstance, ByVal 0&) If hSockWnd = 0 Then MsgBox "Error, can't create Message Window" GoTo ErrOut End If ' Subclassing starten (Socket-Nachrichten werden über unser ' "WSockMsgWnd"-Fenster abgefangen) SubClass hSockWnd, True, ObjPtr(Me) AIndex = -1 ErrOut: End Sub Private Sub Class_Terminate() ' Subclassing beenden und "aufräumen" Call SubClass(hSockWnd, False) Call closesocket(hSock) Call WSACleanup Call DestroyWindow(hSockWnd) End Sub Damit wir nicht nur eine SubClassing-Routine ohne Funktion haben, sollten wir folgenden Code einfügen, der dafür sorgt, dass uns das Windows-Socketsystem auch über die Verbindungen informiert. Dazu erstellen wir ein neues Raw-Socket und teilen Windows mit, das wir die Ereignisse über unser zuvor erstelltes Fenster empfangen wollen. Die SubClassing-Routine wertet dann diese Daten aus und sendet sie wieder an unsere Klasse, die wiederum das entsprechende Ereignis aufruft. ' Anzahl der vorhandenen Netzwerk-Adapter zurückgeben Public Property Get AdaptersCount() As Integer AdaptersCount = SockList.iAddressCount End Property ' Netzwerk-Adapter festlegen, der abgehört werden soll Public Property Get AdapterIndex() As Integer AdapterIndex = AIndex End Property Public Property Let AdapterIndex(ByVal NewIndex As Integer) Dim IFace As sockaddr Dim Retval As Long Dim TmpLng As Long Dim BuffRet As Long If NewIndex < 0 Or NewIndex >= SockList.iAddressCount Then MsgBox "Error, no Adapter" Exit Property End If AIndex = NewIndex If hSock <> 0 Then Call closesocket(hSock) hSock = 0 End If hSock = socket(AF_INET, SOCK_RAW, IPPROTO_IP) If hSock = -1 Then MsgBox "Error, can't create socket" Exit Property End If With IFace .sin_family = AF_INET .sin_port = htons(0) .sin_addr = SockList.Address(AIndex).lpSockaddr.sin_addr End With Retval = bind(hSock, IFace, Len(IFace)) If Retval <> 0 Then MsgBox "Error, can't bin socket" End If TmpLng = 1 Retval = WSAIoctl(hSock, SIO_RCVALL, TmpLng, Len(TmpLng), _ ByVal 0&, 0, BuffRet, ByVal 0&, ByVal 0&) If Retval <> 0 Then MsgBox "Error, can't set sock options" End If Retval = WSAAsyncSelect(hSock, hSockWnd, WM_WSOCK, FD_MAX_EVENTS) If Retval <> 0 Then MsgBox "Error, can't set sock window" End If End Property ' IP-Adresse des gewählten Netzwerk-Adapters ermitteln und zurückgeben Public Property Get AdapterIP(ByVal Index As Integer) As String Dim TmpIP As String If Index < 0 Or Index >= SockList.iAddressCount Then MsgBox "Error, no Adapter" Exit Property End If With SockList.Address(Index) TmpIP = Space$(lstrlen(ByVal inet_ntoa(ByVal .lpSockaddr.sin_addr))) & vbNullChar CopyMemory ByVal TmpIP, ByVal inet_ntoa(ByVal .lpSockaddr.sin_addr), Len(TmpIP) End With AdapterIP = Trim$(Left$(TmpIP, Len(TmpIP) - 1)) End Property ' Diese Funktion wird ausgelöst, wenn eine IP-Verbindung "entdeckt" wurde ' und löst gleichzeitig unser definiertes Klassen-Ereignis "ConnectionDetected" aus Friend Sub ConArrived(ByVal PType As ProtocolType, ByVal SIP As String, _ ByVal SPort As Long, ByVal DIP As String, ByVal DPort As Long) RaiseEvent ConnectionDetected(PType, SIP, SPort, DIP, DPort) End Sub Anwendung der IPMonitor-Klasse Nun fehlt uns eigentlich nur noch eine Form, die unsere Klasse zu verwenden weiß. Dazu platzieren wir eine Combobox (Combo1) und eine Textbox (Text1) mit der Eigenschaft "MultiLine=True" auf unser Formular und geben folgenden Code in das Formular ein: Option Explicit ' IPMonitor-Klassen-Instanz Private WithEvents IM As IPMon Private Sub Form_Load() Dim i As Integer ' IP-Monitor-Klasse instanzieren Set IM = New IPMon ' zunächst alle verfügbaren Netzwerk-Adapter ' ermitteln und in der ComboBox zur Auswahl anbieten With IM For i = 0 To .AdaptersCount - 1 Combo1.AddItem .AdapterIP(i) Next i End With ' ersten Eintrag der ComboBox vorselektieren If Combo1.ListCount > 0 Then Combo1.ListIndex = 0 End Sub Private Sub Combo1_Click() ' der IP-Monitor-Klasse mitteilen, welcher ' Netzwerk-Adapter "abgehorcht" werden soll IM.AdapterIndex = Combo1.ListIndex ' TextBox leeren Text1.Text = "" End Sub ' Aha... es kommen Daten an... Private Sub IM_ConnectionDetected(ByVal Protocol As ProtocolType, _ ByVal SrcIP As String, _ ByVal SrcPort As Long, _ ByVal DestIP As String, _ ByVal DestPort As Long) Dim TmpStr As String Dim TmpProtocol As String Dim IP1 As String Dim IP2 As String ' Inhalt der TextBox "merken" TmpStr = Text1.Text If Len(TmpStr) > 1000 Then ' nur falls der Inhalt der TextBox zu groß wird :-) TmpStr = Mid(TmpStr, InStr(1, TmpStr, vbCrLf) + 2) End If If Len(TmpStr) > 0 Then TmpStr = TmpStr & vbCrLf Select Case Protocol Case ProtocolType.TCP TmpProtocol = "TCP " Case ProtocolType.UDP TmpProtocol = "UDP " Case ProtocolType.ICMP TmpProtocol = "ICMP" Case ProtocolType.Unknwon TmpProtocol = "Unb." End Select ' Infos ein wenig "formatieren" IP1 = SrcIP & ":" & SrcPort IP1 = IP1 & Space$(20 - Len(IP1)) IP2 = DestIP & ":" & DestPort TmpStr = TmpStr & FormatDateTime(Now, vbShortDate) & Space$(1) & _ FormatDateTime(Now, vbShortTime) & Space$(2) & _ TmpProtocol & Space$(1) & IP1 & "-> " & IP2 ' ...und ab in die TextBox... Text1.Text = TmpStr Text1.SelStart = Len(TmpStr) End Sub Wenn Sie nun das Programm starten, werden Ihnen alle Verbindungen aufgelistet, die Ihr System aufbaut. Dies ist besonders interessant um z. B. Spionagesoftware zu ermitteln oder das Internetverhalten zu studieren. Ich wünsche Ihnen weiterhin viel Spaß mit dem Beispielprogramm und frohes Schaffen. Gruß Dieser Workshop wurde bereits 26.420 mal aufgerufen.
Anzeige
![]() ![]() ![]() (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 ![]() ![]() Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats ![]() Dieter Otter PopUp-Menü wird nicht angezeigt :-( In diesem Tipp verraten wir Ihnen, wie Sie Probleme mit PopUp-Menüs umgehen können, wenn diese unter bestimmten Umständen einfach nicht angezeigt werden. sevOutBar 4.0 ![]() Vertikale Menüleisten á la Outlook Erstellen von Outlook ähnlichen Benutzer- interfaces - mit beliebig vielen Gruppen und Symboleinträgen. Moderner OfficeXP-Style mit Farbverläufen, Balloon-Tips, u.v.m. |
|||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |