circfactory.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CIRCFactory"
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 Object Component
'       Author: Nicholas J. Felmlee
'       Email: [e-mail]
'       Last Revision: 7/18/98
'
'       Internal Dependencies:
'           WskSock.bas
'           CIRCFactory.cls
'
'       External Dependencies:
'           -none-
'
'**************************************************************

Option Explicit
Public Event onBeginNickList(ByVal szChan As String, ByVal szNicks As String)
Public Event onEndNickList(ByVal szChan As String)
Public Event onError(ByVal lpErrCode As Long, ByVal szDescription As String)
'**Public Event onExitNick(ByVal szNick As String, ByVal szChan As String)
Public Event onServerMessage(ByVal szMessage As String)
Public Event onPrivMsg(ByVal szNick As String, ByVal szMessage As String)
Public Event onCTCP(ByVal szNick As String, ByVal szCommand As String, ByVal szExtras As String)
Public Event onChanMsg(ByVal szSender As String, ByVal szChan As String, ByVal szMessage As String)
Public Event onNotice(ByVal szSender As String, ByVal szMessage As String)
Public Event onNickChanged(ByVal szOriginalNick As String, ByVal szNewNick As String)
Public Event onNickInvite(ByVal szNick As String, ByVal szChan As String)
Public Event onNickKick(ByVal szNick As String, ByVal szChan As String, ByVal szKicker As String, ByVal szComments As String)
'***Public Event onUserMode(ByVal szNick As String, ByVal szMode As String, ByVal szChan As String)
Public Event onChanMode(ByVal szSetter As String, ByVal szChan As String, ByVal szMode As String, ByVal szUsers As String)
Public Event onTopicChanged(ByVal szTopic As String, ByVal szChannel As String, ByVal szNick As String)
Public Event onNickJoin(ByVal szNick As String, ByVal szChan As String)
Public Event onNickPart(ByVal szNick As String, ByVal szChan As String)
Public Event onNickQuit(ByVal szNick As String)
Public Event onNotifyNicks(ByVal szNickList As String)
Public Event onAwayStatus(ByVal szReply As String, ByVal dwCode As Integer)
Public Event onConnect(ByVal szHost As String)
Public Event onDisconnect(ByVal szHost As String)
Public Event onEndMOTD() 'fires on end of MOTD so we know that we are fully connected



'local variable(s) to hold property value(s)
Private mvarServerName As String 'local copy
Private mvarPort As Integer 'local copy
Private mvarNickName As String 'local copy
Private mvarRealName As String 'local copy
Private mvarUsername As String 'local copy
Public Connected As Boolean
Public lpIRC_SOCKET As Long
Public LocalHost As String
Private mvarRetries As Integer 'local copy
Private mvarhWnd As Long 'Required by MsgHook.dll. Who we attach our hook to
Private mvarWndProc As Long 'Required by MsgHook.dll.
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 Property Let Retries(ByVal vData As Integer)
    mvarRetries = vData
End Property

Public Property Get Retries() As Integer
    Retries = mvarRetries
End Property
Public Sub Send(ByVal szline As String)
    If SendData(lpIRC_SOCKET, szline) < 0 Then
        RaiseEvent onDisconnect(mvarServerName)
    End If
End Sub

Public Sub Disconnect()
    Call closesocket(lpIRC_SOCKET)
    Connected = False
End Sub

Public Sub Connect()
    ConnectSock mvarServerName, mvarPort, 0, mvarhWnd, True
End Sub


