modsocketmaster.bas

支持监控包括传输控制协议和 UDP 的所有的互联网传输协议。同时程序具有实时文件防修改监控功能

Attribute VB_Name = "modSocketMaster"
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：2007/09/20
'描    述：界面清爽VB版高级专业防火墙 Ver 2.0.3
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

Option Explicit
Public Const SOCKET_ERROR           As Long = -1
Public Const INVALID_SOCKET         As Long = -1
Public Const INADDR_NONE            As Long = &HFFFF
Private Const WSADESCRIPTION_LEN    As Long = 257
Private Const WSASYS_STATUS_LEN     As Long = 129
Private Enum WinsockVersion
    SOCKET_VERSION_11 = &H101
    SOCKET_VERSION_22 = &H202
End Enum
#If False Then 'Trick preserves Case of Enums when typing in IDE
Private SOCKET_VERSION_11, SOCKET_VERSION_22
#End If
Public Const MAXGETHOSTSTRUCT       As Long = 1024
Public Const AF_INET                As Long = 2
Public Const SOCK_STREAM            As Long = 1
Public Const SOCK_DGRAM             As Long = 2
Public Const IPPROTO_TCP            As Long = 6
Public Const IPPROTO_UDP            As Long = 17
Private Const FD_READ               As Long = &H1
Private Const FD_WRITE              As Long = &H2
Private Const FD_ACCEPT             As Long = &H8
Private Const FD_CONNECT            As Long = &H10
Private Const FD_CLOSE              As Long = &H20
Private Const OFFSET_2              As Long = 65536
Private Const MAXINT_2              As Long = 32767
Public Const GMEM_FIXED             As Long = &H0
Public Const LOCAL_HOST_BUFF        As Long = 256
Public Const SOL_SOCKET             As Long = 65535
Public Const SO_SNDBUF              As Long = &H1001&
Public Const SO_RCVBUF              As Long = &H1002&
Public Const SO_MAX_MSG_SIZE        As Long = &H2003
Public Const SO_BROADCAST           As Long = &H20
Public Const FIONREAD               As Long = &H4004667F
Private Const WSABASEERR            As Long = 10000
Private Const WSAEINTR              As Long = (WSABASEERR + 4)
Private Const WSAEACCES             As Long = (WSABASEERR + 13)
Private Const WSAEFAULT             As Long = (WSABASEERR + 14)
Private Const WSAEINVAL             As Long = (WSABASEERR + 22)
Private Const WSAEMFILE             As Long = (WSABASEERR + 24)
Public Const WSAEWOULDBLOCK         As Long = (WSABASEERR + 35)
Private Const WSAEINPROGRESS        As Long = (WSABASEERR + 36)
Private Const WSAEALREADY           As Long = (WSABASEERR + 37)
Private Const WSAENOTSOCK           As Long = (WSABASEERR + 38)
Private Const WSAEDESTADDRREQ       As Long = (WSABASEERR + 39)
Public Const WSAEMSGSIZE            As Long = (WSABASEERR + 40)
Private Const WSAEPROTOTYPE         As Long = (WSABASEERR + 41)
Private Const WSAENOPROTOOPT        As Long = (WSABASEERR + 42)
Private Const WSAEPROTONOSUPPORT    As Long = (WSABASEERR + 43)
Private Const WSAESOCKTNOSUPPORT    As Long = (WSABASEERR + 44)
Private Const WSAEOPNOTSUPP         As Long = (WSABASEERR + 45)
Private Const WSAEPFNOSUPPORT       As Long = (WSABASEERR + 46)
Public Const WSAEAFNOSUPPORT        As Long = (WSABASEERR + 47)
Private Const WSAEADDRINUSE         As Long = (WSABASEERR + 48)
Public Const WSAEADDRNOTAVAIL       As Long = (WSABASEERR + 49)
Private Const WSAENETDOWN           As Long = (WSABASEERR + 50)
Private Const WSAENETUNREACH        As Long = (WSABASEERR + 51)
Private Const WSAENETRESET          As Long = (WSABASEERR + 52)
Private Const WSAECONNABORTED       As Long = (WSABASEERR + 53)
Private Const WSAECONNRESET         As Long = (WSABASEERR + 54)
Private Const WSAENOBUFS            As Long = (WSABASEERR + 55)
Private Const WSAEISCONN            As Long = (WSABASEERR + 56)
Private Const WSAENOTCONN           As Long = (WSABASEERR + 57)
Private Const WSAESHUTDOWN          As Long = (WSABASEERR + 58)
Private Const WSAETIMEDOUT          As Long = (WSABASEERR + 60)
Private Const WSAEHOSTUNREACH       As Long = (WSABASEERR + 65)
Private Const WSAECONNREFUSED       As Long = (WSABASEERR + 61)
Private Const WSAEPROCLIM           As Long = (WSABASEERR + 67)
Private Const WSASYSNOTREADY        As Long = (WSABASEERR + 91)
Private Const WSAVERNOTSUPPORTED    As Long = (WSABASEERR + 92)
Private Const WSANOTINITIALISED     As Long = (WSABASEERR + 93)
Private Const WSAHOST_NOT_FOUND     As Long = (WSABASEERR + 1001)
Private Const WSATRY_AGAIN          As Long = (WSABASEERR + 1002)
Private Const WSANO_RECOVERY        As Long = (WSABASEERR + 1003)
Private Const WSANO_DATA            As Long = (WSABASEERR + 1004)
Public Const sckOutOfMemory         As Long = 7
Public Const sckBadState            As Long = 40006
Public Const sckInvalidArg          As Long = 40014
Public Const sckUnsupported         As Long = 40018
Public Const sckInvalidOp           As Long = 40020
Private Type WSAdata
    wVersion                            As Integer
    wHighVersion                        As Integer
    szDescription                       As String * WSADESCRIPTION_LEN
    szSystemStatus                      As String * WSASYS_STATUS_LEN
    iMaxSockets                         As Integer
    iMaxUdpDg                           As Integer
    lpVendorInfo                        As Long
