www.pudn.com > ownfirewall > PWatchProc.bas

Attribute VB_Name = "PWatchProc" 
Option Explicit 
 
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal wndrpcPrev As Long, ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, lParam As Any) As Long 
Public Const GWL_WNDPROC = (-4) 
 
Public intSocket As Integer 
Public OldPwProc As Long 
Public NewSlot As Long 
Public IPDot As String 
Public Cur_Port As String 
 
Public Sub Get_Cur_Port(ByVal P As Long) 
Dim i As Integer 
  For i = 1 To PSW.Cnt 
    If PSW.No(i).WPort = P Then 
      Cur_Port = CStr(PSW.No(i).Port) 
    End If 
  Next 
End Sub 
 
Public Sub WriteLog(ByVal T As String) 
  Protect.LogWnd.AddItem T 
  Save2Log T 
End Sub 
 
Public Function PWatch_Proc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
 
Dim retf As Long 
Dim SendBuffer As String 
Dim lenBuffer As Integer 'send-buffer lenght 
Dim RecvBuffer As String 
Dim BytesRead As Integer 'receive-buffer lenght 
Dim i As Integer, GoAhead As Boolean 
Dim fixstr As String * 1024 
Dim lct As String, Ts As String 
Dim lcv As Integer 
Dim WSAEvent As Long 
Dim WSAError As Long 
  GoAhead = True 
  Select Case uMsg 
  Case 5150 
    Command1 
    Get_Cur_Port (wParam) 
    Ts = Cur_Port & "-|-NOTIFICATION - " & wParam & " - " & lParam & "> " & Format$(Date$, "dd/mm/yy ") & Format$(Time$, "hh:mm - ") 
    WriteLog Ts 
    If (wParam <> 0) Then '= ServerSlot) Or (wParam = NewSlot) Then 'event on server slot 
      WSAEvent = WSAGetSelectEvent(lParam) 
      WSAError = WSAGetAsyncError(lParam) 
      'WriteLog "Retf = "; WSAEvent; WSAError 
      Select Case WSAEvent 
        'FD_READ    = &H1    = 1 
        'FD_WRITE   = &H2    = 2 
        'FD_OOB     = &H4    = 4 
        'FD_ACCEPT  = &H8    = 8 
        'FD_CONNECT = &H10   = 16 
        'FD_CLOSE   = &H20   = 32 
      Case FD_CONNECT 
        WriteLog "PW_Connect " & wParam & " : " & lParam 
        retf = getpeername(NewSlot, SockAddr, SockAddr_Size) 
        IPDot = GetAscIP(SockAddr.sin_addr) 
        Ts = "IP:" & IPDot & " Port:" & ntohs(SockAddr.sin_port) & _ 
          " Host:" & vbGetHostByAddress(IPDot) 
        WriteLog Ts 
      Case FD_ACCEPT 
        WriteLog "Doing FD_Accept" 
        SockAddr.sin_family = AF_INET 
        SockAddr.sin_port = 0 
        'SockAddr.sin_addr = 0 
        NewSlot = accept(wParam, SockAddr, SockAddr_Size) 'try to accept new TCP connection 
        If NewSlot = INVALID_SOCKET Then 
          WriteLog "Can't accept new socket." 
        Else 
          WriteLog "NewSlot OK :" & NewSlot 
          retf = getpeername(NewSlot, SockAddr, SockAddr_Size) 
          IPDot = GetAscIP(SockAddr.sin_addr) 
          WriteLog IPDot & "<>" & vbGetHostByAddress(IPDot) 
          WriteLog " Port:" & ntohs(SockAddr.sin_port) 
          SendBuffer = "000-You've been caught hacking!!!" & vbCrLf & _ 
            vbGetHostByAddress(IPDot) & vbCrLf 
          lenBuffer = Len(SendBuffer) 
          retf = send(NewSlot, SendBuffer, lenBuffer, 0)          'send welcome message 
          WriteLog "Send = " & retf 
        End If 
      Case FD_READ 
        WriteLog "Doing FD_Read" 
        BytesRead = recv(wParam, fixstr, 1024, 0) 'store read bytes in RecvBuffer 
        RecvBuffer = Left$(fixstr, BytesRead) 
        WriteLog "Recvd:" & RecvBuffer 
      Case FD_CLOSE 
        WriteLog "Doing FD_Close" 
        retf = closesocket(wParam)        'connection closed by client 
      Case FD_WRITE 
        WriteLog "Doing FD_Write" 
        'enables sending 
      End Select 
    End If 
    'WriteLog GetWSAErrorString(WSAGetLastError) 
  End Select 
    retf = CallWindowProc(OldPwProc, hwnd, uMsg, wParam, ByVal lParam) 
    PWatch_Proc = retf 
End Function