Public Function Hook(ByVal msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
    Dim SendD As String
    Static m_ReadBuffer As String
    Dim lDummy&, a&, lPos&, AsyncError&
    Dim sTemp$, OutBuffer$, RecvBuffer$
    Dim lTemp&, lTmp&, sHost$, sTmp$, tmphost As HostEnt
Select Case msg
    Case 1025
        '#We have connected
        If lp = FD_CONNECT Then
            lpIRC_SOCKET = wp
            RaiseEvent onConnect(ServerName)
            SendD = "USER " & mvarUsername & " host.com " & AddrToIP(LocalHost) & " :" & mvarRealName & vbCrLf
            Call SendData(lpIRC_SOCKET, SendD)
            SendD = "NICK " & mvarNickName & vbCrLf
            Call SendData(lpIRC_SOCKET, SendD)
            SendD = "MODE " & mvarNickName & " +i" & vbCrLf
            Call SendData(lpIRC_SOCKET, SendD)
    
        '#Data recieved yippie
        ElseIf lp = FD_READ Then
                    lpIRC_SOCKET = wp
                    RecvBuffer = String$(4096, " ")
                    lDummy = recv(lpIRC_SOCKET, ByVal RecvBuffer, Len(RecvBuffer), 0)
                    If lDummy > 0 Then
                        m_ReadBuffer = m_ReadBuffer & Left$(RecvBuffer, lDummy)
                        While InStr(m_ReadBuffer, vbLf)
                            lPos = InStr(m_ReadBuffer, vbLf)
                                If lPos < Len(m_ReadBuffer) Then
                                    OutBuffer = Left$(m_ReadBuffer, lPos - 1)
                                    m_ReadBuffer = Mid$(m_ReadBuffer, lPos + 1)
                                        lPos = InStr(OutBuffer, vbCr)
                                        While lPos > 0
                                            If lPos < Len(OutBuffer) Then
                                                OutBuffer = Left$(OutBuffer, lPos - 1) & Mid$(OutBuffer, lPos + 1)
                                            Else
                                                OutBuffer = Left$(OutBuffer, lPos - 1)
                                            End If
                                            lPos = InStr(OutBuffer, vbCr)
                                        Wend
    '-------------------------------what to do after a linemode read
                                    ParseLine OutBuffer
    '----------------------------------------------------------------
                                Else
                                    OutBuffer = Left$(m_ReadBuffer, Len(m_ReadBuffer) - 1)
                                    m_ReadBuffer = ""
                                        lPos = InStr(OutBuffer, vbCr)
                                        While lPos > 0
                                            If lPos < Len(OutBuffer) Then
                                                OutBuffer = Left$(OutBuffer, lPos - 1) & Mid$(OutBuffer, lPos + 1)
                                            Else
                                                OutBuffer = Left$(OutBuffer, lPos - 1)
                                            End If
                                            lPos = InStr(OutBuffer, vbCr)
                                        Wend
    '-------------------------------what to do after a linemode read (same as above)
                                    ParseLine OutBuffer
    '-------------------------------------------------------------------------------
                                End If
                        Wend
                    End If
            
       '#closed
       Hook = 0
        ElseIf lp = FD_CLOSE Then
            Call closesocket(lpIRC_SOCKET)
            Connected = False
            RaiseEvent onDisconnect(ServerName)
        End If
    Case Else
        Hook = mvarWndProc
    End Select
End Function
Public Property Let Username(ByVal vData As String)
    mvarUsername = vData
End Property


Public Property Get Username() As String
    Username = mvarUsername
End Property



Public Property Let RealName(ByVal vData As String)
    mvarRealName = vData
End Property


Public Property Get RealName() As String
    RealName = mvarRealName
End Property



Public Property Let NickName(ByVal vData As String)
    mvarNickName = vData
End Property


Public Property Get NickName() As String
    NickName = mvarNickName
End Property

Public Property Let Port(ByVal vData As Integer)
    mvarPort = vData
End Property

Public Property Get Port() As Integer
    Port = mvarPort
End Property

Public Property Let ServerName(ByVal vData As String)
    mvarServerName = vData
End Property

Public Property Get ServerName() As String
    ServerName = mvarServerName
End Property

Private Sub processReply(rcode As Integer, ByVal szData$)
    Dim buff As String, temp As String, param1 As String, param2 As String, param3 As String
    '#Reserved numerics.
   'These numerics are not described above since they fall into one of
   'the following categories:
        '1. no longer in use;
        '2. reserved for future planned use;
        '3. in current use but are part of a non-generic 'feature' of the current IRC server.
        '209     RPL_TRACECLASS          217     RPL_STATSQLINE
        '231     RPL_SERVICEINFO         232     RPL_ENDOFSERVICES
        '233     RPL_SERVICE             234     RPL_SERVLIST
        '235     RPL_SERVLISTEND
        '316     RPL_WHOISCHANOP         361     RPL_KILLDONE
        '362     RPL_CLOSING             363     RPL_CLOSEEND
        '373     RPL_INFOSTART           384     RPL_MYPORTIS
        '466     ERR_YOUWILLBEBANNED     476     ERR_BADCHANMASK
        '492     ERR_NOSERVICEHOST
    Debug.Print "RPL " & rcode & vbCrLf
    Debug.Print "DATA= " & szData$
    Select Case rcode
    Case 300 'RPL_NONE
    Case 301 'RPL_AWAY
        Debug.Print "AWAY-> " & szData$
        RaiseEvent onAwayStatus(szData$, 301)
    Case 302 'RPL_USERHOST
        Debug.Print "USERHOST-> " & szData$
    Case 303 'RPL_ISON
        ':irc.vol.com 303 BoDeBoT :BoDePlOt BoDePlOt DrCert
        temp = Mid(szData$, 2)
        param1 = getNextToken(temp, ":")
        RaiseEvent onNotifyNicks(temp)
        'RaiseEvent onServerMessage("IS ON Reply -> " & temp)
    'NO 304
    Case 305 'RPL_UNAWAY
        ':irc.vol.com 305 BoDeBoT :You are no longer marked as being away
        temp = szData$
        Call getNextToken(temp, " ") 'irc.vol.com
        Call getNextToken(temp, " ") '305
        Call getNextToken(temp, " ") 'bodebot
        RaiseEvent onAwayStatus(Mid(temp, 2), 305)
    Case 306 'RPL_NOAWAY
        ':irc.vol.com 306 BoDeBoT :You have been marked as being away
        temp = szData$
        Call getNextToken(temp, " ") 'irc.vol.com
        Call getNextToken(temp, " ") '306
        Call getNextToken(temp, " ") 'bodebot
        RaiseEvent onAwayStatus(Mid(temp, 2), 306)
    'NO 307-310
    Case 311 'RPL_WHOISUSER
        ':irc.vol.com 311 BoDeBoT DrCert ~noone host-209-214-71-188.atl-n.bellsouth.net * :noone
        temp = szData$
        Call getNextToken(temp, " ") 'irc.vol.com
        Call getNextToken(temp, " ") '311
        Call getNextToken(temp, " ") 'bodebot
        param1 = getNextToken(temp, " ")
        RaiseEvent onServerMessage(param1 & " is " & temp)
    Case 312 'RPL_WHOISSERVER
        ':irc.vol.com 312 BoDeBoT DrCert irc.emory.edu :[170.140.4.6] Emory University
        temp = szData$
        Call getNextToken(temp, " ") 'irc.vol.com
        Call getNextToken(temp, " ") '312
        Call getNextToken(temp, " ") 'bodebot
        param1 = getNextToken(temp, " ")
        RaiseEvent onServerMessage(param1 & " using " & temp)
    Case 313 'RPL_WHOISOPERATOR
        Debug.Print "WHOISOPERATOR-> " & szData$
    Case 314 'RPL_WHOWASUSER
        Debug.Print "WHOWASUSER-> " & szData$
    Case 315 'RPL_ENDOFWHO
    'NO 316
    Case 317 'RPL_WHOISIDLE
        Debug.Print "WHOISIDLE-> " & szData$
    Case 318 'RPL_ENDOFWHOIS
        ':irc.vol.com 318 BoDeBoT drcert :End of /WHOIS list.
        temp = szData$
        Call getNextToken(temp, " ") 'irc.vol.com
        Call getNextToken(temp, " ") '311
        Call getNextToken(temp, " ") 'bodebot
        Call getNextToken(temp, " ") 'drcert
        RaiseEvent onServerMessage(Mid(temp, 2))
    Case 319 'RPL_WHOISCHANNELS
        Debug.Print "WHOISCHANNELS-> " & szData$
    'NO 320
    Case 321 'RPL_LISTSTART
    Case 322 'RPL_LIST
    Case 323 'RPLLISTEND
    Case 324 'RPL_CHANNELMODEIS
        Debug.Print "CHANNELMODEIS-> " & szData$
    'NO 325-330
    Case 331 'RPL_NOTOPIC
    Case 332 'RPL_TOPIC
        ':irc.vol.com 332 SMeLLMe #visualbasic :*** Wrexen has quit IRC (Licking some ass)
        buff = szData$
        temp = getNextToken(buff, " ") 'irc.vol.com
        temp = getNextToken(buff, " ") '332
        temp = getNextToken(buff, " ") ' SMeLLMe
        param1 = getNextToken(buff, " ") '#visualbasic
        param2 = Mid(buff, 2)
        RaiseEvent onTopicChanged(param2, param1, param1)
        
    'NO 333-340
    Case 341 'RPL_INVITING
        Debug.Print "INVITING-> " & szData$
    Case 342 'RPL_SUMMONING
    'NO 343-350
    Case 351 'RPL_VERSION
    Case 352 'RPL_WHOREPLY
        ':irc.vol.com 352 BoDeBoT #teenchat duh123 access-isdn1-22.oz.psu.edu irc2.sprynet.com Dingo1 H :5 Da  jEsTeR
        ':irc.vol.com 352 BoDeBoT #luthertech snag2 access-hnts1p9.hn.psu.edu irc.mcs.net Snag H@ :5 snag
        temp = szData$
        Call getNextToken(temp, " ") 'irc.vol.com
        Call getNextToken(temp, " ") '352
        Call getNextToken(temp, " ") 'bodebot
        RaiseEvent onServerMessage(temp)
    Case 353 'RPL_NAMREPLY
        ':irc.vol.com 353 SMeLLMe * #VisualBasic :SMeLLMe +wishdev FezzOr Larson Bver @CaiSSa OakSmoke ThundrBug T-2 Altec^ Victor RasterP Kanati aolsux AcSSDnID JeremyS Donkey Mephiston MaxS Weed7526 @reboot pentium Vv JBlaze Compe screwed @Moosebert MrParata @ShadowRam +Kiliman zipoff @sk8ball +EnEsch @MarC_BV @Shadey XLogility @Leahcim @SuiDo +English +MindRape @BenKo @Rebecca_ @Adriana O-3 @ML_
        buff = szData$
        temp = getNextToken(buff, " ") 'irc.vol.com
        temp = getNextToken(buff, " ") '353
        temp = getNextToken(buff, " ") 'smellme
        temp = getNextToken(buff, " ") ' *