API tools faq
paste
Guest User

sean

a guest
Oct 18th, 2010
337
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 34.07 KB | None | 0 0
raw download clone embed print report
  1.  
  2. Option Explicit
  3.  
  4. Dim CMode          As String
  5. Dim sData          As String
  6. Dim sChannel       As String
  7. Dim HostGroup      As String
  8. Dim OwnerGroup     As String
  9. Dim GuideGroup     As String
  10. Dim sRoomList      As String
  11. Dim lFoundPosition As Long
  12. Dim Color          As Boolean
  13. Dim sList          As ListItem
  14. Dim i              As Integer
  15.  
  16. '--------------------------------------------------------
  17. '----------- Control Interface
  18. '--------------------------------------------------------
  19.        
  20. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  21.     txtServer.Text = PropBag.ReadProperty("Server", "irc.xtcomputing.com")
  22.     txtNickName.Text = PropBag.ReadProperty("NickName", "Webchat_" & Format(Now, "mmss"))
  23.     txtRoom.Text = PropBag.ReadProperty("RoomName", "extremeteam")
  24.     UserControl.BackColor = PropBag.ReadProperty("BackColor", &HE8FFFF)
  25.     'UserControl.ScaleHeight = PropBag.ReadProperty("ScaleHeight", 7005)
  26.    'UserControl.ScaleWidth = PropBag.ReadProperty("ScaleWidth", 12555)
  27.    frTopBack.BackColor = PropBag.ReadProperty("TopBackHighlightColor", &HCEB2A5)
  28.     frBack.BackColor = PropBag.ReadProperty("BackHighlightColor", &HF7EFEF)
  29.     lstMe.BackColor = PropBag.ReadProperty("BackHighlightColor", &HF7EFEF)
  30.     lRoomName.ForeColor = PropBag.ReadProperty("BackColor", &HE8FFFF)
  31.     frInputBorder.BackColor = PropBag.ReadProperty("ButtonFrameColor", &HFF9966)
  32.     frButtonFrame.BackColor = PropBag.ReadProperty("InputBordercolor", &H9C654A)
  33.     cmdSend.BackColor = PropBag.ReadProperty("ButtonBackColor", &HFFEACE)
  34.     cmdAction.BackColor = PropBag.ReadProperty("ButtonBackColor", &HFFEACE)
  35.     cmdOptions.BackColor = PropBag.ReadProperty("BackHighlightColor", &HF7EFEF)
  36. End Sub
  37.  
  38. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  39.     Call PropBag.WriteProperty("RoomName", txtRoom.Text, "extremeteam")
  40.     Call PropBag.WriteProperty("NickName", txtNickName.Text, "Webchat_" & Format(Now, "mmss"))
  41.     Call PropBag.WriteProperty("Server", txtServer.Text, "irc.xtcomputing.com")
  42.     Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &HE8FFFF)
  43.     'Call PropBag.WriteProperty("ScaleHeight", UserControl.ScaleHeight, 7005)
  44.    'Call PropBag.WriteProperty("ScaleWidth", UserControl.ScaleWidth, 12555)
  45.    Call PropBag.WriteProperty("TopBackHighlightColor", frTopBack.BackColor, &HCEB2A5)
  46.     Call PropBag.WriteProperty("BackHighlightColor", frBack.BackColor, &HF7EFEF)
  47.     Call PropBag.WriteProperty("ButtonFrameColor", frInputBorder.BackColor, &HFF9966)
  48.     Call PropBag.WriteProperty("InputBordercolor", frButtonFrame.BackColor, &H9C654A)
  49.     Call PropBag.WriteProperty("ButtonBackColor", cmdSend.BackColor, &HFFEACE)
  50. End Sub
  51.  
  52. Private Sub UserControl_InitProperties()
  53.     RoomName = txtRoom.Text
  54.     NickName = txtNickName.Text
  55.     BackColor = UserControl.BackColor
  56.     TopBackHighlightColor = frTopBack.BackColor
  57.     BackHighlightColor = frBack.BackColor
  58.     'ScaleHeight = UserControl.ScaleHeight
  59.    'ScaleWidth = UserControl.ScaleWidth
  60.    ButtonFrameColor = frInputBorder.BackColor
  61. End Sub
  62.  
  63. 'MappingInfo=txtRoom,txtRoom,-1,Text
  64. Public Property Get RoomName() As String
  65.     RoomName = txtRoom.Text
  66. End Property
  67.  
  68. Public Property Let RoomName(ByVal New_RoomName As String)
  69.     txtRoom.Text() = New_RoomName
  70.     PropertyChanged "RoomName"
  71. End Property
  72.  
  73. Public Property Get NickName() As String
  74.     NickName = txtNickName.Text
  75. End Property
  76.  
  77. Public Property Let NickName(ByVal New_NickName As String)
  78.     txtNickName.Text() = New_NickName
  79.     PropertyChanged "NickName"
  80. End Property
  81.  
  82. Public Property Get Server() As String
  83.     Server = txtServer.Text
  84. End Property
  85.  
  86. Public Property Let Server(ByVal New_Server As String)
  87.     txtServer.Text() = New_Server
  88.     PropertyChanged "Server"
  89. End Property
  90.  
  91. 'MappingInfo=UserControl,UserControl,-1,BackColor
  92. Public Property Get BackColor() As OLE_COLOR
  93.     BackColor = UserControl.BackColor
  94. End Property
  95.  
  96. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  97.     UserControl.BackColor() = New_BackColor
  98.     PropertyChanged "BackColor"
  99. End Property
  100.  
  101. 'MappingInfo=UserControl,UserControl,-1,ScaleHeight
  102. 'Public Property Get ScaleHeight() As Single
  103.    'ScaleHeight = UserControl.ScaleHeight
  104. 'End Property
  105.  
  106. 'Public Property Let ScaleHeight(ByVal New_ScaleHeight As Single)
  107.    'UserControl.ScaleHeight() = New_ScaleHeight
  108.    'PropertyChanged "ScaleHeight"
  109. 'End Property
  110.  
  111. 'MappingInfo=UserControl,UserControl,-1,ScaleWidth
  112. 'Public Property Get ScaleWidth() As Single
  113.    'ScaleWidth = UserControl.ScaleWidth
  114. 'End Property
  115.  
  116. 'Public Property Let ScaleWidth(ByVal New_ScaleWidth As Single)
  117.    'UserControl.ScaleWidth() = New_ScaleWidth
  118.    'PropertyChanged "ScaleWidth"
  119. 'End Property
  120.  
  121. Public Property Get TopBackHighlightColor() As OLE_COLOR
  122.     TopBackHighlightColor = frTopBack.BackColor
  123. End Property
  124.  
  125. Public Property Let TopBackHighlightColor(ByVal New_BackColor As OLE_COLOR)
  126.     frTopBack.BackColor() = New_BackColor
  127.     PropertyChanged "TopBackHighlightColor"
  128. End Property
  129.  
  130. Public Property Get BackHighlightColor() As OLE_COLOR
  131.     BackHighlightColor = frBack.BackColor
  132. End Property
  133.  
  134. Public Property Let BackHighlightColor(ByVal New_BackColor As OLE_COLOR)
  135.     frBack.BackColor() = New_BackColor
  136.     PropertyChanged "BackHighlightColor"
  137. End Property
  138.  
  139. Public Property Get ButtonFrameColor() As OLE_COLOR
  140.     ButtonFrameColor = frInputBorder.BackColor
  141. End Property
  142.  
  143. Public Property Let ButtonFrameColor(ByVal New_BackColor As OLE_COLOR)
  144.     frInputBorder.BackColor() = New_BackColor
  145.     PropertyChanged "ButtonFrameColor"
  146. End Property
  147.  
  148. Public Property Get InputBordercolor() As OLE_COLOR
  149.     InputBordercolor = frButtonFrame.BackColor
  150. End Property
  151.  
  152. Public Property Let InputBordercolor(ByVal New_BackColor As OLE_COLOR)
  153.     frButtonFrame.BackColor() = New_BackColor
  154.     PropertyChanged "InputBordercolor"
  155. End Property
  156.  
  157. Public Property Get ButtonBackColor() As OLE_COLOR
  158.     ButtonBackColor = cmdSend.BackColor
  159. End Property
  160.  
  161. Public Property Let ButtonBackColor(ByVal New_BackColor As OLE_COLOR)
  162.     cmdSend.BackColor() = New_BackColor
  163.     PropertyChanged "ButtonBackColor"
  164. End Property
  165.  
  166. Private Sub cmdSend_Click() ' the send button code
  167.    If txtSend = "" Then Exit Sub
  168.     txtmain.SelStart = Len(txtmain.Text)
  169.     If UCase$(Left$(txtSend, 6)) = "/CLEAR" Then
  170.         txtmain.Text = ""
  171.         txtSend.Text = ""
  172.         Exit Sub
  173.     ElseIf UCase$(Left$(txtSend, 1)) = "/" Then
  174.         SendServ Replace$(txtSend, "/", "")
  175.         txtSend.Text = ""
  176.         Exit Sub
  177.     End If
  178.     SendServ "PRIVMSG " & sChannel & " :" & txtSend.Text
  179.     SendMsg txtSend.Text
  180. End Sub
  181.  
  182. Private Sub cmdAction_Click() ' action button code
  183.    SendServ "PRIVMSG " & sChannel & " :" & Chr$(1) & "ACTION " & txtSend.Text & "" & Chr$(1)
  184.     SendAction txtSend.Text
  185. End Sub
  186.  
  187. Public Sub SendMsg(sMsg As String) ' send message routine
  188.    txtmain.SelStart = Len(txtmain.Text)
  189.     txtmain.SelBold = True
  190.     txtmain.SelText = "    " & CheckNick(sMyNick) & " : "
  191.     txtmain.SelBold = False
  192.     txtmain.SelText = sMsg & vbCrLf
  193.     txtSend.Text = ""
  194.     ResetFontFormat
  195. End Sub
  196.  
  197. Public Sub SendAction(sMsg As String) 'send action routine
  198.    txtmain.SelStart = Len(txtmain.Text)
  199.     txtmain.SelColor = &H800080
  200.     txtmain.SelItalic = True
  201.     txtmain.SelText = "    " & CheckNick(sMyNick) & " " & sMsg & "" & vbCrLf
  202.     txtSend.Text = ""
  203.     ResetFontFormat
  204. End Sub
  205.  
  206. Private Sub cmdOptions_Click()
  207.     frmTrace.Show vbModal, Me
  208. End Sub
  209.  
  210. Private Sub lstMe_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'lstMe is your own nick
  211.    Dim sUser As String
  212.     sUser = lstMe.SelectedItem.Text
  213.     If sUser <> "" Then
  214.         If Button = 2 Then
  215.             'UserControl.PopupMenu mnuUsers, vbPopupMenuRightButton
  216.        End If
  217.     End If
  218. End Sub
  219.  
  220. Private Sub lstUsers_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'lstUsers are the users
  221.    Dim sUser As String
  222.     On Error Resume Next
  223.     sUser = lstUsers.SelectedItem.Text
  224.     If sUser <> "" Then
  225.         If Button = 2 Then
  226.             UserControl.PopupMenu mnuUsers, vbPopupMenuRightButton
  227.         End If
  228.     End If
  229. End Sub
  230. Private Sub mnuPart_Click()
  231.     On Error Resume Next
  232.     SendServ "MODE " & sChannel & " -q " & lstUsers.SelectedItem.Key
  233.     SendServ "MODE " & sChannel & " -o " & lstUsers.SelectedItem.Key
  234. End Sub
  235.  
  236. Private Sub mnuHost_Click()
  237.     On Error Resume Next
  238.     SendServ "MODE " & sChannel & " +o " & lstUsers.SelectedItem.Key
  239. End Sub
  240.  
  241. Private Sub mnuOwner_Click()
  242.     On Error Resume Next
  243.     SendServ "MODE " & sChannel & " +q " & lstUsers.SelectedItem.Key
  244. End Sub
  245.  
  246. Private Sub mnuWhisper_Click()
  247. '
  248. End Sub
  249.  
  250. Private Sub mnuSlap_Click()
  251.     On Error Resume Next
  252.     SendServ "PRIVMSG " & sChannel & " :" & Chr$(1) & "ACTION slaps " & lstUsers.SelectedItem.Key & " around a bit with a large trout" & Chr$(1)
  253.     SendAction "slaps " & lstUsers.SelectedItem.Text & " around a bit with a large trout"
  254. End Sub
  255.  
  256. Private Sub txtSend_Change()
  257.     If txtSend.Text <> "" And ds1.State = 7 Then
  258.         cmdSend.Enabled = True
  259.         cmdAction.Enabled = True
  260.     End If
  261.     If txtSend.Text = "" Or ds1.State <> 7 Then
  262.         cmdSend.Enabled = False
  263.         cmdAction.Enabled = False
  264.     End If
  265. End Sub
  266.  
  267. Private Sub txtSend_KeyPress(KeyAscii As Integer)
  268.     If KeyAscii = 13 Then
  269.         Call cmdSend_Click
  270.         KeyAscii = 0
  271.     End If
  272. End Sub
  273.  
  274. Private Sub lstUsers_DblClick()
  275. Dim tempNick As String
  276. tempNick = lstUsers.SelectedItem.Text
  277.  
  278.     If Left$(tempNick, 1) = "@" Or Left$(tempNick, 1) = "+" Or Left$(tempNick, 1) = "." Then
  279.         tempNick = Right$(tempNick, Len(tempNick) - 1)
  280.     End If
  281.     If Not DoesPvtExists(tempNick) Then 'if no curren window exists
  282.        Dim PvtIndex As Integer
  283.         PvtIndex = FreePvtIndex
  284.         Call PvtWindows(PvtIndex).SetEventObject(Me)
  285.         PvtWindows(PvtIndex).Tag = PvtIndex 'the tag will contain the array index of the window
  286.        PvtWindows(PvtIndex).Caption = tempNick 'change the caption to nick
  287.        PvtWindows(PvtIndex).Show vbModal, Me 'display the window
  288.        PvtWindowState(PvtIndex).name = tempNick 'just
  289.    Else
  290.         PvtWindows(GetPvtIndex(tempNick)).WindowState = vbNormal 'yeah need to open!
  291.    End If
  292. End Sub
  293.  
  294. Private Sub UserWhisper(sNick As String)
  295.     Dim sMsg As String
  296.  
  297.     sMsg = Mid(sData, 3)
  298.     sMsg = Mid(sMsg, InStr(1, sMsg, ":", 1) + 1)
  299.     sMsg = Replace(sMsg, vbCrLf, "")
  300.     sMsg = Replace(sMsg, Chr$(1), "")
  301.  
  302.     'txtmain.SelStart = Len(txtmain.Text)
  303.    'txtmain.SelBold = True
  304.    'txtmain.SelText = "    " & CheckNick(sNick)
  305.    'txtmain.SelColor = &H800080
  306.    'txtmain.SelText = " Whispers to "
  307.    'txtmain.SelColor = &H800000
  308.    'txtmain.SelText = CheckNick(sMyNick) & " : "
  309.    'txtmain.SelText = sMsg & vbCrLf
  310.    'ResetFontFormat
  311.    
  312.     'write the msg to pvt window
  313.    Dim PvtIndex As Integer
  314.     If Not DoesPvtExists(sNick) Then 'if no pvt for sender
  315.        PvtIndex = FreePvtIndex
  316.         Call PvtWindows(PvtIndex).SetEventObject(Me)
  317.         PvtWindows(PvtIndex).Tag = PvtIndex 'the tag will contain the array index of the window
  318.        PvtWindows(PvtIndex).Caption = sNick 'change the caption to nick
  319.        PvtWindows(PvtIndex).Show vbModal, Me 'display the window
  320.        PvtWindowState(PvtIndex).name = sNick 'just
  321.    End If
  322.     PvtIndex = GetPvtIndex(sNick)
  323.     PvtWindows(PvtIndex).WindowState = vbNormal
  324.     PvtWindows(PvtIndex).AddText sMsg, sNick
  325.            
  326. End Sub
  327.  
  328. Private Sub ResetFontFormat()
  329.     SetEmo
  330.     lFoundPosition = Len(txtmain.Text) - 1
  331.     txtmain.SelStart = Len(txtmain.Text) ' jump to end
  332.    txtmain.SelBold = False
  333.     txtmain.SelUnderline = False
  334.     txtmain.SelItalic = False
  335.     txtmain.SelFontName = "Tahoma"
  336.     txtmain.SelColor = &H0&
  337. End Sub
  338.  
  339. Private Sub Webding()
  340.     txtmain.SelStart = Len(txtmain.Text) 'jump to end
  341.    txtmain.SelBold = False
  342.     txtmain.SelUnderline = False
  343.     txtmain.SelItalic = False
  344.     txtmain.SelColor = &H808080
  345.     txtmain.SelFontName = "Webdings"
  346.     txtmain.SelText = "    4"
  347. End Sub
  348.  
  349. Function CheckNick(str As String)
  350.     CheckNick = Replace(str, ">", "Guest_")
  351. End Function
  352.  
  353. Private Sub NickChanged(sNick As String) ':[email protected] NICK :hoera
  354. Dim sNewNick As String
  355.     On Error Resume Next
  356.     sNewNick = Split(sData, " ")(2)
  357.     sNewNick = Replace$(sNewNick, ":", "")
  358.     Webding
  359.     txtmain.SelFontName = "Tahoma"
  360.     txtmain.SelText = Replace$(CheckNick(sNick), "'", "") & " is now known as " & sNewNick & vbCrLf
  361.     ResetFontFormat
  362.    
  363.     GuideGroup = Replace$(GuideGroup, " " & sNick & " ", " " & sNewNick & " ")
  364.     HostGroup = Replace$(HostGroup, " " & sNick & " ", " " & sNewNick & " ")
  365.     OwnerGroup = Replace$(OwnerGroup, " " & sNick & " ", " " & sNewNick & " ")
  366.    
  367.     If sNick = lstMe.ListItems(1).Text Then
  368.         sMyNick = sNewNick
  369.         lstMe.ListItems.Remove 1
  370.         lstMe.ListItems.Add , sNewNick, sNewNick
  371.         Exit Sub
  372.     End If
  373.    
  374.     For i = 1 To lstUsers.ListItems.Count
  375.         If lstUsers.ListItems(i).Key = sNick Then
  376.             lstUsers.ListItems.Remove i
  377.             Exit For
  378.         End If
  379.     Next i
  380.  
  381.     If InStr(1, OwnerGroup, " " & sNewNick & " ") <> 0 Then
  382.         Set sList = lstUsers.ListItems.Add(, sNewNick, "." & sNewNick, , "gold")
  383.         sList.ListSubItems.Add , , sNewNick & " (Host)", "gold"
  384.     ElseIf InStr(1, HostGroup, " " & sNewNick & " ") <> 0 Then
  385.         Set sList = lstUsers.ListItems.Add(, sNewNick, "@" & sNewNick, , "brown")
  386.         sList.ListSubItems.Add , , sNewNick & " (Host)", "brown"
  387.     ElseIf InStr(1, GuideGroup, " " & sNewNick & " ") <> 0 Then
  388.         Set sList = lstUsers.ListItems.Add(, sNewNick, "&" & sNewNick, , "guide")
  389.         sList.ListSubItems.Add , , sNewNick & " (Host)", "guide"
  390.     Else
  391.        Set sList = lstUsers.ListItems.Add(, sNewNick, Replace$(sNewNick, ">", ""), 1)
  392.        sList.ListSubItems.Add , , CheckNick(sNewNick), "blank"
  393.     End If
  394.     lstUsers.Refresh
  395. End Sub
  396.  
  397. Private Sub UserKicked(sNick As String)
  398.     On Error Resume Next
  399.     Dim sKicked As String
  400.     Dim sReason As String
  401.  
  402.     sKicked = Split(sData, " ")(3)
  403.     sReason = Replace(Split(sData, " :")(1), vbCrLf, "")
  404.  
  405.     txtmain.SelStart = Len(txtmain.Text)
  406.     txtmain.SelColor = &HFF&
  407.     txtmain.SelBold = True
  408.     txtmain.SelFontName = "Tahoma"
  409.     txtmain.SelText = "    Host " & sNick & " Kicked " & sKicked & " :" & sReason & vbCrLf
  410.     ResetFontFormat
  411.  
  412.     If sKicked = sMyNick Then
  413.         lstMe.ListItems.Clear
  414.         lstUsers.ListItems.Clear
  415.         ds1.Close
  416.         lUserCount.Caption = "0 chatters in room."
  417.         Exit Sub
  418.     End If
  419.  
  420.     For i = 1 To lstUsers.ListItems.Count
  421.         If lstUsers.ListItems(i).Key = sKicked Then
  422.             lstUsers.ListItems.Remove i
  423.             Exit For
  424.         End If
  425.     Next i
  426.  
  427.     GuideGroup = Replace$(GuideGroup, " " & sNick & " ", " ")
  428.     HostGroup = Replace$(HostGroup, " " & sNick & " ", " ")
  429.     OwnerGroup = Replace$(OwnerGroup, " " & sNick & " ", " ")
  430.  
  431.     lUserCount.Caption = lstUsers.ListItems.Count - 1 & " chatters in room."
  432.  
  433. End Sub
  434.  
  435. Private Sub UserControl_Initialize()
  436.     On Error Resume Next
  437.    
  438.     ReDim Emo(16)
  439.     ReDim Icon(16)
  440.  
  441.     Emo(1) = "(H) (h)"
  442.     Icon(1) = frmEmo.sunglass.Text
  443.     Emo(2) = ":P :p :-P :-p"
  444.     Icon(2) = frmEmo.Tongue.Text
  445.     Emo(3) = ":O :o :-o :-O"
  446.     Icon(3) = frmEmo.Oh.Text
  447.     Emo(4) = "(Y) (y)"
  448.     Icon(4) = frmEmo.thumbsup.Text
  449.     Emo(5) = ":) :-)"
  450.     Icon(5) = frmEmo.Smile.Text
  451.     Emo(6) = ":D :-D :d :-d :>"
  452.     Icon(6) = frmEmo.BSmile.Text
  453.     Emo(7) = ":( :-("
  454.     Icon(7) = frmEmo.Sad.Text
  455.     Emo(8) = ":| :-|"
  456.     Icon(8) = frmEmo.shut.Text
  457.     Emo(9) = ":'("
  458.     Icon(9) = frmEmo.cry.Text
  459.     Emo(10) = "(F) (f)"
  460.     Icon(10) = frmEmo.flower.Text
  461.     Emo(11) = ":s :S :-S :-s"
  462.     Icon(11) = frmEmo.SS.Text
  463.     Emo(12) = ";) ;-)"
  464.     Icon(12) = frmEmo.knipoog.Text
  465.     Emo(13) = ":@"
  466.     Icon(13) = frmEmo.angry.Text
  467.     Emo(14) = "(K) (k)"
  468.     Icon(14) = frmEmo.kiss.Text
  469.     Emo(15) = ":$ :-$"
  470.     Icon(15) = frmEmo.blush.Text
  471.     Emo(16) = "(A) (a)"
  472.     Icon(16) = frmEmo.angel.Text
  473.  
  474.     txtNickName.Text = "Webchat_" & Format(Now, "mmss") 'this is the random name
  475.  
  476.     ' the resize part isnt done for everything (yet?)
  477.    frButtonFrame.Move 0, (UserControl.ScaleHeight - 660), (UserControl.ScaleWidth - 2895 - 200), 560
  478.     frInputBorder.Move 90, (UserControl.ScaleHeight - 565), (UserControl.ScaleWidth - 5120), 380
  479.     txtSend.Move 130, (UserControl.ScaleHeight - 520), (UserControl.ScaleWidth - 5200), 300
  480.     cmdSend.Move (UserControl.ScaleWidth - 4920), (UserControl.ScaleHeight - 565), 1275, 380
  481.     cmdAction.Move (UserControl.ScaleWidth - 3550), (UserControl.ScaleHeight - 565), 375, 380
  482.     txtmain.Move 120, 80, (UserControl.ScaleWidth - 3225), (UserControl.ScaleHeight - 845)
  483.     frBack.Move (UserControl.ScaleWidth - frBack.Width - 100), 0, frBack.Width, (UserControl.ScaleHeight - 80)
  484.     chListback.Move (UserControl.ScaleWidth - chListback.Width - 120), 1080, chListback.Width, (UserControl.ScaleHeight - 1755)
  485.     lstUsers.Move (UserControl.ScaleWidth - lstUsers.Width - 140), 1150, 2800, (UserControl.ScaleHeight - 1850)
  486.     cmdOptions.Move (UserControl.ScaleWidth - 2905), (UserControl.ScaleHeight - 600), cmdOptions.Width, cmdOptions.Height
  487.     frTopBack.Move (UserControl.ScaleWidth - 3005), 0, frTopBack.Width, frTopBack.Height
  488.     lstMe.Move (UserControl.ScaleWidth - 2905), 800, lstMe.Width, lstMe.Height
  489.     lUserCount.Move (UserControl.ScaleWidth - 2805), 360, lUserCount.Width, lUserCount.Height
  490.     lRoomName.Move (UserControl.ScaleWidth - 2805), 40, lRoomName.Width, lRoomName.Height
  491.     shBack.Move 160, 60, (UserControl.ScaleWidth - 3255), (UserControl.ScaleHeight - 815)
  492.     shCorner.Move 60, 60, 855, (UserControl.ScaleHeight - 815)
  493.    
  494.     EnableURLDetect txtmain.hWnd, Me.hWnd
  495.        
  496. End Sub
  497.  
  498. Public Property Get hWnd() As Long
  499.     hWnd = UserControl.hWnd
  500. End Property
  501.  
  502. Private Sub UserMode(sNick As String, sUser As String, sEvent As String, sIcon As String, sGroup As String)
  503.  
  504.     Webding ' I use this to skip tonns of code each time
  505.    txtmain.SelFontName = "Tahoma"
  506.     txtmain.SelText = sNick & " has made " & sUser & sEvent & vbCrLf
  507.     ResetFontFormat
  508.  
  509.     If sUser = lstMe.ListItems(lstMe.ListItems.Count).Key Then
  510.         lstMe.ListItems(lstMe.ListItems.Count).SmallIcon = sIcon
  511.         Exit Sub
  512.     End If
  513.  
  514.     For i = 1 To lstUsers.ListItems.Count
  515.         If lstUsers.ListItems(i).Key = sUser Then
  516.             Set sList = lstUsers.ListItems(i)
  517.             sList.ListSubItems(1).ReportIcon = sIcon
  518.             If sIcon = "gold" Then
  519.                 sGroup = sGroup & " " & lstUsers.ListItems(i).Key & " "
  520.                 sList.ListSubItems(1).Text = sList.ListSubItems(1).Text & " (Host)"
  521.                 lstUsers.ListItems(i).Text = "." & lstUsers.ListItems(i).Text
  522.             ElseIf sIcon = "brown" Then
  523.                 sGroup = sGroup & " " & lstUsers.ListItems(i).Key & " "
  524.                 sList.ListSubItems(1).Text = sList.ListSubItems(1).Text & " (Host)"
  525.                 lstUsers.ListItems(i).Text = "@" & lstUsers.ListItems(i).Text
  526.             ElseIf sIcon = "blank" Then
  527.                 sGroup = Replace(sGroup, " " & lstUsers.ListItems(i).Key & " ", "")
  528.                 sList.ListSubItems(1).Text = Replace(sList.ListSubItems(1).Text, " (Host)", "")
  529.                 lstUsers.ListItems(i).Text = Replace(lstUsers.ListItems(i).Text, "@", "")
  530.                 lstUsers.ListItems(i).Text = Replace(lstUsers.ListItems(i).Text, ".", "")
  531.             End If
  532.             lstUsers.ListItems(i).SmallIcon = sIcon
  533.             Exit For
  534.         End If
  535.     Next i
  536.  
  537.     lstUsers.ListItems.Add , "      ", "      "
  538.     For i = 1 To lstUsers.ListItems.Count
  539.         If lstUsers.ListItems(i).Key = "      " Then
  540.             lstUsers.ListItems.Remove i
  541.             Exit For
  542.         End If
  543.     Next i
  544.        
  545. End Sub
  546.  
  547. Private Sub SetEmo()
  548. Dim j As Integer
  549. Dim CharCombo() As String
  550. Dim lFoundPosition2 As Long
  551.  
  552. On Error Resume Next
  553. For i = 0 To 30
  554.     CharCombo = Split(Emo(i), " ")
  555.     For j = 0 To UBound(CharCombo)
  556.         lFoundPosition2 = InStr(lFoundPosition, txtmain.Text, CharCombo(j))
  557.         While lFoundPosition2 > 0
  558.             txtmain.SelStart = lFoundPosition2 - 1
  559.             txtmain.SelLength = Len(CharCombo(j))
  560.             txtmain.SelRTF = Icon(i)
  561.             lFoundPosition2 = InStr(lFoundPosition2, txtmain.Text, CharCombo(j))
  562.         Wend
  563.     Next j
  564. Next i
  565.  
  566. lFoundPosition = Len(txtmain.Text) - 1
  567.  
  568. End Sub
  569.  
  570. Private Sub UserControl_Resize()
  571. On Error Resume Next
  572.     frButtonFrame.Move 0, (UserControl.ScaleHeight - 660), (UserControl.ScaleWidth - 2895 - 200), 560
  573.     frInputBorder.Move 90, (UserControl.ScaleHeight - 565), (UserControl.ScaleWidth - 5120), 380
  574.     txtSend.Move 130, (UserControl.ScaleHeight - 520), (UserControl.ScaleWidth - 5200), 300
  575.     cmdSend.Move (UserControl.ScaleWidth - 4920), (UserControl.ScaleHeight - 565), 1275, 380
  576.     cmdAction.Move (UserControl.ScaleWidth - 3550), (UserControl.ScaleHeight - 565), 375, 380
  577.     txtmain.Move 120, 80, (UserControl.ScaleWidth - 3225), (UserControl.ScaleHeight - 845)
  578.     frBack.Move (UserControl.ScaleWidth - frBack.Width - 100), 0, frBack.Width, (UserControl.ScaleHeight - 80)
  579.     chListback.Move (UserControl.ScaleWidth - chListback.Width - 120), 1080, chListback.Width, (UserControl.ScaleHeight - 1755)
  580.     lstUsers.Move (UserControl.ScaleWidth - lstUsers.Width - 140), 1150, 2800, (UserControl.ScaleHeight - 1850)
  581.     cmdOptions.Move (UserControl.ScaleWidth - 2905), (UserControl.ScaleHeight - 600), cmdOptions.Width, cmdOptions.Height
  582.     frTopBack.Move (UserControl.ScaleWidth - 3005), 0, frTopBack.Width, frTopBack.Height
  583.     lstMe.Move (UserControl.ScaleWidth - 2905), 800, lstMe.Width, lstMe.Height
  584.     lUserCount.Move (UserControl.ScaleWidth - 2805), 360, lUserCount.Width, lUserCount.Height
  585.     lRoomName.Move (UserControl.ScaleWidth - 2805), 40, lRoomName.Width, lRoomName.Height
  586.     shBack.Move 160, 60, (UserControl.ScaleWidth - 3255), (UserControl.ScaleHeight - 815)
  587.     shCorner.Move 60, 60, 855, (UserControl.ScaleHeight - 815)
  588. End Sub
  589.  
  590. Private Sub UserControl_Show()
  591.  
  592.     txtRoom.Text = Replace(txtRoom.Text, " ", "\b")
  593.     CMode = 1
  594.     Dim localport As Long
  595.         ds1.Close
  596.         localport = 0
  597.         ds1.RemotePort = 6667
  598.         ds1.localport = localport
  599.         identd.localport = 113
  600.         On Error GoTo closeidentd
  601.         identd.Listen
  602. closeidentd:
  603.         ds1.Connect txtServer, 6667
  604.  
  605.         txtmain.SelColor = &H8000&
  606.         txtmain.SelItalic = False
  607.         txtmain.SelText = "Please wait, connecting to server..." & vbCrLf
  608.         ResetFontFormat
  609.  
  610. End Sub
  611.  
  612. Private Sub UserControl_Terminate()
  613.     On Error Resume Next
  614.     ds1.Close
  615.     Set sList = Nothing
  616.     Set ie = Nothing
  617.     DisableURLDetect
  618. End Sub
  619.  
  620. Private Sub ds1_Connect()
  621. Dim sPass As String
  622.         SendServ ("NICK " & txtNickName.Text)
  623.         SendServ ("Nickserv Identify " & sPass)
  624.         SendServ ("USER " & txtNickName.Text) & " " & ds1.LocalHostName & " irc.xtcomputing.com :XTeam"
  625. End Sub
  626. Private Sub ds1_DataArrival(ByVal bytesTotal As Long)
  627. Dim asData() As String
  628. Dim i        As Integer
  629.     ds1.GetData sData, vbString
  630.     asData = Split(sData, vbCrLf)
  631.     ReDim Preserve asData(UBound(asData)) As String
  632.     For i = 0 To UBound(asData)
  633.         sData = asData(i)
  634.         If sData <> "" Then
  635.             Parse
  636.         End If
  637.     Next i
  638.     Erase asData
  639. End Sub
  640. Private Sub Parse()
  641. Dim sUsers As String
  642. Dim sTopic As String
  643. Dim sWelcome As String
  644. Dim sTemp As String
  645.  
  646. txtmain.SelStart = Len(txtmain.Text)
  647. On Error Resume Next
  648. Select Case CMode
  649.     Case 1
  650.         Select Case Split(sData, " ")(1)
  651.             Case "001"
  652.                 sMyNick = Split(sData, " ")(2)
  653.                 lstMe.ListItems.Add , sMyNick, sMyNick
  654.                 SendServ "JOIN #" & txtRoom.Text
  655.                 Exit Sub
  656.             Case "NOTICE"
  657.                 Broadcast
  658.                 Exit Sub
  659.             Case "433"
  660.                 MsgBox "Nickname already in use.", vbOKOnly, "Nick in use"
  661.                 ds1.Close
  662.                 Exit Sub
  663.             Case "913"
  664.                 MsgBox "You are banned from this chatroom.", vbOKOnly, "Banned"
  665.                 ds1.Close
  666.                 Exit Sub
  667.             Case "437"
  668.                 MsgBox "Invite only chatroom.", vbOKOnly, "Invite only mode"
  669.                 ds1.Close
  670.                 Exit Sub
  671.             Case "JOIN"
  672.                 txtmain.SelColor = &HFF&
  673.                 txtmain.SelItalic = False
  674.                 txtmain.SelText = "Connected!" & vbCrLf & vbCrLf
  675.                 ResetFontFormat
  676.                 sChannel = Split(sData, " ")(2)
  677.                 sChannel = Replace$(sChannel, ":", "")
  678.                 lRoomName.Caption = LCase$(Replace$(Replace$(sChannel, "#", ""), "\b", " "))
  679.             Case "332"
  680.                 sTopic = Split(sData, " :")(1)
  681.                 sTopic = Replace(sTopic, "\b", " ")
  682.                 txtmain.SelColor = &H808000
  683.                 txtmain.SelText = vbCrLf & "The chat's topic is: "
  684.                 txtmain.SelColor = &H0&
  685.                 txtmain.SelText = sTopic & vbCrLf & vbCrLf
  686.                 ResetFontFormat
  687.                 Exit Sub
  688.             Case "353"
  689.                 sUsers = Split(sData, sChannel & " :")(1)
  690.                 ReadNames (sUsers)
  691.                 Exit Sub
  692.             Case "366"
  693.                 CMode = 2
  694.         End Select
  695.     Case 2
  696.         Select Case Split(sData, " ")(1)
  697.             Case "NOTICE"
  698.                 Broadcast
  699.                 Exit Sub
  700.             Case "KICK"
  701.                 UserKicked GetNick(sData)
  702.                 Exit Sub
  703.             Case "JOIN"
  704.                 UserJoined GetNick(sData)
  705.                 Exit Sub
  706.             Case "QUIT"
  707.                 UserParted GetNick(sData)
  708.                 Exit Sub
  709.             Case "PART"
  710.                 UserParted GetNick(sData)
  711.                 Exit Sub
  712.             Case "PRIVMSG"
  713.                 If Split(sData, " ")(3) = ":ACTION" Then
  714.                     UserAction GetNick(sData)
  715.                     Exit Sub
  716.                 ElseIf Split(sData, " ")(2) = sMyNick Then
  717.                     UserWhisper GetNick(sData)
  718.                     Exit Sub
  719.                 Else
  720.                     UserSpoke GetNick(sData)
  721.                     Exit Sub
  722.                 End If
  723.             Case "MODE"
  724.                 Select Case Split(sData, " ")(3)
  725.                     Case "+q"
  726.                         UserMode GetNick(sData), (Split(sData, " ")(4)), " an Owner.", "gold", OwnerGroup
  727.                     Case "+o"
  728.                         UserMode GetNick(sData), (Split(sData, " ")(4)), " a Host.", "brown", HostGroup
  729.                     Case "-q"
  730.                         UserMode GetNick(sData), (Split(sData, " ")(4)), " a Participant.", "blank", OwnerGroup
  731.                     Case "-o"
  732.                         UserMode GetNick(sData), (Split(sData, " ")(4)), " a Participant.", "blank", HostGroup
  733.                 End Select
  734.             Case "NICK"
  735.                     NickChanged GetNick(sData)
  736.             Case "499"
  737.                 Webding
  738.                 txtmain.SelFontName = "Tahoma"
  739.                 txtmain.SelText = "You're not a channel owner." & vbCrLf
  740.                 ResetFontFormat
  741.         End Select
  742.     End Select
  743.    
  744.     Select Case Split(UCase$(sData), " ")(0)
  745.         Case "PING" 'PING :19D30FF
  746.            sTemp = Split(sData, "PING :")(1)
  747.             SendServ "PONG :" & sTemp
  748.     End Select
  749.  
  750.     WriteLog "RECEIVED: " & sData
  751.    
  752. End Sub
  753.  
  754. Function GetNick(str As String)
  755.      GetNick = Split(str, "!")(0)
  756.      GetNick = Right$(GetNick, Len(GetNick) - 1)
  757. End Function
  758.  
  759. Public Sub SendServ(strData As String)
  760.     On Error GoTo ERRH_
  761.     ds1.SendData strData & vbCrLf
  762.     WriteLog "SEND: " & strData
  763.     Exit Sub
  764. ERRH_:
  765.     MsgBox "Description: " & Err.Description & vbNewLine & "Number: " & Err.Number
  766. End Sub
  767.  
  768. Private Sub UserAction(sNick As String)
  769. Dim sMsg As String
  770.     sMsg = Split(sData, ":ACTION")(1)
  771.     sMsg = Replace(sMsg, "", "")
  772.     sMsg = Replace(sMsg, vbCrLf, "")
  773.     Status sNick
  774.     txtmain.SelStart = Len(txtmain.Text)
  775.     txtmain.SelItalic = True
  776.     txtmain.SelColor = &H800080
  777.     txtmain.SelText = Replace(CheckNick(sNick), "'", "") & " " & sMsg & vbCrLf
  778.     ResetFontFormat
  779. End Sub
  780.  
  781. Private Sub UserSpoke(sNick As String)
  782. Dim sMsg As String
  783.     sMsg = Split(sData, " PRIVMSG " & sChannel & " :")(1)
  784.     Status sNick
  785.     txtmain.SelStart = Len(txtmain.Text)
  786.     txtmain.SelColor = &H800000
  787.     txtmain.SelText = Replace$(CheckNick(sNick), "'", "") & " : "
  788.     txtmain.SelColor = read_color(sMsg)
  789.     txtmain.SelBold = sBold
  790.     txtmain.SelText = sParsed & vbCrLf
  791.     txtmain.SelFontName = "Tahoma"
  792.     sBold = False
  793.     ResetFontFormat
  794. End Sub
  795.    
  796. Private Sub Status(sNick As String)
  797.     If InStr(1, HostGroup, " " & sNick & " ") <> 0 Then
  798.         txtmain.SelText = " "
  799.         txtmain.SelRTF = frmEmo.brown.Text
  800.     ElseIf InStr(1, GuideGroup, " " & sNick & " ") <> 0 Then
  801.         txtmain.SelText = " "
  802.         txtmain.SelRTF = frmEmo.butterfly.Text
  803.     ElseIf InStr(1, OwnerGroup, " " & sNick & " ") <> 0 Then
  804.         txtmain.SelText = " "
  805.         txtmain.SelRTF = frmEmo.gold.Text
  806.     Else
  807.         txtmain.SelText = "    "
  808.     End If
  809. End Sub
  810.  
  811. Private Sub UserJoined(sNick As String)
  812.  
  813.     Webding
  814.     txtmain.SelFontName = "Tahoma"
  815.     txtmain.SelText = Replace$(CheckNick(sNick), "'", "") & " has joined the conversation." & vbCrLf
  816.     ResetFontFormat
  817.  
  818.     If Left$(sNick, 1) = "'" Then
  819.         GuideGroup = GuideGroup & " " & sNick & " "
  820.         Set sList = lstUsers.ListItems.Add(, sNick, " " & sNick, , "guide")
  821.         sList.ListSubItems.Add , , Replace(sNick, "'", "") & " (Host)", "guide"
  822.     Else
  823.         Set sList = lstUsers.ListItems.Add(, sNick, CheckNick(sNick))
  824.         sList.ListSubItems.Add , , CheckNick(sNick), "blank"
  825.     End If
  826.  
  827.     lUserCount.Caption = lstUsers.ListItems.Count + 1 & " chatters in room."
  828.  
  829. End Sub
  830.  
  831. Private Sub UserParted(sNick As String)
  832.  
  833.     Webding
  834.     txtmain.SelFontName = "Tahoma"
  835.     txtmain.SelText = Replace(CheckNick(sNick), "'", "") & " has left the conversation." + vbCrLf
  836.     ResetFontFormat
  837.    
  838.     GuideGroup = Replace(GuideGroup, " " & sNick & " ", "")
  839.     HostGroup = Replace(HostGroup, " " & sNick & " ", "")
  840.     OwnerGroup = Replace(OwnerGroup, " " & sNick & " ", "")
  841.    
  842.     For i = 1 To lstUsers.ListItems.Count
  843.         If lstUsers.ListItems(i).Key = sNick Then
  844.             lstUsers.ListItems.Remove i
  845.             Exit For
  846.         End If
  847.     Next i
  848.    
  849.     lUserCount.Caption = lstUsers.ListItems.Count + 1 & " chatters in room."
  850.    
  851. End Sub
  852.  
  853. Private Sub Broadcast()
  854. Dim msg As String
  855.     msg = Split(sData, " :")(1)
  856.     msg = Replace(msg, vbCrLf, "")
  857.     txtmain.SelStart = Len(txtmain.Text)
  858.     txtmain.SelColor = &HFF&
  859.     txtmain.SelText = "Broadcast Message from " & txtServer & ":" & vbCrLf
  860.     txtmain.SelColor = &H0&
  861.     txtmain.SelText = msg & vbCrLf
  862.     ResetFontFormat
  863. End Sub
  864.  
  865. Private Sub WriteLog(StrText As String, Optional Color As Long = vbBlack)
  866.     StrText = Replace(StrText, vbCrLf, "")
  867.     On Error Resume Next
  868.     frmTrace.txtTrace.SelStart = Len(frmTrace.txtTrace.Text)                  'Jump to end
  869.    frmTrace.txtTrace.SelText = frmTrace.txtTrace.SelText & StrText & vbCrLf  'Write text
  870.    frmTrace.txtTrace.SelStart = Len(frmTrace.txtTrace.Text)                  'Jup to end again
  871. End Sub
  872.  
  873. Private Sub ReadNames(Users)
  874. Dim asUsers()    As String
  875. Dim strName      As String
  876. Dim i            As Integer
  877.  
  878.     asUsers = Split(Users, " ")
  879.     For i = 0 To UBound(asUsers)
  880.         On Error Resume Next
  881.         Select Case (Left$(asUsers(i), 1))
  882.             Case "~"
  883.                 strName = Replace$(asUsers(i), "~", "")
  884.                 If strName <> sMyNick Then
  885.                     OwnerGroup = OwnerGroup & " " & strName & " "
  886.                     Set sList = lstUsers.ListItems.Add(, strName, "." & strName, "gold")
  887.                     sList.ListSubItems.Add , , strName & " (Host)", "gold"
  888.                 End If
  889.             Case "&"
  890.                 strName = Replace$(asUsers(i), "&", "")
  891.                 If strName <> sMyNick Then
  892.                     GuideGroup = GuideGroup & " " & strName & " "
  893.                     Set sList = lstUsers.ListItems.Add(, strName, asUsers(i), , "guide")
  894.                     sList.ListSubItems.Add , , strName & " (Host)", "guide"
  895.                 End If
  896.             Case "%"
  897.                 strName = Replace$(asUsers(i), "%", "")
  898.                 If strName <> sMyNick Then
  899.                     HostGroup = HostGroup & " " & strName & " "
  900.                     Set sList = lstUsers.ListItems.Add(, strName, asUsers(i), , "brown")
  901.                     sList.ListSubItems.Add , , strName & " (Host)", "brown"
  902.                 End If
  903.             Case "@"
  904.                 strName = Replace$(asUsers(i), "@", "")
  905.                 If strName <> sMyNick Then
  906.                     HostGroup = HostGroup & " " & strName & " "
  907.                     Set sList = lstUsers.ListItems.Add(, strName, asUsers(i), , "brown")
  908.                     sList.ListSubItems.Add , , strName & " (Host)", "brown"
  909.                 Else
  910.                     HostGroup = HostGroup & " " & strName & " "
  911.                     lstMe.ListItems.Remove 1
  912.                     Set sList = lstMe.ListItems.Add(, strName, strName, , "brown")
  913.                 End If
  914.             Case "+"
  915.                 strName = Replace$(asUsers(i), "+", "")
  916.                 If strName <> sMyNick Then
  917.                     Set sList = lstUsers.ListItems.Add(, strName, asUsers(i), 1)
  918.                     sList.ListSubItems.Add , , CheckNick(strName), "blank"
  919.                 End If
  920.             Case Else
  921.                 If asUsers(i) <> sMyNick And asUsers(i) <> "" Then
  922.                     Set sList = lstUsers.ListItems.Add(, asUsers(i), asUsers(i), 1)
  923.                     sList.ListSubItems.Add , , CheckNick(asUsers(i)), "blank"
  924.                 End If
  925.         End Select
  926.     lUserCount.Caption = lstUsers.ListItems.Count + 1 & " chatters in room."
  927.     Next
  928.  
  929.     lstMe.ListItems(1).Text = CheckNick(lstMe.ListItems(1).Text)
  930.     lstUsers.Refresh
  931.  
  932. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!