modusox.bas

入侵检测是近几年发展起来的新型网络安全策略

    '********************************************************************************
    'Create a window. It will be used for hooking messages for registered
    'sockets, and we'll not see this window as the ShowWindow is never called.
    p_lngWindowHandle = CreateWindowEx(0&, "STATIC", "SOCKET_WINDOW", 0&, 0&, 0&, 0&, 0&, 0&, 0&, App.hInstance, ByVal 0&)
    If p_lngWindowHandle = 0 Then
        'I really don't know - is this possible? Probably - yes,
        'due the lack of the system resources, for example.
        'In this case the function returns 0.
    Else
        'Register a callback function for the window created a moment ago in this function
        'm_lngPreviousValue - stores the returned value that is the pointer to the previous
        'callback window function. We'll need this value to destroy the window.
        m_lngPreviousValue = SetWindowLong(p_lngWindowHandle, GWL_WNDPROC, AddressOf WindowProc)
        'Just to let the caller know that the function was executed successfully
        CreateWinsockMessageWindow = p_lngWindowHandle
    End If
End Function
Private Function DestroyWinsockMessageWindow() As Boolean
    '********************************************************************************
    'Author    :Oleg Gdalevich
    'Date/Time :17-12-2001
    'Purpose   :Destroyes the window
    'Returns   :If the window was destroyed successfully - True.
    '********************************************************************************
    On Error GoTo ERR_HANDLER
    'Return the previous window procedure
    SetWindowLong p_lngWindowHandle, GWL_WNDPROC, m_lngPreviousValue
    'Destroy the window
    DestroyWindow p_lngWindowHandle
    'Debug.Print "The window " & p_lngWindowHandle & " is destroyed"
    'Reset the window handle variable
    p_lngWindowHandle = 0
    'If no errors occurred, the function returns True
    DestroyWinsockMessageWindow = True
ERR_HANDLER:
    Err.Clear
End Function
Private Function SocketObjectFromPointer(ByVal lngPointer As Long) As clsSocket
    Dim objSocket                   As clsSocket
    CopyMemory objSocket, lngPointer, 4&
    Set SocketObjectFromPointer = objSocket
    CopyMemory objSocket, 0&, 4&
End Function
Private Function LoWord(lngValue As Long) As Long
    LoWord = (lngValue And &HFFFF&)
End Function
Private Function HiWord(lngValue As Long) As Long
    If (lngValue And &H80000000) = &H80000000 Then
        HiWord = ((lngValue And &H7FFF0000) \ &H10000) Or &H8000&
    Else
        HiWord = (lngValue And &HFFFF0000) \ &H10000
    End If
End Function
Public Function GetErrorDescription(ByVal lngErrorCode As Long) As String
    Dim strDesc                     As String
    Select Case lngErrorCode
        Case WSAEACCES
            strDesc = "Permission denied."
        Case WSAEADDRINUSE
            strDesc = "Address already in use."
        Case WSAEADDRNOTAVAIL
            strDesc = "Cannot assign requested address."
        Case WSAEAFNOSUPPORT
            strDesc = "Address family not supported by protocol family."
        Case WSAEALREADY
            strDesc = "Operation already in progress."
        Case WSAECONNABORTED
            strDesc = "Software caused connection abort."
        Case WSAECONNREFUSED
            strDesc = "Connection refused."
        Case WSAECONNRESET
            strDesc = "Connection reset by peer."
        Case WSAEDESTADDRREQ
            strDesc = "Destination address required."
        Case WSAEFAULT
            strDesc = "Bad address."
        Case WSAEHOSTDOWN
            strDesc = "Host is down."
        Case WSAEHOSTUNREACH
            strDesc = "No route to host."
        Case WSAEINPROGRESS
            strDesc = "Operation now in progress."
        Case WSAEINTR
            strDesc = "Interrupted function call."
        Case WSAEINVAL
            strDesc = "Invalid argument."
        Case WSAEISCONN
            strDesc = "Socket is already connected."
        Case WSAEMFILE
            strDesc = "Too many open files."
        Case WSAEMSGSIZE
            strDesc = "Message too long."
        Case WSAENETDOWN
            strDesc = "Network is down."
        Case WSAENETRESET
            strDesc = "Network dropped connection on reset."
        Case WSAENETUNREACH
            strDesc = "Network is unreachable."
        Case WSAENOBUFS
            strDesc = "No buffer space available."
        Case WSAENOPROTOOPT
            strDesc = "Bad protocol option."
        Case WSAENOTCONN
            strDesc = "Socket is not connected."
        Case WSAENOTSOCK
            strDesc = "Socket operation on nonsocket."
        Case WSAEOPNOTSUPP
            strDesc = "Operation not supported."
        Case WSAEPFNOSUPPORT
            strDesc = "Protocol family not supported."
        Case WSAEPROCLIM
            strDesc = "Too many processes."
        Case WSAEPROTONOSUPPORT
            strDesc = "Protocol not supported."
        Case WSAEPROTOTYPE
            strDesc = "Protocol wrong type for socket."
        Case WSAESHUTDOWN
            strDesc = "Cannot send after socket shutdown."
        Case WSAESOCKTNOSUPPORT
            strDesc = "Socket type not supported."
        Case WSAETIMEDOUT
            strDesc = "Connection timed out."
        Case WSATYPE_NOT_FOUND
            strDesc = "Class type not found."
        Case WSAEWOULDBLOCK
            strDesc = "Resource temporarily unavailable."
        Case WSAHOST_NOT_FOUND
            strDesc = "Host not found."
        Case WSANOTINITIALISED
            strDesc = "Successful WSAStartup not yet performed."
        Case WSANO_DATA
            strDesc = "Valid name, no data record of requested type."
        Case WSANO_RECOVERY
            strDesc = "This is a nonrecoverable error."
        Case WSASYSCALLFAILURE
            strDesc = "System call failure."
        Case WSASYSNOTREADY
            strDesc = "Network subsystem is unavailable."
        Case WSATRY_AGAIN
            strDesc = "Nonauthoritative host not found."
        Case WSAVERNOTSUPPORTED
            strDesc = "Winsock.dll version out of range."
        Case WSAEDISCON
            strDesc = "Graceful shutdown in progress."
        Case Else
            strDesc = "Unknown error."
    End Select
    GetErrorDescription = strDesc
