circfactory.cls

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

        param1 = getNextToken(buff, " ") '#visualbasic
        param2 = Mid(buff, 2)
        RaiseEvent onBeginNickList(param1, param2)
        
    'NO 354-363
    Case 364 'RPL_LINKS
    Case 365 'RPL_ENDOFLINKS
    Case 366 'RPL_ENDOFNAMES
        ':irc.vol.com 366 SMeLLMe #visualbasic :End of /NAMES list.
        buff = szData$
        temp = getNextToken(buff, " ") 'irc.vol.com
        temp = getNextToken(buff, " ") '353
        temp = getNextToken(buff, " ") 'smellme
        param1 = getNextToken(buff, " ") '#visualbasic
        RaiseEvent onEndNickList(param1)
        
    Case 367 'RPL_BANLIST
        Debug.Print "BANLIST-> " & szData$
    Case 368 'RPL_ENDOFBANLIST
    Case 369 'RPL_ENDOFWHOWAS
    'NO 370
    Case 371 'RPL_INFO
        Debug.Print "INFO-> " & szData$
    Case 372 'RPL_MOTD
        ':irc.vol.com 372 BoDeBoT :-
        buff = szData$
        temp = getNextToken(buff, " ") 'irc
        temp = getNextToken(buff, " ") '372
        temp = getNextToken(buff, " ") 'bodebot
        RaiseEvent onServerMessage(Mid(buff, 2))
    'NO 373
    Case 374 'RPL_ENDOFINFO
    Case 375 'RPL_MOTDSTART
    Case 376 'RPL_ENDOFMOTD
        ':irc.vol.com 376 BoDeBoT :End of /MOTD command.
        buff = szData$
        temp = getNextToken(buff, " ") 'irc
        temp = getNextToken(buff, " ") '376
        temp = getNextToken(buff, " ") 'bodebot
        RaiseEvent onServerMessage(Mid(buff, 2))
        RaiseEvent onEndMOTD
    'NO 377-380
    Case 381 'RPL_YOUREOPER
        Debug.Print "YOUREOPER-> " & szData$
    Case 382 'RPL_REHASHING
    'NO 383-390
    Case 391 'RPL_TIME
    Case 392 'RPL_USERSSTART
    Case 393 'RPL_USERS
    Case 394 'RPL_ENDOFUSERS
    Case 395 'RPL_NOUSERS
    
    '200's start here
    Case 200 'RPL_TRACELINK
    Case 201 'RPL_TRACECONNECTING
    Case 202 'RPL_TRACEHANDSHAKE
    Case 203 'RPL_TRACEUNKNOWN
    Case 204 'RPL_TRACEOPERATOR
    Case 205 'RPL_TRACEUSER
    Case 206 'RPL_TRACESERVER
    'NO 207
    Case 208 'RPL_TRACENEWTYPE
    'NO 209-210
    Case 211 'RPL_STATSLINKINFO
    Case 212 'RPL_STATSCOMMANDS
    Case 213 'STATSCLINE
    Case 214 'STATSNLINE
    Case 215 'STATSILINE
    Case 216 'STATSKLINE
    'NO 217
    Case 218 'STATSYLINE
    Case 219 'ENDOFSTATS
    'NO 220
    Case 221 'RPL_UMODEIS
    'NO 222-240
    Case 241 'RPL_STATSLLINE
    Case 242 'RPL_STATSUPTIME
    Case 243 'RPL_STATSOLINE
    Case 244 'RPL_STATSHLINE
    'NO 245-250
    Case 251 'RPL_LUSERCLIENT
    Case 252 'RPL_LUSEROP
    Case 253 'RPL_LUSERUNKNOWN
    Case 254 'RPL_LUSERCHANNELS
    Case 255 'RPL_LUSERME
    Case 256 'RPL_ADMINME
    Case 257 'RPL_ADMINLOC1
    Case 258 'RPL_ADMINLOC2
    Case 259 'RPL_ADMINEMAIL
    Case 261 'RPL_TRACELOG
    
    End Select
