www.pudn.com > irc-code.zip > IRCPRE2.FRM
VERSION 4.00
Begin VB.Form Form1
Caption = "IRC Preface Example Client - Revised"
ClientHeight = 4672
ClientLeft = 1552
ClientTop = 1664
ClientWidth = 6880
Height = 5312
Left = 1488
LinkTopic = "Form1"
ScaleHeight = 292
ScaleMode = 3 'Pixel
ScaleWidth = 430
Top = 1088
Width = 7008
Begin VB.ListBox NameList
Height = 3808
Left = 5296
Sorted = -1 'True
TabIndex = 3
Top = 384
Width = 1488
End
Begin VB.TextBox Topic
Height = 304
Left = 64
TabIndex = 2
Top = 64
Width = 6720
End
Begin VB.TextBox Outgoing
Height = 300
Left = 64
TabIndex = 1
Top = 3888
Width = 5232
End
Begin VB.TextBox Incoming
Height = 3504
Left = 64
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 384
Width = 5232
End
Begin WINSOCKLib.TCP TCP1
Left = 6400
Top = 4224
_ExtentX = 709
_ExtentY = 709
RemoteHost = ""
RemotePort = 0
LocalPort = 0
End
Begin VB.Menu mnuFile
Caption = "&File"
Begin VB.Menu FileConnect
Caption = "&Connect"
End
Begin VB.Menu FileSetup
Caption = "&Setup"
End
Begin VB.Menu dash
Caption = "-"
End
Begin VB.Menu FileExit
Caption = "E&xit"
End
End
Begin VB.Menu mnuHelp
Caption = "&Help"
Begin VB.Menu HelpAbout
Caption = "&About"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
' This example and included document are
' Copyright (C) 1996 by Dann Daggett II
' Please read the document that comes with this
' program.
Dim CRLF As String ' Cairrage return/Line feed
Dim OldText As String ' Holds any text still
' needing processed
Dim channel As String ' Holds the channel name
Dim CMode ' CurrentMode of client
' 0 is logged in
' 1 is joining channel
' 2 is in channel
Sub AddText(textmsg As String)
' Add the data in textmsg to the Incoming
' text box and force the text down
Incoming.Text = Incoming.Text & textmsg & CRLF
End Sub
Sub SendData(textmsg As String)
' Send the data in textmsg to the server, and
' add a CRLF
TCP1.SendData textmsg & CRLF
End Sub
Private Sub FileConnect_Click()
If FileConnect.Caption = "&Connect" Then
' Set the RemoteHost to the IRC Server Host
TCP1.RemoteHost = Server
' Set the Port to connect to
TCP1.RemotePort = Port
' Connect
TCP1.Connect
' Clear textbox, topic and listbox
Incoming.Text = ""
NameList.Clear
Topic.Text = ""
AddText "*** Attempting to connect to " & Server & "..."
FileConnect.Caption = "&Disconnect"
Else
FileConnect.Caption = "&Connect"
AddText "*** Disconnected"
' Close the socket
TCP1.Close
End If
End Sub
Private Sub FileExit_Click()
' Close the program
Unload Me
End Sub
Private Sub FileSetup_Click()
' Show the setup form
setup.Show 1
End Sub
Private Sub Form_Activate()
' Scroll the textbox down again
Incoming_Change
End Sub
Private Sub Form_Load()
' Set CRLF to be Cairrage Return + Line Feed,
' ALL IRC messages end with this
CRLF = Chr$(13) & Chr$(10)
' Set the current mode to 0
CMode = 0
'Set the default values
Server = "irc.neosoft.com"
Port = 6667
Nickname = "IRCPre2"
End Sub
Private Sub HelpAbout_Click()
about.Show 1
End Sub
Private Sub Incoming_Change()
' We want this box to scroll down automatically.
Incoming.SelStart = Len(Incoming.Text)
' What this does is says, make the start of my
' selected text the end of the entire text,
' which effectively scrolls down the textbox,
' but does not select anything. The len()
' command returns the length of characters of
' the text, in a number.
End Sub
Private Sub Incoming_GotFocus()
' We don't want the client to be able to edit
' the Incoming textbox.
Outgoing.SetFocus
' This make it so the user cannot click inside
' the Incoming text box, but can still scroll it.
' It does this by giving another object the
' focus.
End Sub
Private Sub Outgoing_KeyPress(KeyAscii As Integer)
Dim msg As String
' Exit unless its a return, then process
If KeyAscii <> 13 Then Exit Sub
KeyAscii = 0 ' Stop that stupid beep!
msg = Outgoing.Text
If Left$(msg, 1) <> "/" Then
' they want to send a msg, send it if we're
' in a channel
If NameList.ListCount > 0 Then
SendData "PRIVMSG " & channel & " :" & msg
AddText "> " & msg
End If
Else
Outgoing.Text = Mid$(Outgoing.Text, 2)
msg = Mid$(Outgoing.Text, InStr(Outgoing.Text, " ") + 1)
Select Case UCase$(Left$(Outgoing.Text, InStr(Outgoing.Text, " ") - 1)) ' see what kind of action to do
Case "JOIN"
SendData "JOIN " & msg: CMode = 1 ' join the channel, set the mode
channel = msg
Case "ME"
' if we're in a channel, then do an action
If NameList.ListCount > 0 Then SendData "PRIVMSG " & channel & " :" & Chr$(1) & "ACTION " & msg & Chr$(1)
AddText "* " & Nickname & " " & msg
Case "MSG"
' send a priv msg
SendData "PRIVMSG " & Left$(msg, InStr(msg, " ") - 1) & " :" & Mid$(msg, InStr(msg, " ") + 1)
AddText "=->" & Left$(msg, InStr(msg, " ") - 1) & "<-= " & Mid$(msg, InStr(msg, " ") + 1)
End Select
End If
' clear the textbox
Outgoing.Text = ""
End Sub
Private Sub TCP1_Close()
FileConnect.Caption = "&Connect"
AddText "*** Disconnected"
' Close the socket
TCP1.Close
End Sub
Private Sub TCP1_Connect()
' Physical connect
AddText "*** Connection established."
AddText "*** Sending login information..."
' Send the server my nickname
SendData "NICK " & Nickname
' Send the server the user information
SendData "USER email " & TCP1.LocalIP & " " & Server & " :username"
End Sub
Private Sub TCP1_DataArrival(ByVal bytesTotal As Long)
Dim inData As String
Dim sline As String
Dim msg As String
Dim msg2 As String
Dim x
' Get the incoming data into a string
TCP1.GetData inData, vbString
' Add any unprocessed text on first
inData = OldText & inData
' Some IRC servers are only using a Cairrage
' Retrun, or a LineFeed, instead of both, so
' we need to be prepared for that
x = 0
If Right$(inData, 2) = CRLF Then x = 1
If Right$(inData, 1) = Chr$(10) Then x = 1
If Right$(inData, 1) = Chr$(13) Then x = 1
If x = 1 Then
OldText = "" ' its a full send, process
Else
OldText = inData: Exit Sub ' incomplete send
' save and exit
End If
again:
GoSub parsemsg ' get next msg fragment
If Left$(sline, 6) = "PING :" Then ' we need to pong to stay alive
AddText "PING? PONG!"
SendData "PONG " & Server
GoTo again ' get next msg
End If
If Left$(sline, 5) = "ERROR" Then ' some error
AddText "*** ERROR " & Mid$(sline, InStr(sline, "("))
End If
If Left$(sline, Len(Nickname) + 1) = ":" & Nickname Then
' a command for the client only
sline = Mid$(sline, InStr(sline, " ") + 1)
Select Case Left$(sline, InStr(sline, " ") - 1)
Case "MODE"
AddText "*** Your mode is now " & Mid$(sline, InStr(sline, ":") + 1)
End Select
End If
If Mid$(sline, InStr(sline, " ") + 1, 7) = "PRIVMSG" Then
'someone /msged us
msg = Mid$(sline, InStr(sline, " ") + 9)
If LCase$(Left$(msg, InStr(msg, " ") - 1)) = LCase$(Nickname) Then ' private msg
' add so its: --nick-- msg here
AddText "--" & Mid$(sline, 2, InStr(sline, "!") - 2) & "-- " & Mid$(msg, InStr(msg, ":") + 1)
End If
End If
Select Case CMode
Case 0 ' not in channel
If Mid$(sline, InStr(1, sline, " ") + 1, 3) = "001" Then
Server = Mid$(sline, 2, InStr(sline, " ") - 2)
End If
If Left$(sline, Len(Server) + 1) = ":" & Server Then
' its a server msg, add the important part
sline = Mid$(sline, InStr(2, sline, ":") + 1)
':washington.dc.us.undernet.org 001 Das2 :Welcome to the Internet Relay Network Das2
AddText sline
End If
Case 1 ' joining channel
If Left$(sline, Len(Server) + 1) = ":" & Server Then
msg = Mid$(sline, InStr(sline, " ") + 1)
Select Case Left$(msg, InStr(msg, " ") - 1)
Case "332" ' Topic
Topic.Text = Mid$(msg, InStr(msg, ":") + 1)
Case "353" ' Name list
msg = Mid$(msg, InStr(msg, ":") + 1)
Do Until msg = "" ' break apart names and add them seperatly
x = InStr(msg, " ")
If x <> 0 Then
NameList.AddItem Left$(msg, x - 1)
msg = Mid$(msg, x + 1)
Else
NameList.AddItem msg
msg = ""
End If
Loop
Case "366" ' End of Name List
CMode = 2 ' change mode to joined channel
End Select
Else
' someone joined the channel, us!
If Left$(sline, InStr(sline, " ") - 1) = "JOIN" Then
AddText "*** " & Nickname & " has joined " & channel
End If
End If
Case 2 ' in a channel
If Mid$(sline, InStr(sline, " ") + 1, 7) = "PRIVMSG" Then
msg = Mid$(sline, InStr(sline, " ") + 9)
If LCase$(Left$(msg, InStr(msg, " ") - 1)) = LCase$(Nickname) Then ' private msg
AddText "--" & Mid$(sline, 2, InStr(sline, "!") - 2) & "-- " & Mid$(msg, InStr(msg, ":") + 1)
Else ' channel msg
If Left$(Mid$(msg, InStr(msg, ":") + 1), 1) = Chr$(1) Then ' action
msg2 = Mid$(msg, InStr(msg, ":") + 9)
AddText "* " & Mid$(sline, 2, InStr(sline, "!") - 2) & " " & Left$(msg2, Len(msg2) - 1)
Else ' msg
AddText "<" & Mid$(sline, 2, InStr(sline, "!") - 2) & "> " & Mid$(msg, InStr(msg, ":") + 1)
End If
End If
Else
' command not yet supported, just display it
AddText sline
End If
End Select
' Did I say "Good programming practice?"
' Sometimes its easier to do this
GoTo again
Exit Sub
parsemsg:
' irc may send more than one msg at a time,
' so parse them first
If inData = "" Then Exit Sub
x = InStr(inData, CRLF) ' find the break
If x <> 0 Then
sline = Left$(inData, x - 1)
' strip off the text
If Len(inData) > x + 2 Then
inData = Mid$(inData, x + 2)
Else
inData = ""
End If
Else
x = InStr(inData, Chr$(13)) ' find the break
If x = 0 Then
x = InStr(inData, Chr$(10)) ' find the break
End If
If x <> 0 Then
sline = Left$(inData, x - 1)
Else
sline = inData
End If
' strip off the text
If Len(inData) > x + 1 Then
inData = Mid$(inData, x + 1)
Else
inData = ""
End If
End If
Return
End Sub
Private Sub Topic_GotFocus()
' We don't want the client to be able to edit
' the topic
Outgoing.SetFocus
End Sub