End Type
Public Type Hostent
    hName                               As Long
    hAliases                            As Long
    hAddrType                           As Long
    hLength                             As Long
    hAddrList                           As Long
End Type
Public Type sockaddr_in
    sin_family                          As Integer
    sin_port                            As Integer
    sin_addr                            As Long
    sin_zero(1 To 8)                    As Byte
End Type
Private m_blnInitiated              As Boolean 'specify if winsock service was initiated
Private m_lngSocksQuantity          As Long    'number of instances created
Private m_colSocketsInst            As Collection 'sockets list and instance owner
Private m_colAcceptList             As Collection 'sockets in queue that need to be accepted
Private m_lngWindowHandle           As Long    'message window handle
Private Const PATCH_06              As Long = 106
Private Const PATCH_09              As Long = 137
Private Const GWL_WNDPROC           As Long = (-4)
Private Const WM_USER               As Long = &H400
Private Const RESOLVE_MESSAGE       As Long = WM_USER + &H400
Private Const SOCKET_MESSAGE        As Long = WM_USER + &H401
Private lngMsgCntA                  As Long    'TableA entry count
Private lngMsgCntB                  As Long    'TableB entry count
Private lngTableA1()                As Long    'TableA1: list of async handles
Private lngTableA2()                As Long    'TableA2: list of async handles owners
Private lngTableB1()                As Long    'TableB1: list of sockets
Private lngTableB2()                As Long    'TableB2: list of sockets owners
Private hWndSub                     As Long    'window handle subclassed
Private nAddrSubclass               As Long    'address of our WndProc
Private nAddrOriginal               As Long    'address of original WndProc
Public Declare Sub api_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _
                                                                        Source As Any, _
                                                                        ByVal Length As Long)
''Private Declare Function api_WSAGetLastError Lib "ws2_32.dll" Alias "WSAGetLastError" () As Long
Public Declare Function api_GlobalAlloc Lib "kernel32" Alias "GlobalAlloc" (ByVal wFlags As Long, _
                                                                            ByVal dwBytes As Long) As Long
