cbotfactory.cls

vb中如何进行网络编程的示例,包括:UDP聊天,TCP聊天,UDP,TCP flood攻击等 非常棒

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CBotFactory"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'**************************************************************
'   IRC Bot Component
'       Author: Nicholas J. Felmlee
'       Email: [e-mail]
'       Last Revision: 07/18/98
'
'       Internal Dependencies:
'           WskSock.bas
'           Crypt.bas
'           CBotFactory.cls
'           CBotConn.cls
'
'       External Dependencies:
'           -none-
'
'**************************************************************

Option Explicit

'local variable(s) to hold property value(s)
Private mvarDisableDefaultOps As Boolean 'local copy
Private mvarMaxConnections As Integer 'local copy
Private mvarlpIRC_SOCKET As Long 'local copy
Private mvarhWnd As Long 'local copy
Private mvarWndProc As Long

Public Event onUserJoin(ByVal szUser As String, ByVal szHost As String, ByVal dwCount As Integer)
Public Event onUserPart(ByVal szName As String, ByVal dwCount As Integer)
Public Event onUserCommand(ByVal UserOb As Object, ByVal szCommand As String, ByVal szParams As String)


Private BotConns As New Collection

'internal levels
Private PRIV_OP As Integer
Private PRIV_DEOP As Integer
Private PRIV_PV As Integer
Private PRIV_MV As Integer
Private PRIV_KICK As Integer
Private PRIV_BAN As Integer
Private PRIV_UNBAN As Integer
Private PRIV_SAY As Integer
Private PRIV_KICKBAN As Integer
Private PRIV_PERMBAN As Integer
Private PRIV_TOPIC As Integer
Private PRIV_JOIN As Integer
Private PRIV_PART As Integer
Private PRIV_ADDUSER As Integer
Private PRIV_DELUSER As Integer
Private PRIV_LSUSERS As Integer
Private PRIV_SETPERMS As Integer

Private Function GetChannel(ByVal szLine As String) As String
    'channel is always the second argument in a user command
    GetChannel = getNextToken(szLine, " ")
End Function

Private Function GetPrivProfString(ByVal szSection As String, ByVal szKey As String, ByVal szFile As String)
    Dim ret As Long
    Dim retstr As String
    Dim file As String
    retstr = Space$(255)
    file = App.Path & "\" & szFile
    ret = GetPrivateProfileString(UCase$(szSection), UCase$(szKey), "", retstr, Len(retstr), file)
    GetPrivProfString = Left(retstr, ret)
End Function
Private Sub WritePrivProfString(ByVal szString As String, ByVal szSection As String, ByVal szKey As String, ByVal szFile As String)
    Dim ret As Long
    'Dim retstr As String
    Dim file As String
    file = App.Path & "\" & szFile
    ret = WritePrivateProfileString(UCase$(szSection), UCase$(szKey), szString, file)
End Sub

Private Function GetPrivProfSection(ByVal szSection As String)
    Dim ret As Long
    Dim retstr As String
    Dim file As String
    retstr = Space$(255)
    file = App.Path & "\pass.txt"
    ret = GetPrivateProfileSection(szSection, retstr, Len(retstr), file)
    'ret = GetPrivateProfileString(UCase$(szSection), UCase$(szKey), "", retstr, Len(retstr), file)
    GetPrivProfSection = Left(retstr, ret)
End Function
Public Property Let hWnd(ByVal vData As Long)
    mvarhWnd = vData
End Property


Public Property Get hWnd() As Long
    hWnd = mvarhWnd
End Property
Public Property Let WndProc(ByVal vData As Long)
    mvarWndProc = vData
End Property
Public Property Get WndProc() As Long
    WndProc = mvarWndProc
End Property


Public Sub GetNewConnection(szNick As String)
    Dim MySock As Long
    Dim addrlen&
    Dim ret&
    Dim sa As sockaddr
    Dim dwPort As Integer
    addrlen = sockaddr_size
    ret = getsockname(mvarlpIRC_SOCKET, sa, addrlen)
    dwPort = ListenToFreePort(MySock)
    Call SendData(mvarlpIRC_SOCKET, "PRIVMSG " & szNick & " :" & Chr(1) & "DCC CHAT chat " & htonl(sa.sin_addr) & " " & dwPort & Chr(1) & vbCrLf)
End Sub


Public Property Let lpIRC_SOCKET(ByVal vData As Long)
    mvarlpIRC_SOCKET = vData
End Property


Public Property Get lpIRC_SOCKET() As Long
    lpIRC_SOCKET = mvarlpIRC_SOCKET
End Property


'
Private Function ListenToFreePort(ByRef MySock As Long) As Integer
    Dim sockin As sockaddr
    Dim addrlen&, s&, Dummy&, SelectOps&
    sockin = saZero     'zero out the structure
    sockin.sin_family = AF_INET
    
    'sockin.sin_port = htons(0)
    sockin.sin_port = 0
    If sockin.sin_port = INVALID_SOCKET Then
        ListenToFreePort = INVALID_SOCKET
        Exit Function
    End If
    
    sockin.sin_addr = htonl(INADDR_ANY)
    If sockin.sin_addr = INADDR_NONE Then
        ListenToFreePort = INVALID_SOCKET
        Exit Function
    End If
    
    s = socket(PF_INET, SOCK_STREAM, 0)
    If s < 0 Then
        ListenToFreePort = INVALID_SOCKET
        Exit Function
    End If
    
    If bind(s, sockin, sockaddr_size) Then
        If s > 0 Then
            Dummy = closesocket(s)
        End If
        ListenToFreePort = INVALID_SOCKET
        Exit Function
    End If
    
    SelectOps = FD_READ Or FD_WRITE Or FD_CLOSE Or FD_ACCEPT
    If WSAAsyncSelect(s, mvarhWnd, ByVal 1025, ByVal SelectOps) Then
        If s > 0 Then
            Dummy = closesocket(s)
        End If
        ListenToFreePort = SOCKET_ERROR
        Exit Function
    End If
    
    If listen(s, 1) Then
        If s > 0 Then
            Dummy = closesocket(s)
        End If
        ListenToFreePort = INVALID_SOCKET
        Exit Function
    End If
    Dim sadd As sockaddr
    MySock = s
    addrlen = sockaddr_size
    Call getsockname(s, sadd, addrlen)
    ListenToFreePort = htons(sadd.sin_port)