End Sub
Private Sub processError(ecode As Integer)
    Debug.Print "ERR " & ecode & vbCrLf
    Dim szDesc As String
    Select Case ecode
        Case 401 'ERR_NOSUCHNICK
            szDesc = "No Such Nick"
        Case 402 'ERR_NOSUCHSERVER
            szDesc = "No Such Server"
        Case 403 'ERR_NOSUCHCHANNEL
            szDesc = "No Such Channel"
        Case 404 'ERR_CANNOTSENDTOCHANNEL
            szDesc = "Cannot Send To Channel"
        Case 405 'ERR_TOOMANYCHANNELS
            szDesc = "Too Many Channels"
        Case 406 'ERR_WASNOSUCHNICK
            szDesc = "Was No Such Nick"
        Case 407 'ERR_TOOMANYTARGETS
            szDesc = "Too Many Targets"
        'NO 408
        Case 409 'ERR_NOORIGN
            szDesc = "No Origin"
        'NO 410
        Case 411 'ERR_NORECIPIENT
            szDesc = "No Recipient"
        Case 412 'ERR_NOTEXTTOSEND
            szDesc = "No Text To Send"
        Case 413 'ERR_NOTOPLEVEL
            szDesc = "No Top Level"
        Case 414 'ERR_WILDTOPLEVEL
            szDesc = "Wild Top Level"
        'NO 415-420
        Case 421 'ERR_UNKNOWNCOMMAND
            szDesc = "Unknown Command"
        Case 422 'ERR_NOMOTD
            szDesc = "No MOTD"
        Case 423 'ERR_NOADMININFO
            szDesc = "No Admin Info"
        Case 424 'ERR_FILEERROR
            szDesc = "File Error"
        'NO 425-430
        Case 431 'ERR_NONICKNAMEGIVEN
            szDesc = "No Nickname Given"
        Case 432 'ERR_ERRONEUSNICKNAME
            szDesc = "Erronous Nickname"
        Case 433 'ERR_NICKNAMEINUSE
            szDesc = "Nickname In Use"
        'NO 434-435
        Case 436 'ERR_NICKCOLLISION
            szDesc = "Nick Collision"
        'NO 437-440
        Case 441 'ERR_USERNOTINCHANNEL
            szDesc = "User Not In Channel"
        Case 442 'ERR_NOTONCHANNEL
            szDesc = "Not On Channel"
        Case 443 'ERR_USERONCHANNEL
            szDesc = "User On Channel"
        Case 444 'ERR_NOLOGIN
            szDesc = "No Login"
        Case 445 'ERR_SUMMONDISABLED
            szDesc = "Summond Disabled"
        Case 446 'ERR_USERDISABLED
            szDesc = "User Disabled"
        'NO 447-450
        Case 451 'ERR_NOTREGISTERED
            szDesc = "Not Registered"
        'NO 452-460
        Case 461 'ERR_NEEDMOREPARAMS
            szDesc = "Need More Params"
        Case 462 'ERR_ALREADYREGISTERED
            szDesc = "Already Registered"
        Case 463 'ERR_NOPERMFORHOST
            szDesc = "No Permission For Your Host"
        Case 464 'ERR_PASSWDMISMATCH
            szDesc = "Password Mismatch"
        Case 465 'ERR_YOUREBANNEDCREEP
            szDesc = "You Are Banned Creep"
        'NO 466
        Case 467 'ERR_KEYSET
            szDesc = "Key Set"
        'NO 468-470
        Case 471 'ERR_CHANNELISFULL
            szDesc = "Channel Is Full"
        Case 472 'ERR_UNKNOWNMODE
            szDesc = "Unknown Mode"
        Case 473 'ERR_INVITEONLYCHAN
            szDesc = "Invite-Only Channel"
        Case 474 'ERR_BANNEDFROMCHAN
            szDesc = "You Are Banned From The Channel"
        Case 475 'ERR_BADCHANNELKEY
            szDesc = "Bad Channel Key"
        'NO 476-480
        Case 481 'ERR_NOPRIVILEGES
            szDesc = "No Privileges"
        Case 482 'ERR_CHANOPRIVSNEEDED
            szDesc = "Channel Op Privileges Needed"
        Case 483 'ERR_CANTKILLSERVER
            szDesc = "You Can't Kill the Server"
        'NO 484-490
        Case 491 'ERR_NOOPERHOST
            szDesc = "NOOPERHOST"
        'NO 492-500
        Case 501 'ERR_UMODEUNKNOWNFLAG
            szDesc = "User Mode Unknown Flag"
        Case 502 'ERR_USERSDONTMATCH
            szDesc = "Users Don't Match"
    End Select
    RaiseEvent onError(CLng(ecode), szDesc)
End Sub

Private Sub Class_Initialize()
    Dim retb As Boolean
    'StartWinsock ("")
    LocalHost = GetLocalHostName
End Sub

Private Function getNextToken(ByRef szTemp$, ByVal szTok$)
    Dim Y As Integer
    Y = InStr(szTemp$, szTok$)
    If Y <> 0 Then
        getNextToken = Left(szTemp$, Y - 1)
        szTemp$ = Mid(szTemp$, Y + 1)
    Else
        getNextToken = szTemp$
    End If
End Function