End Function
Public Function InitWinsockService() As Long
    'This functon does two things; it initializes the Winsock
    'service and returns value of maximum size of the UDP
    'message. Since this module is supposed to serve multiple
    'instances of the CSocket class, this function can be
    'called several times. But we need to call the WSAStartup
    'Winsock API function only once when the first instance of
    'the CSocket class is created.
    Dim lngRetVal                   As Long     'value returned by WSAStartup
    Dim strErrorMsg                 As String   'error description string
    Dim udtWinsockData              As WSAData  'structure to pass to WSAStartup as an argument
    If Not m_blnWinsockInit Then
        'start up winsock service
        lngRetVal = WSAStartup(&H101, udtWinsockData)
        If lngRetVal <> 0 Then
            'The system cannot load the Winsock library.
            Select Case lngRetVal
                Case WSASYSNOTREADY
                    strErrorMsg = "The underlying network subsystem is not ready for network communication."
                Case WSAVERNOTSUPPORTED
                    strErrorMsg = "The version of Windows Sockets API support requested is not provided by this particular Windows Sockets implementation."
                Case WSAEINVAL
                    strErrorMsg = "The Windows Sockets version specified by the application is not supported by this DLL."
            End Select
            Err.Raise Err.LastDllError, "MSocketSupport.InitWinsockService", strErrorMsg
        Else
            'The Winsock library is loaded successfully.
            m_blnWinsockInit = True
            'This function returns returns value of
            'maximum size of the UDP message
            m_lngMaxMsgSize = IntegerToUnsigned(udtWinsockData.iMaxUdpDg)
            InitWinsockService = m_lngMaxMsgSize
            m_lngResolveMessage = RegisterWindowMessage(App.EXEName & ".ResolveMessage")
            p_lngWinsockMessage = RegisterWindowMessage(App.EXEName & ".WinsockMessage")
        End If
    Else
        'If this function has been called before by another
        'instance of the CSocket class, the code to init the
        'Winsock service must not be executed, but the function
        'returns maximum size of the UDP message anyway.
        InitWinsockService = m_lngMaxMsgSize
    End If
End Function
Public Sub CleanupWinsock()
    '********************************************************************************
    'This subroutine is called from the Class_Terminate() event
    'procedure of any instance of the CSocket class. But the WSACleanup
    'Winsock API function is called only if the calling object is the
    'last instance of the CSocket class within the current process.
    '********************************************************************************
    'If the Winsock library was loaded
    'before and there are no more sockets.
    If m_blnWinsockInit And m_colSockets Is Nothing Then
        'Unload library and free the system resources
        Call WSACleanup
        'Turn off the m_blnWinsockInit flag variable
        m_blnWinsockInit = False
    End If
End Sub
Public Function StringFromPointer(ByVal lPointer As Long) As String
    Dim strTemp                     As String
    Dim lRetVal                     As Long
    'prepare the strTemp buffer
    strTemp = String$(lstrlen(ByVal lPointer), 0)
    'copy the string into the strTemp buffer
    lRetVal = lstrcpy(ByVal strTemp, ByVal lPointer)
    'return a string
    If lRetVal Then StringFromPointer = strTemp
End Function
Public Function UnsignedToLong(Value As Double) As Long
    'The function takes a Double containing a value in the