Public Declare Function api_GlobalFree Lib "kernel32" Alias "GlobalFree" (ByVal hMem As Long) As Long
Private Declare Function api_WSAStartup Lib "ws2_32.dll" Alias "WSAStartup" (ByVal wVersionRequired As Long, _
                                                                             lpWSAData As WSAdata) As Long
Private Declare Function api_WSACleanup Lib "ws2_32.dll" Alias "WSACleanup" () As Long
Private Declare Function api_WSAAsyncGetHostByName Lib "ws2_32.dll" Alias "WSAAsyncGetHostByName" (ByVal hWnd As Long, _
                                                                                                   ByVal wMsg As Long, _
                                                                                                   ByVal strHostName As String, _
                                                                                                   buf As Any, _
                                                                                                   ByVal buflen As Long) As Long
Private Declare Function api_WSAAsyncSelect Lib "wsock32.dll" Alias "WSAAsyncSelect" (ByVal s As Long, _
                                                                                      ByVal hWnd As Long, _
                                                                                      ByVal wMsg As Long, _
                                                                                      ByVal lEvent As Long) As Long
Private Declare Function api_CreateWindowEx Lib "user32" 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, _
                                                                                  lpParam As Any) As Long
Private Declare Function api_DestroyWindow Lib "user32" Alias "DestroyWindow" (ByVal hWnd As Long) As Long
Private Declare Function api_lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Declare Function api_lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, _
                                                                      ByVal lpString2 As Long) As Long
Private Declare Function api_IsWindow Lib "user32" Alias "IsWindow" (ByVal hWnd As Long) As Long
Private Declare Function api_GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, _
                                                                                ByVal nIndex As Long) As Long
Private Declare Function api_SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, _
                                                                                ByVal nIndex As Long, _
                                                                                ByVal dwNewLong As Long) As Long
Private Declare Function api_GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function api_GetProcAddress Lib "kernel32" Alias "GetProcAddress" (ByVal hModule As Long, _
                                                                                   ByVal lpProcName As String) As Long
Private Function CreateWinsockMessageWindow() As Long
    m_lngWindowHandle = api_CreateWindowEx(0&, "STATIC", "SOCKET_WINDOW", 0&, 0&, 0&, 0&, 0&, 0&, 0&, App.hInstance, ByVal 0&)
    If m_lngWindowHandle = 0 Then
        CreateWinsockMessageWindow = sckOutOfMemory
    Else
        CreateWinsockMessageWindow = 0
    End If
End Function
Private Function DestroyWinsockMessageWindow() As Long
Dim lngResult As Long
    DestroyWinsockMessageWindow = 0
    If m_lngWindowHandle = 0 Then
        Exit Function
    End If
    lngResult = api_DestroyWindow(m_lngWindowHandle)
    If lngResult = 0 Then
        DestroyWinsockMessageWindow = sckOutOfMemory
        Err.Raise sckOutOfMemory, "modSocketMaster.DestroyWinsockMessageWindow", "Out of memory"
    Else
        m_lngWindowHandle = 0
    End If
End Function
Public Function FinalizeProcesses() As Long
Dim lngErrorCode As Long
    FinalizeProcesses = 0
    m_lngSocksQuantity = m_lngSocksQuantity - 1
    If m_blnInitiated And m_lngSocksQuantity = 0 Then
        If FinalizeService = SOCKET_ERROR Then
            lngErrorCode = Err.LastDllError
            FinalizeProcesses = lngErrorCode
            Err.Raise lngErrorCode, "modSocketMaster.FinalizeProcesses", GetErrorDescription(lngErrorCode)
        End If
        Subclass_Terminate
        m_blnInitiated = False
    End If
End Function
Private Function FinalizeService() As Long
Dim lngResultado As Long
    lngResultado = api_WSACleanup
    FinalizeService = lngResultado