Private Function CountTokens(ByVal val As String) As Integer
    Dim count As Integer
    Dim x As Integer
    count = 0
    x = InStr(val, ",")
    Do Until x = 0
        val = Mid(val, x + 1)
        count = count + 1
        x = InStr(val, ",")
    Loop
    CountTokens = count + 1
End Function

Private Sub Class_Terminate()
    'EndWinsock
End Sub



Private Sub ParseLine(ByVal data As String)
    '************************************************
    ' Parses a line of input from the server
    '
    '************************************************
    Dim temp As String, buff As String, param1 As String, param2 As String
    data = Trim(data)
    Debug.Print data & vbCrLf
    '#Coded Response
    If (InStr(1, data, ":" & mvarServerName) = 1 Or InStr(1, Mid(data, 1, InStr(1, data, " ") - 1), "!") = 0) And (InStr(1, data, "PING") = 0) Then
        Dim szcode As Integer
        temp = Mid(data, InStr(1, data, " ") + 1)
        szcode = val(Mid(temp, 1, InStr(1, temp, " ") - 1))
        If szcode < 400 Then
            processReply szcode, data
        Else
            processError szcode
        End If
    '#server set our mode
    ElseIf (InStr(1, data, ":" & mvarNickName & " MODE")) = 1 Then
    
    '#Normal Messages
    ElseIf Mid(data, 1, 1) = ":" Then
        parseNormalMessages data
    
    '#NOTICE from server
    ElseIf InStr(1, data, "NOTICE") = 1 Then
        buff = data
        temp = getNextToken(buff, ":")
        RaiseEvent onNotice("Auth:", buff)
    '#PING from server
    ElseIf InStr(1, data, "PING") = 1 Then
        Call SendData(lpIRC_SOCKET, "PONG :" & mvarServerName & vbCrLf)
        'UpdateRTB WConsole.RTB, "***PONG PONG PONG", 1
    
    '#ERROR from server
    ElseIf InStr(1, data, "ERROR") = 1 Then
        MsgBox data, vbOKOnly, "BoDeBoT"
    '#something else we don't know about
    Else
        Debug.Print vbCrLf & "Unknown Line"
        'parseNormalMessages data
    End If
End Sub

Private Sub parseNormalMessages(ByVal szData As String)
    Dim data As String
    Dim buff As String
    data = szData
    Dim szNick As String
    Dim szCommand As String
    Dim szTarget As String
    Dim szParams As String
    Dim szcode As String
    Dim pos As Integer
    Dim temp As String
        'get sender
        szNick = Mid(getNextToken(data, "!"), 2)
        Debug.Print "Sender was: " & szNick & vbCrLf
        'get command
        temp = getNextToken(data, " ")
        szCommand = getNextToken(data, " ")
        Debug.Print "Command was: " & szCommand & vbCrLf
        'get object of command
        szTarget = getNextToken(data, " ")
        Debug.Print "Target was: " & szTarget & vbCrLf
        
        Select Case UCase$(szCommand)
            Case "PRIVMSG"
                szParams = Mid(data, 2)
                If InStr(1, szTarget, "#") <> 0 Then
                    RaiseEvent onChanMsg(szNick, LCase$(szTarget), szParams)
                Else
                    If Not Mid(szParams, 1, 1) = Chr(1) Then
                        RaiseEvent onPrivMsg(szNick, szParams)
                    Else
                        szParams = Mid(szParams, 2)
                        RaiseEvent onCTCP(szNick, getNextToken(szParams, " "), szParams)
                    End If
                End If
            Case "JOIN"
                RaiseEvent onNickJoin(szNick, LCase$(Mid(szTarget, 2)))
            Case "PART"
                RaiseEvent onNickPart(szNick, LCase$(szTarget))
            Case "QUIT"
                RaiseEvent onNickQuit(szNick)
            Case "KICK"
                RaiseEvent onNickKick(getNextToken(data, " "), LCase$(szTarget), szNick, Mid(data, 2))
            Case "TOPIC"
                RaiseEvent onTopicChanged(Mid(data, 2), LCase$(szTarget), szNick)
            Case "NOTICE"
                RaiseEvent onNotice(szNick, "[" & szTarget & "] " & Mid(data, 2))
            Case "MODE"
                RaiseEvent onChanMode(szNick, szTarget, getNextToken(data, " "), data)
            Case "NICK"
                RaiseEvent onNickChanged(szNick, Mid(szTarget, 2))
            Case "INVITE"
                RaiseEvent onNickInvite(szNick, Mid(data, 2))
        End Select
End Sub

Public Function GetVersion() As String
    GetVersion = "[" & App.Title & "] " & App.Major & "." & App.Minor & "." & App.Revision
End Function