home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / A_Complete2049172212007.psc / cIRCParser.cls < prev    next >
Text File  |  2007-02-21  |  30KB  |  755 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cIRCParser"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14.  
  15. Option Explicit
  16.  
  17. 'IRC Parsing Engine Class
  18. '⌐2007 - Jason James Newland
  19. '
  20. 'Purpose:
  21. '       The purpose of this class is to parse the individual
  22. '       events coming from an IRC session and splitting them
  23. '       up so it just raises the relevant events.
  24. '       Saves large parsing subs, especially when it comes to
  25. '       PRIVMSG, as you have to parse private/channel action/text,
  26. '       CTCP's and DCC's.
  27. '
  28. 'Usage: (Declarations)
  29. '       Private WithEvents cParser As cIRCParser
  30. 'Form/Class load:
  31. '       Set cParser = New cIRCParser
  32. 'For/Class unload:
  33. '       Set cParser = Nothing
  34. '
  35. 'Method:
  36. '       To parse socket data, get the data into a string, pass that
  37. '       directly to ParseRAWSocketData sVariableName.
  38. '       When parsed, it will raise SocketDataOutput sFirst, sSecond, sThird, sFourth.
  39. '       The reason for this is so an IRC client can override any
  40. '       further parsing for various reasons.
  41. '
  42. '       Just simply pass the output of this event back to the Parse
  43. '       routine of this class.
  44. '
  45. 'NOTE:
  46. '       strMe is a string that is set to your current IRC
  47. '       nick name.
  48. Public strMe As String
  49.  
  50. Private WithEvents IRCSocket As CSocket
  51. Attribute IRCSocket.VB_VarHelpID = -1
  52. Private WithEvents tmrParse As CLiteTimer
  53. Attribute tmrParse.VB_VarHelpID = -1
  54. Private WithEvents tmrRaiseDiscon As CLiteTimer
  55. Attribute tmrRaiseDiscon.VB_VarHelpID = -1
  56. Private WithEvents tmrCloseSock As CLiteTimer
  57. Attribute tmrCloseSock.VB_VarHelpID = -1
  58. Private cQueueMSG As New Collection
  59. Private blClose As Boolean
  60. '
  61. 'events that will be raised
  62. Public Event SocketDataOutput(ByVal sFirst As String, sSecond As String, sThird As String, sFourth As String)
  63.  
  64. Public Event IRCSocketConnect()
  65. Public Event IRCSocketDisconnect()
  66. Public Event IRCSocketCancel()
  67. Public Event IRCSocketServerDisconnect(ByVal sNumber As Integer, sErrorMSG As String)
  68.  
  69. 'Main IRC events
  70. Public Event IRCCloseLink(ByVal sLink As String, sErrorMSG As String)
  71. Public Event IRCPing(ByVal sText As String)
  72. Public Event IRCJoin(ByVal ssServer As String, sNick As String, sAddress As String, sChannel As String)
  73. Public Event IRCPart(ByVal sNick As String, sAddress As String, sChannel As String, sText As String)
  74. Public Event IRCKick(ByVal sNick As String, sKnick As String, sChannel As String, sText As String)
  75. Public Event IRCNick(ByVal sNick As String, sNewNick As String)
  76. Public Event IRCQuit(ByVal sNick As String, sAddress As String, sText As String)
  77. Public Event IRCMode(ByVal sNick As String, sChannel As String, sModeString As String, sData As String)
  78. Public Event IRCSelfMode(ByVal sNick As String, sModeString As String)
  79. Public Event IRCNotice(ByVal sNick As String, sAddress As String, sText As String)
  80. Public Event IRCSNotice(ByVal ssServer As String, sText As String)
  81. Public Event IRCTopic(ByVal sNick As String, sChannel As String, sText As String)
  82. Public Event IRCInvite(ByVal sNick As String, sAddress As String, sChannel As String)
  83.  
  84. 'private message events
  85. Public Event IRCTextChan(ByVal sNick As String, sAddress As String, sChannel As String, sText As String)
  86. Public Event IRCActionChan(ByVal sNick As String, sAddress As String, sChannel As String, sText As String)
  87. Public Event IRCTextQuery(ByVal sNick As String, sAddress As String, sText As String)
  88. Public Event IRCActionQuery(ByVal sNick As String, sAddress As String, sText As String)
  89.  
  90. 'ctcps
  91. Public Event IRCCTCPPing(ByVal sNick As String, sAddress As String, sText As String)
  92. Public Event IRCCTCPTime(ByVal sNick As String, sAddress As String)
  93. Public Event IRCCTCPVersion(ByVal sNick As String, sAddress As String)
  94. Public Event IRCCTCPFinger(ByVal sNick As String, sAddress As String)
  95. Public Event IRCCTCPAway(ByVal sNick As String, sAddress As String, sText As String)
  96. Public Event IRCCTCPOther(ByVal sNick As String, sAddress As String, sText As String)
  97.  
  98. Public Event IRCCTCPReply(ByVal sNick As String, sCTCP As String, sText As String)
  99.  
  100. 'DCC
  101. Public Event IRCDCCSend(ByVal sNick As String, sAddress As String, sFile As String, sNickIP As String, sPort As String, sFSize As String)
  102. Public Event IRCDCCChat(ByVal sNick As String, sAddress As String, sNickIP As String, sPort As String)
  103. Public Event IRCDCCResume(ByVal sNick As String, sAddress As String, sFile As String, sPort As String, sPos As String)
  104. Public Event IRCDCCAccept(ByVal sNick As String, sAddress As String, sFile As String, sPort As String, sPos As String)
  105.  
  106. 'RAW events
  107. Public Event IRCUnknown(ByVal ssServer As String, sText As String)
  108.  
  109. Public Event IRCNotifyUpdate(ByVal ssServer As String, sNick As String, sAddress As String)
  110. Public Event IRCNotify(ByVal ssServer As String, sNick As String, sAddress As String)
  111. Public Event IRCUNotify(ByVal ssServer As String, sNick As String, sAddress As String)
  112.  
  113. Public Event IRCWelcome1(ByVal ssServer As String, sText As String)
  114. Public Event IRCWelcome2(ByVal ssServer As String, sText As String)
  115.  
  116. Public Event IRCProtocols(ByVal ssServer As String, sText As String)
  117.  
  118. Public Event IRCMOTDStart(ByVal ssServer As String, sText As String)
  119. Public Event IRCMOTDText(ByVal ssServer As String, sText As String)
  120. Public Event IRCMOTDEnd(ByVal ssServer As String, sText As String)
  121. Public Event IRCMOTDError(ByVal ssServer As String, sText As String)
  122.  
  123. Public Event IRCLusers(ByVal ssServer As String, sText As String)
  124.  
  125. Public Event IRCWho(ByVal sNick As String, sChannel As String, sAddress As String)
  126. Public Event IRCWhoEnd(ByVal sNick As String, sChannel As String)
  127.  
  128. Public Event IRCNames(ByVal sChannel As String, sNames As String)
  129. Public Event IRCNamesEnd(ByVal sChannel As String)
  130.  
  131. Public Event IRCChannelList(ByVal ssServer As String, sChannel As String, sUsers As String, sTopic As String)
  132. Public Event IRCChannelListEnd(ByVal ssServer As String, sText As String)
  133.  
  134. Public Event IRCBanList(ByVal sChannel As String, sBanMask As String, sNick As String, sTime As String)
  135. Public Event IRCBanListEnd(ByVal sChannel As String, sText As String)
  136.  
  137. Public Event IRCChannelModes(ByVal sChannel As String, sModeString As String)
  138. Public Event IRCCannotJoin(ByVal sChannel As String, sReason)
  139. Public Event IRCTopicIs(ByVal sChannel As String, sText As String)
  140. Public Event IRCTopicSet(ByVal sChannel As String, sNick As String, sTime As String)
  141.  
  142. Public Event IRCRawOther(ByVal ssServer As String, sNumeric As String, sText As String)
  143.  
  144. 'socket control
  145. Public Sub IRCSocketConnect(ByVal ssServer As String, Optional sPort As String)
  146.     On Error Resume Next
  147.     '
  148.     blClose = False
  149.     '
  150.     IRCSocket.Connect ssServer, IIf(LenB(sPort) <> 0, sPort, vbNullString)
  151. End Sub
  152.  
  153. Public Sub IRCSocketDisconnect(ByVal sQuit As String)
  154.     On Error Resume Next
  155.     '
  156.     If IRCSocket.State = sckConnected Then
  157.         IRCSocket.SendData "QUIT :" & sQuit & vbCrLf
  158.         '
  159.         Set tmrCloseSock = New CLiteTimer
  160.         tmrCloseSock.Interval = 20
  161.         tmrCloseSock.Enabled = True
  162.     ElseIf IRCSocket.State = sckConnecting Or IRCSocket.State = sckResolvingHost Then
  163.         blClose = True
  164.         RaiseEvent IRCSocketCancel
  165.         IRCSocket.CloseSocket
  166.     End If
  167. End Sub
  168.  
  169. 'socket senddata routine
  170. Public Sub IRCSocketSendData(ByVal sData As String)
  171.     On Error Resume Next
  172.     '
  173.     If IRCSocket.State = sckConnected Then IRCSocket.SendData sData
  174.     '
  175. End Sub
  176.  
  177. 'local socket properties
  178. Public Property Get IRCSocketState() As StateConstants
  179.     On Error Resume Next
  180.     '
  181.     IRCSocketState = IRCSocket.State
  182.     '
  183. End Property
  184.  
  185. Public Property Get IRCSocketLocalHostName() As String
  186.     On Error Resume Next
  187.     '
  188.     IRCSocketLocalHostName = IRCSocket.LocalHostName
  189.     '
  190. End Property
  191.  
  192. Public Property Get IRCSocketRemoteHost() As String
  193.     On Error Resume Next
  194.     '
  195.     IRCSocketRemoteHost = IRCSocket.RemoteHost
  196.     '
  197. End Property
  198.  
  199. Public Property Get IRCSocketRemoteHostIP() As String
  200.     On Error Resume Next
  201.     '
  202.     IRCSocketRemoteHostIP = IRCSocket.RemoteHostIP
  203.     '
  204. End Property
  205.  
  206. Public Property Get IRCSocketLocalIP() As String
  207.     On Error Resume Next
  208.     '
  209.     IRCSocketLocalIP = IRCSocket.LocalIP
  210.     '
  211. End Property
  212.  
  213. Public Property Get IRCSocketRemotePort() As Long
  214.     On Error Resume Next
  215.     '
  216.     IRCSocketRemotePort = IRCSocket.RemotePort
  217.     '
  218. End Property
  219.  
  220. Public Property Let IRCSocketRemotePort(sNewValue As Long)
  221.     On Error Resume Next
  222.     '
  223.     IRCSocket.RemotePort = sNewValue
  224.     '
  225. End Property
  226.  
  227. Public Property Let IRCSocketRemoteHost(sNewValue As String)
  228.     On Error Resume Next
  229.     '
  230.     IRCSocket.RemoteHost = sNewValue
  231.     '
  232. End Property
  233.  
  234. Public Property Get IRCSocketProtocol() As ProtocolConstants
  235.     On Error Resume Next
  236.     '
  237.     IRCSocketProtocol = IRCSocket.Protocol
  238.     '
  239. End Property
  240.  
  241. Public Property Let IRCSocketProtocol(sNewValue As ProtocolConstants)
  242.     On Error Resume Next
  243.     '
  244.     IRCSocket.Protocol = sNewValue
  245.     '
  246. End Property
  247.  
  248. Public Property Get IRCSocketLocalPort() As Long
  249.     On Error Resume Next
  250.     '
  251.     IRCSocketLocalPort = IRCSocket.LocalPort
  252.     '
  253. End Property
  254.  
  255. Public Property Let IRCSocketLocalPort(sNewValue As Long)
  256.     On Error Resume Next
  257.     '
  258.     IRCSocket.LocalPort = sNewValue
  259.     '
  260. End Property
  261.  
  262. 'socket events
  263. Private Sub IRCSocket_OnClose()
  264.     On Error Resume Next
  265.     '
  266.     If blClose = True Then Exit Sub
  267.     '
  268.     Set tmrRaiseDiscon = New CLiteTimer
  269.     tmrRaiseDiscon.Interval = 100
  270.     tmrRaiseDiscon.Enabled = True
  271. End Sub
  272.  
  273. Private Sub IRCSocket_OnConnect()
  274.     On Error Resume Next
  275.     '
  276.     RaiseEvent IRCSocketConnect
  277. End Sub
  278.  
  279. Private Sub IRCSocket_OnDataArrival(ByVal bytesTotal As Long)
  280.     On Error Resume Next
  281.     Dim sData As String
  282.     '
  283.     IRCSocket.GetData sData
  284.     '
  285.     ParseRAWSocketData sData
  286. End Sub
  287.  
  288. Private Sub IRCSocket_OnError(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
  289.     On Error Resume Next
  290.     '
  291.     RaiseEvent IRCSocketServerDisconnect(Number, Description)
  292. End Sub
  293.  
  294. 'parsing routines
  295. Public Sub ParseRAWSocketData(ByVal sData As String)
  296.     On Error Resume Next
  297.     '
  298.     Dim M As String * 1
  299.     Dim i As Long
  300.     Dim recvBuf As String
  301.     '
  302.     Do While Len(sData) > 0
  303.         i = InStr(1, sData, vbCrLf)
  304.         '
  305.         If i = 0 Then
  306.             recvBuf = recvBuf & sData
  307.             Exit Sub
  308.         Else
  309.             recvBuf = recvBuf & Left$(sData, i - 1)
  310.             '
  311.             cQueueMSG.Add recvBuf
  312.             '
  313.             recvBuf = vbNullString
  314.             If Len(sData) > i + 1 Then
  315.                 sData = Mid$(sData, i + 2)
  316.             Else
  317.                 sData = vbNullString
  318.             End If
  319.         End If
  320.         '
  321.     Loop
  322. End Sub
  323.  
  324. Public Sub Parse(ByVal sFirst As String, sSecond As String, sThird As String, sFourth As String)
  325.     On Error Resume Next
  326.     Dim intTemp As Integer
  327.     Dim intTemp2 As Integer
  328.     Dim strTemp As String
  329.     Dim strTemp2 As String
  330.     Dim strAddress As String
  331.     Dim strCTCP As String
  332.     Dim i As Long
  333.     Select Case UCase(sSecond)
  334.         Case "ERROR"
  335.             intTemp = InStr(sFourth, Chr$(32))
  336.             If intTemp = 0 Then
  337.                 'no space, which is unusal
  338.                 strTemp = Replace(sFourth, ":", vbNullString)
  339.                 strTemp2 = vbNullString
  340.             Else
  341.                 strTemp = Left$(sFourth, intTemp - 1)
  342.                 strTemp2 = Mid$(sFourth, intTemp + 1)
  343.             End If
  344.             '
  345.             RaiseEvent IRCCloseLink(strTemp, strTemp2)
  346.             Exit Sub
  347.         Case "AUTH"
  348.             If UCase(sFirst) = "NOTICE" Then RaiseEvent IRCSNotice(Replace(sFirst, ":", vbNullString), Mid$(sThird, 2) & " " & sFourth)
  349.             Exit Sub
  350.         Case "PING"
  351.             RaiseEvent IRCPing(sFirst)
  352.             Exit Sub
  353.         Case "PRIVMSG"
  354.             intTemp = InStr(sFirst, "!")
  355.             If intTemp = 0 Then
  356.                 'must be a server
  357.                 strTemp = Mid$(sFirst, 2)
  358.             Else
  359.                 strTemp = Replace(Left$(sFirst, intTemp - 1), ":", vbNullString)
  360.                 strAddress = Mid$(sFirst, intTemp + 1)
  361.             End If
  362.             '
  363.             'check for CTCP's
  364.             If Left$(GetTok(sFourth, "1", 32), 2) = ":" & Chr$(1) And UCase(GetTok(sFourth, "1", 32)) <> ":" & Chr$(1) & "ACTION" Then
  365.                 strCTCP = Replace(GetTok(sFourth, "1", 32), Chr$(1), vbNullString)
  366.                 strCTCP = Replace(strCTCP, ":", vbNullString)
  367.                 Select Case UCase(strCTCP)
  368.                     Case "PING"
  369.                         RaiseEvent IRCCTCPPing(strTemp, strAddress, Replace(GetTok(sFourth, "2-", 32), Chr$(1), vbNullString))
  370.                         Exit Sub
  371.                     Case "VERSION"
  372.                         RaiseEvent IRCCTCPVersion(strTemp, strAddress)
  373.                         Exit Sub
  374.                     Case "TIME"
  375.                         RaiseEvent IRCCTCPTime(strTemp, strAddress)
  376.                         Exit Sub
  377.                     Case "FINGER"
  378.                         RaiseEvent IRCCTCPFinger(strTemp, strAddress)
  379.                         Exit Sub
  380.                     Case "AWAY"
  381.                         RaiseEvent IRCCTCPAway(strTemp, strAddress, Replace(GetTok(sFourth, "2-", 32), Chr$(1), vbNullString))
  382.                         Exit Sub
  383.                     Case "DCC"
  384.                         Select Case UCase(GetTok(sFourth, "2", 32))
  385.                             Case "SEND"
  386.                                 If Val(GetTok(sFourth, "0", 32)) > 6 Then Exit Sub
  387.                                 RaiseEvent IRCDCCSend(strTemp, strAddress, GetTok(sFourth, "3", 32), GetTok(sFourth, "4", 32), GetTok(sFourth, "5", 32), Replace(GetTok(sFourth, "6", 32), Chr$(1), vbNullString))
  388.                                 Exit Sub
  389.                             Case "ACCEPT"
  390.                                 If Val(GetTok(sFourth, "0", 32)) > 6 Then Exit Sub
  391.                                 RaiseEvent IRCDCCAccept(strTemp, strAddress, GetTok(sFourth, "3", 32), GetTok(sFourth, "4", 32), Replace(GetTok(sFourth, "5", 32), Chr$(1), vbNullString))
  392.                                 Exit Sub
  393.                             Case "RESUME"
  394.                                 RaiseEvent IRCDCCResume(strTemp, strAddress, GetTok(sFourth, "3", 32), GetTok(sFourth, "4", 32), Replace(GetTok(sFourth, "5", 32), Chr$(1), vbNullString))
  395.                                 Exit Sub
  396.                             Case "CHAT"
  397.                                 RaiseEvent IRCDCCChat(strTemp, strAddress, GetTok(sFourth, "4", 32), Replace(GetTok(sFourth, "5", 32), Chr$(1), vbNullString))
  398.                                 Exit Sub
  399.                         End Select
  400.                         Exit Sub
  401.                     Case "OTHER"
  402.                         RaiseEvent IRCCTCPOther(strTemp, strAddress, Replace(GetTok(sFourth, "2-", 32), Chr$(1), vbNullString))
  403.                         Exit Sub
  404.                 End Select
  405.             Else
  406.                 'it isn't a ctcp so its either a private or
  407.                 'a channel message
  408.                 If LCase(sThird) = LCase(strMe) Then
  409.                     'its a private message
  410.                     If GetTok(sFourth, "1", 32) = ":" & Chr$(1) & "ACTION" Then
  411.                         'its an action
  412.                         RaiseEvent IRCActionQuery(strTemp, strAddress, Replace(GetTok(sFourth, "2-", 32), Chr$(1), vbNullString))
  413.                         Exit Sub
  414.                     Else
  415.                         'normal message
  416.                         RaiseEvent IRCTextQuery(strTemp, strAddress, Mid$(sFourth, 2))
  417.                         Exit Sub
  418.                     End If
  419.                 Else
  420.                     'its a channel message
  421.                     If GetTok(sFourth, "1", 32) = ":" & Chr$(1) & "ACTION" Then
  422.                         'its an action
  423.                         RaiseEvent IRCActionChan(strTemp, strAddress, sThird, Replace(GetTok(sFourth, "2-", 32), Chr$(1), vbNullString))
  424.                         Exit Sub
  425.                     Else
  426.                         'normal message
  427.                         RaiseEvent IRCTextChan(strTemp, strAddress, sThird, Mid$(sFourth, 2))
  428.                         Exit Sub
  429.                     End If
  430.                 End If
  431.             End If
  432.             Exit Sub
  433.         Case "NOTICE"
  434.             intTemp = InStr(sFirst, "!")
  435.             If intTemp = 0 Then
  436.                 'must be a server
  437.                 strTemp = Mid$(sFirst, 2)
  438.             Else
  439.                 strTemp = Replace(Left$(sFirst, intTemp - 1), ":", vbNullString)
  440.                 strAddress = Mid$(sFirst, intTemp + 1)
  441.             End If
  442.             'we have to first parse CTCP replies
  443.             If Left$(sFourth, 2) = ":" & Chr$(1) Then
  444.                 strCTCP = UCase(Replace(Mid$(GetTok(sFourth, "1", 32), 2), Chr$(1), vbNullString))
  445.                 Select Case strCTCP
  446.                     Case "VERSION", "TIME", "FINGER"
  447.                         RaiseEvent IRCCTCPReply(strTemp, strCTCP, Replace(GetTok(sFourth, "2-", 32), Chr$(1), vbNullString))
  448.                         Exit Sub
  449.                     Case "PING"
  450.                         i = Val(Replace(GetTok(sFourth, "2-", 32), Chr$(1), vbNullString))
  451.                         If i <> 0 Then
  452.                             RaiseEvent IRCCTCPReply(strTemp, "PING", GetDuration(Round((GetTickCount - i) / 1000)))
  453.                             Exit Sub
  454.                         Else
  455.                             RaiseEvent IRCCTCPReply(strTemp, "PING", Replace(GetTok(sFourth, "2-", 32), Chr$(1), vbNullString))
  456.                             Exit Sub
  457.                         End If
  458.                 End Select
  459.                 Exit Sub
  460.             Else
  461.                 'normal notice
  462.                 If UCase(sThird) <> "AUTH" Then
  463.                     RaiseEvent IRCNotice(strTemp, strAddress, Mid$(sFourth, 2))
  464.                     Exit Sub
  465.                 Else
  466.                     RaiseEvent IRCSNotice(strTemp, Mid$(sFourth, 2))
  467.                     Exit Sub
  468.                 End If
  469.             End If
  470.         Case "JOIN"
  471.             intTemp = InStr(sFirst, "!")
  472.             RaiseEvent IRCJoin(Replace(sFirst, ":", vbNullString), Replace(Left$(sFirst, intTemp - 1), ":", vbNullString), Mid$(sFirst, intTemp + 1), Replace(sThird, ":", vbNullString))
  473.             Exit Sub
  474.         Case "PART"
  475.             intTemp = InStr(sFirst, "!")
  476.             RaiseEvent IRCPart(Replace(Left$(sFirst, intTemp - 1), ":", vbNullString), Mid$(sFirst, intTemp + 1), Replace(sThird, ":", vbNullString), Mid$(sFourth, 2))
  477.             Exit Sub
  478.         Case "KICK"
  479.             intTemp = InStr(sFirst, "!")
  480.             intTemp2 = InStr(sFourth, Chr$(32))
  481.             RaiseEvent IRCKick(Replace(Left$(sFirst, intTemp - 1), ":", vbNullString), Left$(sFourth, intTemp2 - 1), sThird, Mid$(sFourth, intTemp2 + 2))
  482.             Exit Sub
  483.         Case "NICK"
  484.             intTemp = InStr(sFirst, "!")
  485.             RaiseEvent IRCNick(Replace(Left$(sFirst, intTemp - 1), ":", vbNullString), Mid$(sThird, 2))
  486.             Exit Sub
  487.         Case "QUIT"
  488.             intTemp = InStr(sFirst, "!")
  489.             RaiseEvent IRCQuit(Replace(Left$(sFirst, intTemp - 1), ":", vbNullString), Mid$(sFirst, intTemp + 1), sFourth)
  490.             Exit Sub
  491.         Case "INVITE"
  492.             intTemp = InStr(sFirst, "!")
  493.             RaiseEvent IRCInvite(Replace(Left$(sFirst, intTemp - 1), ":", vbNullString), Mid$(sFirst, intTemp + 1), Mid$(sFourth, 2))
  494.             Exit Sub
  495.         Case "TOPIC"
  496.             intTemp = InStr(sFirst, "!")
  497.             RaiseEvent IRCTopic(Replace(Left$(sFirst, intTemp - 1), ":", vbNullString), sThird, Mid$(sFourth, 2))
  498.             Exit Sub
  499.         Case "MODE"
  500.             intTemp = InStr(sFirst, "!")
  501.             If LCase(Mid$(sFirst, 2)) = LCase(sThird) Then
  502.                 'self mode
  503.                 RaiseEvent IRCSelfMode(sThird, Mid$(sFourth, 2))
  504.                 Exit Sub
  505.             Else
  506.                 'channel mode
  507.                 'get the nick
  508.                 intTemp = InStr(sFirst, "!")
  509.                 If intTemp = 0 Then
  510.                     'must be a server, not a nick
  511.                     intTemp2 = InStr(sFourth, Chr$(32))
  512.                     RaiseEvent IRCMode(Mid$(sFirst, 2), sThird, Left$(sFourth, intTemp2 - 1), Mid$(sFourth, intTemp2 + 1))
  513.                     Exit Sub
  514.                 Else
  515.                     'it is a nick
  516.                     intTemp2 = InStr(sFourth, Chr$(32))
  517.                     RaiseEvent IRCMode(Replace(Left$(sFirst, intTemp - 1), ":", vbNullString), sThird, Left$(sFourth, intTemp2 - 1), Mid$(sFourth, intTemp2 + 1))
  518.                     Exit Sub
  519.                 End If
  520.             End If
  521.         'RAWS
  522.         'welcome
  523.         Case "001"
  524.             RaiseEvent IRCWelcome1(Mid$(sFirst, 2), Mid$(sFourth, 2))
  525.             Exit Sub
  526.         Case "002"
  527.             RaiseEvent IRCWelcome2(Mid$(sFirst, 2), Mid$(sFourth, 2))
  528.             Exit Sub
  529.         Case "003"
  530.             RaiseEvent IRCWelcome2(Mid$(sFirst, 2), Mid$(sFourth, 2))
  531.             Exit Sub
  532.         Case "004"
  533.             RaiseEvent IRCWelcome2(Mid$(sFirst, 2), sFourth)
  534.             Exit Sub
  535.         'protocols
  536.         Case "005"
  537.             RaiseEvent IRCProtocols(Mid$(sFirst, 2), Replace(sFourth, " :are available on this server", vbNullString))
  538.             Exit Sub
  539.         'lusers
  540.         Case "251", "252", "253", "254", "255", "265", "266"
  541.             RaiseEvent IRCLusers(Mid$(sFirst, 2), Replace(sFourth, ":", vbNullString))
  542.             Exit Sub
  543.         'topic on join
  544.         Case "332"
  545.             intTemp = InStr(sFourth, Chr$(32))
  546.             RaiseEvent IRCTopicIs(Left$(sFourth, intTemp - 1), Mid$(sFourth, intTemp + 2))
  547.             Exit Sub
  548.         'topic set
  549.         Case "333"
  550.             RaiseEvent IRCTopicSet(GetTok(sFourth, "1", 32), GetTok(sFourth, "2", 32), GetTok(sFourth, "3", 32))
  551.             Exit Sub
  552.         'who
  553.         Case "352"
  554.             RaiseEvent IRCWho(sThird, GetTok(sFourth, "1", 32), GetTok(sFourth, "5", 32) & "!" & GetTok(sFourth, "2", 32) & "@" & GetTok(sFourth, "3", 32))
  555.             Exit Sub
  556.         'who end
  557.         Case "315"
  558.             RaiseEvent IRCWhoEnd(sThird, GetTok(sFourth, "1", 32))
  559.             Exit Sub
  560.         'channel list
  561.         Case "322"
  562.             RaiseEvent IRCChannelList(Replace(sFirst, ":", vbNullString), GetTok(sFourth, "1", 32), GetTok(sFourth, "2", 32), Mid$(GetTok(sFourth, "3-", 32), 2))
  563.             Exit Sub
  564.         'end channel list
  565.         Case "323"
  566.             RaiseEvent IRCChannelListEnd(Replace(sFirst, ":", vbNullString), "End of /LIST command.")
  567.             Exit Sub
  568.         'channel modes
  569.         Case "324"
  570.             intTemp = InStr(sFourth, Chr$(32))
  571.             RaiseEvent IRCChannelModes(Left$(sFourth, intTemp - 1), Mid$(sFourth, intTemp + 1))
  572.             Exit Sub
  573.         'names
  574.         Case "353"
  575.             intTemp = InStr(sFourth, Chr$(32))
  576.             intTemp2 = InStr(intTemp + 1, sFourth, Chr$(32))
  577.             RaiseEvent IRCNames(Trim(Mid$(sFourth, intTemp + 1, intTemp2 - intTemp)), Replace(Trim(Mid$(sFourth, intTemp2 + 1)), ":", vbNullString))
  578.             Exit Sub
  579.         Case "366"
  580.             intTemp = InStr(sFourth, Chr$(32))
  581.             RaiseEvent IRCNamesEnd(Left$(sFourth, intTemp - 1))
  582.             Exit Sub
  583.         'ban list
  584.         Case "367"
  585.             intTemp = InStr(sFourth, Chr$(32))
  586.             RaiseEvent IRCBanList(Left$(sFourth, intTemp - 1), GetTok(sFourth, "2", 32), GetTok(sFourth, "3", 32), GetTok(sFourth, "4", 32))
  587.             Exit Sub
  588.         'end of ban list
  589.         Case "368"
  590.             intTemp = InStr(sFourth, Chr$(32))
  591.             RaiseEvent IRCBanListEnd(Left$(sFourth, intTemp - 1), "End of BAN list.")
  592.             Exit Sub
  593.         'unknown
  594.         Case "421"
  595.             intTemp = InStr(sFourth, Chr$(32))
  596.             Select Case UCase(Left$(sFourth, intTemp - 1))
  597.                 Case "IRCX": Exit Sub
  598.                 Case Else
  599.                     RaiseEvent IRCUnknown(Mid$(sFirst, 2), Mid$(sFourth, intTemp + 2) & ": " & Left$(sFourth, intTemp - 1))
  600.                     Exit Sub
  601.             End Select
  602.         'motd
  603.         Case "372"
  604.             RaiseEvent IRCMOTDText(Mid$(sFirst, 2), Mid$(sFourth, 2))
  605.             Exit Sub
  606.         Case "375"
  607.             RaiseEvent IRCMOTDStart(Mid$(sFirst, 2), Mid$(sFourth, 2))
  608.             Exit Sub
  609.         Case "376"
  610.             RaiseEvent IRCMOTDEnd(Mid$(sFirst, 2), "End of Message Of The Day (MOTD)")
  611.             Exit Sub
  612.         Case "377", "378"
  613.             RaiseEvent IRCMOTDText(Mid$(sFirst, 2), Mid$(sFourth, 2))
  614.             Exit Sub
  615.         'motd error
  616.         Case "422"
  617.             RaiseEvent IRCMOTDError(Mid$(sFirst, 2), Mid$(sFourth, 2))
  618.             Exit Sub
  619.         'cannot join
  620.         Case "471"
  621.             intTemp = InStr(sFourth, Chr$(32))
  622.             RaiseEvent IRCCannotJoin(Left$(sFourth, intTemp - 1), "+l")
  623.             Exit Sub
  624.         Case "473"
  625.             intTemp = InStr(sFourth, Chr$(32))
  626.             RaiseEvent IRCCannotJoin(Left$(sFourth, intTemp - 1), "+i")
  627.             Exit Sub
  628.         Case "474"
  629.             intTemp = InStr(sFourth, Chr$(32))
  630.             RaiseEvent IRCCannotJoin(Left$(sFourth, intTemp - 1), "+b")
  631.             Exit Sub
  632.         Case "475"
  633.             intTemp = InStr(sFourth, Chr$(32))
  634.             RaiseEvent IRCCannotJoin(Left$(sFourth, intTemp - 1), "+k")
  635.             Exit Sub
  636.         Case "477"
  637.             intTemp = InStr(sFourth, Chr$(32))
  638.             RaiseEvent IRCCannotJoin(Left$(sFourth, intTemp - 1), "+r")
  639.             Exit Sub
  640.         'watch
  641.         Case "600"
  642.             RaiseEvent IRCNotify(Mid$(sFirst, 2), GetTok(sFourth, "1", 32), GetTok(sFourth, "2", 32) & "@" & GetTok(sFourth, "3", 32))
  643.             Exit Sub
  644.         Case "601"
  645.             RaiseEvent IRCUNotify(Mid$(sFirst, 2), GetTok(sFourth, "1", 32), GetTok(sFourth, "2", 32) & "@" & GetTok(sFourth, "3", 32))
  646.             Exit Sub
  647.         Case "604"
  648.             RaiseEvent IRCNotifyUpdate(Mid$(sFirst, 2), GetTok(sFourth, "1", 32), GetTok(sFourth, "2", 32) & "@" & GetTok(sFourth, "3", 32))
  649.             Exit Sub
  650.         'ircx
  651.         Case "800"
  652.             RaiseEvent IRCRawOther(Mid$(sFirst, 2), sSecond, sFourth)
  653.             Exit Sub
  654.         Case Else
  655.             RaiseEvent IRCRawOther(Mid$(sFirst, 2), sSecond, IIf(Left$(sFourth, 1) = ":", Mid$(sFourth, 2), sFourth))
  656.             Exit Sub
  657.     End Select
  658. End Sub
  659.  
  660. 'class properties
  661. Private Sub Class_Initialize()
  662.     On Error Resume Next
  663.     Set IRCSocket = New CSocket
  664.     IRCSocketProtocol = sckTCPProtocol
  665.     '
  666.     Set tmrParse = New CLiteTimer
  667.     tmrParse.Interval = 1
  668.     tmrParse.Enabled = True
  669. End Sub
  670.  
  671. Private Sub Class_Terminate()
  672.     On Error Resume Next
  673.     tmrParse.Enabled = False
  674.     Set tmrParse = Nothing
  675.     Set tmrCloseSock = Nothing
  676.     Set tmrRaiseDiscon = Nothing
  677.     '
  678.     Set IRCSocket = Nothing
  679. End Sub
  680.  
  681. 'timer class
  682. Private Sub tmrCloseSock_Timer()
  683.     On Error Resume Next
  684.     tmrCloseSock.Enabled = False
  685.     Set tmrCloseSock = Nothing
  686.     IRCSocket.CloseSocket
  687. End Sub
  688.  
  689. Private Sub tmrRaiseDiscon_Timer()
  690.     On Error Resume Next
  691.     tmrRaiseDiscon.Enabled = False
  692.     Set tmrRaiseDiscon = Nothing
  693.     RaiseEvent IRCSocketDisconnect
  694. End Sub
  695.  
  696. Private Sub tmrParse_Timer()
  697.     On Error Resume Next
  698.     'The timer will check for queue message every 1 millisecond.  This is secondary parse
  699.     Dim intCount As Integer
  700.     Dim blnParsed As Boolean
  701.     Dim strData As String
  702.     '
  703.     Dim strFirst As String
  704.     Dim strSecond As String
  705.     Dim strThird As String
  706.     Dim strFourth As String
  707.     '
  708.     Dim intPos1 As Integer
  709.     Dim intPos2 As Integer
  710.     Dim intPos3 As Integer
  711.     Dim intPos4 As Integer
  712.     '
  713.     intCount = 1
  714.     Do While blnParsed = False And intCount <= cQueueMSG.Count
  715.         strData = cQueueMSG.Item(intCount)
  716.         'remove first line feed if there are any
  717.         If Mid$(strData, 1, 1) = Chr$(13) Or Mid$(strData, 1, 1) = Chr$(10) Then
  718.             strData = Mid$(strData, 2)
  719.         End If
  720.         intPos1 = InStr(1, strData, Chr$(32))
  721.         If intPos1 Then
  722.             strFirst = Trim$(Left$(strData, intPos1))
  723.             intPos2 = InStr(intPos1 + 1, strData, Chr$(32))
  724.             If intPos2 Then
  725.                 strSecond = Trim$(Mid$(strData, intPos1 + 1, (intPos2 - intPos1)))
  726.                 intPos3 = InStr(intPos2 + 1, strData, Chr$(32))
  727.                     If intPos3 Then
  728.                         strThird = Trim$(Mid$(strData, intPos2 + 1, (intPos3 - intPos2)))
  729.                         strFourth = Trim$(Right$(strData, Len(strData) - intPos3))
  730.                     Else
  731.                         'no third space
  732.                         strThird = Trim$(Mid$(strData, intPos2 + 1, Len(strData) - intPos2))
  733.                     End If
  734.             Else
  735.                 'no second space, most likely PING or ERROR
  736.                 strFirst = Trim$(Right$(strData, Len(strData) - InStr(strData, ":")))
  737.                 strSecond = "PING"
  738.                 strThird = vbNullString
  739.                 strFourth = vbNullString
  740.             End If
  741.         End If
  742.         'Error case
  743.         If UCase(strFirst) = "ERROR" Then
  744.             strFirst = vbNullString
  745.             strSecond = "ERROR"
  746.         End If
  747.         blnParsed = True
  748.         cQueueMSG.Remove intCount
  749.         intCount = intCount + 1
  750.         '
  751.         RaiseEvent SocketDataOutput(strFirst, strSecond, strThird, strFourth)
  752.         '
  753.     Loop
  754. End Sub
  755.