End Function




Public Function ListUsers() As Object
End Function

Public Sub DelUser(ByVal szUser As String)
End Sub

Public Sub AddUser(ByVal szUser As String, ByVal szPass As String, ByVal dwLevel As Integer)
End Sub

Public Sub KickUser(ByVal szUser As String)
End Sub

Public Property Let MaxConnections(ByVal vData As Integer)
    mvarMaxConnections = vData
End Property


Public Property Get MaxConnections() As Integer
    MaxConnections = mvarMaxConnections
End Property



Public Property Let DisableDefaultOps(ByVal vData As Boolean)
    mvarDisableDefaultOps = vData
End Property


Public Property Get DisableDefaultOps() As Boolean
    DisableDefaultOps = mvarDisableDefaultOps
End Property



Public Function Hook(ByVal msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
    Dim x As Long, a As String, i As Long
    Dim ReadBuffer(1) As Byte
    Dim SendD As String
    Dim newsock As Long
    Dim saddr As sockaddr
    Static CurrentLine As String
    Static was_delim As Boolean
    Select Case msg
        Case 1025
            '#We have connected
            If lp = FD_CONNECT Then
                Debug.Print "Bot Connect"
        
            '#Data recieved yippie
            ElseIf lp = FD_READ Then
                x = recv(wp, ReadBuffer(0), 1, 0)
                If x > 0 Then
                    a = StrConv(ReadBuffer, vbUnicode)
                    a = CStr(Chr$(Asc(a)))
                    If Not ((a = Chr$(10)) Or (a = Chr$(13)) Or (a = (Chr$(10) & Chr$(13)))) Then
                        CurrentLine = CurrentLine & a
                        was_delim = False
                    Else
                        If Not was_delim Then
                            ProcessBotInput wp, CurrentLine
                            CurrentLine = ""
                            was_delim = True
                        End If
                    End If
                End If
            
            ElseIf lp = FD_CLOSE Then
                Debug.Print "Bot Close"
                x = closesocket(wp)
                RemoveConn wp
            
            ElseIf lp = FD_ACCEPT Then
                Debug.Print "Bot Accept"
                newsock = accept(wp, saddr, sockaddr_size)
                Call closesocket(wp)
                Call SendData(newsock, "############################" & vbCrLf)
                Call SendData(newsock, "# BoDeBoT (c) 1998         #" & vbCrLf)
                Call SendData(newsock, "# PoWeReD by VB5           #" & vbCrLf)
                Call SendData(newsock, "############################" & vbCrLf)
                Call SendData(newsock, Now & vbCrLf)
                Call SendData(newsock, "Login:" & vbCrLf)
                AddConn newsock
            End If
            Hook = 0
        Case Else
            Hook = mvarWndProc
    End Select

End Function
Private Sub RemoveConn(ByVal ConnID As Long)
    Dim szKey As String
    szKey = CStr(ConnID)
    'Set BotConns(szKey) = Nothing
    If BotConns.Item(szKey).Status >= 2 Then
        SendToPartyLine "** " & BotConns.Item(szKey).User & " left the party line."
        RaiseEvent onUserPart(BotConns.Item(szKey).User, BotConns.count - 1)
    End If
    BotConns.Remove szKey
End Sub

Private Sub AddConn(ByVal ConnID As Long)
    Dim ucon As CBotConn
    Dim szKey As String
    szKey = CStr(ConnID)
    Set ucon = New CBotConn
    ucon.User = ""
    ucon.Status = 0 'zero means waiting for user
    ucon.Level = 0 'zero until we get a login
    ucon.LastCommand = "Login: Waiting for Username"
    ucon.ConnID = ConnID
    BotConns.Add ucon, szKey
    'We won't fire event until we get an official login from Authenticate
    'MDI.StatusBar1.Panels(2).Text = BotConns.count & " users logged into bot."
End Sub

Private Sub ProcessBotInput(ByVal ConnID As Long, ByVal szLine As String)
    Dim baccess As Integer
    Dim sw As Integer
    Dim szKey As String
    szKey = CStr(ConnID)
    sw = BotConns.Item(szKey).Status
    Debug.Print sw
    Select Case sw
        Case 0 'was waiting for a username
            BotConns.Item(szKey).User = szLine
            BotConns.Item(szKey).Status = 1
            Call SendData(ConnID, "Pass:" & vbCrLf)
        Case 1 'was waiting for a password
            'check password file
            baccess = Authenticate(BotConns.Item(szKey).User, szLine)
            If baccess > 0 Then
                RaiseEvent onUserJoin(BotConns.Item(szKey).User, "", BotConns.count)
                BotConns.Item(szKey).Status = 2