His brain exploded (or i'm terrible at making tables in mySQL)
here is what's left
Public strNick As String
Public strChannel As String
Public blnNotConnected As Boolean
Public intLastline As Integer
Private intSec
Private intMin
Private intHour
Private intDay
Public AttentionLevel As Integer
Public Sub DebugPrint(what As String)
Form1.txtDebug.text = Form1.txtDebug.text & what & vbNewLine
Form1.txtDebug.SelStart = Len(Form1.txtDebug.text)
End Sub
Public Sub ParseData(data As String)
'all data sent by the IRC server is processed here first
Dim pingargs As Variant, datastring, dataargs As Variant, Messageastring, intSearch2 As Long, messageargs As Variant, nickstring, nickargs As Variant
Dim intSearch As Integer
Dim Pingdata As String
Dim channel As String
Dim MyMessage As String
DebugPrint ("RAW INCOMING DATA " & data)
On Error Resume Next
If blnNotConnected Then
':irc.semicolon-zero.com 001 Rocko :
intSearch = InStr(1, data, " 001 " & strNick & " :")
If intSearch <> 0 Then
Send ("JOIN :" & strChannel)
DebugPrint ("Connected")
DebugPrint ("Joined Channel " & strChannel)
blnNotConnected = False
Form1.cmdConnect.Caption = "Disconnect"
Form1.cmdConnect.Enabled = True
End If
End If
intSearch = InStr(1, data, "PING")
If intSearch <> 0 Then
pingargs = Split(data, ":")
Pingdata = pingargs(1)
Send ("PONG :" & Pingdata)
Exit Sub
End If
':MikeJ!~jagels@h-69-3-145-25.SNVACAID.dynamic.covad.net PRIVMSG #semicolon-zero :thi sis a test
parsestring = data
parseargs = Split(parsestring, vbNewLine)
For i = 0 To UBound(parseargs)
data = parseargs(i)
datastring = data
dataargs = Split(datastring, " ")
If UBound(dataargs) >= 2 Then
If dataargs(1) = "PRIVMSG" Then
If dataargs(2) = strNick Then
'Rocko got a PM
'Do PM stuff
Else
'Detected Channel Text
Dim StrSpokenChannel As String
Dim strSpokenNick As String
Dim strSpokenText As String
StrSpokenChannel = dataargs(2)
datastring = dataargs(0)
dataargs = Split(datastring, "!")
strSpokenNick = Replace(dataargs(0), ":", "")
datastring = data
dataargs = Split(datastring, ":")
strSpokenText = Replace(datastring, dataargs(0), "")
strSpokenText = Replace(strSpokenText, dataargs(1), "")
strSpokenText = Right(strSpokenText, Len(strSpokenText) - 2)
DebugPrint (strSpokenNick & " said " & strSpokenText & " on " & StrSpokenChannel)
If strSpokenNick = "graham" Then
'nothing
Else
Call ChannelParse(strSpokenNick, StrSpokenChannel, strSpokenText)
End If
End If
End If
End If
Next i
End Sub
Public Sub ChannelParse(nick As String, channel As String, what As String)
Dim StrSpokenChannel As String
Dim strSpokenNick As String
Dim strSpokenText As String
Dim blnCommand As Boolean
'Format for parsing
StrSpokenChannel = Replace(channel, vbNewLine, "")
strSpokenNick = Replace(nick, vbNewLine, "")
strSpokenText = Replace(what, vbNewLine, "")
strSpokenNick = Replace(strSpokenNick, "{", "")
strSpokenNick = Replace(strSpokenNick, "}", "")
strSpokenText = Replace(strSpokenText, "{", "")
strSpokenText = Replace(strSpokenText, "}", "")
For i = 1 To Len(strSpokenText)
strSpokenText = Replace(strSpokenText, " ", " ")
Next i
DebugPrint ("FILTERED CHANNEL DATA " & "<" & strSpokenNick & "> " & strSpokenText)
Form1.Timer1.Enabled = False
Call RaiseAttention(10) '+10 attention points for channel activity
Form1.Timer1.Enabled = True
intLastline = intLastline + 1
blnCommand = False
'check for COMMAND
intSearch = InStr(1, UCase$(strSpokenText), "ROCKO") 'name said?, might not be command but
'high priority
If intSearch <> 0 Then
Call RaiseAttention(1000) 'Max attention because someone said my name
intSearch = InStr(1, UCase$(strSpokenText), "REPORT")
If intSearch <> 0 Then
If strSpokenNick = "MikeJ" Then
'Report
Call ReportStatus(StrSpokenChannel)
blnCommand = True
End If
Else
intSearch = InStr(1, UCase$(strSpokenText), "DIE")
If intSearch <> 0 Then
If strSpokenNick = "MikeJ" Then
Send ("PRIVMSG " & StrSpokenChannel & " :I'M BONING OUT!!!")
Send ("QUIT :Rocko Bot by MikeJ")
Form1.cmdConnect.Caption = "Connect"
'Exit Sub
blnCommand = True
End If
Else
If IsIn(strSpokenText, "shut") And IsIn(strSpokenText, "up") Then
Send ("PRIVMSG " & StrSpokenChannel & " :OK, Sorry. I'm shutting up, for now.")
AttentionLevel = -500
Form1.lblAttention.Caption = AttentionLevel 'someone doesn't want me talking
'i'll stop paying attention to the channel, for now
blnCommand = True
End If
End If
End If
End If
'End Command Parse
If blnCommand = False Then
If UCase$(strSpokenText) = strSpokenText Then
'It is an exclemation
Call RaiseAttention(50)
Call HandleStatement(StrSpokenChannel, strSpokenNick, strSpokenText)
Else
'It is a normal statement, no bonus attention
strSpokenText = LCase$(strSpokenText)
Call HandleStatement(StrSpokenChannel, strSpokenNick, strSpokenText)
End If
End If
End Sub
Public Sub HandleStatement(channel As String, _
ByVal nick As String, _
what As String)
'Normal Statement, let's pick a word to respond to
Dim i As Integer, lowpriorargs As Variant, lineargs As Variant, i2 As Integer, ourword As Variant, Worddefs As Variant, wordcount As Variant, intwordcount, Value As Integer, learnargs As Variant
Dim NewLearnedWord As String
Dim FilteredLine As String
Dim intSearch As Long
Dim intSearch2 As Long
Dim DefCount As Integer
Dim NewDefCount As Integer
Dim HighDefCount As Integer
Dim CurrentWord As String
Dim NewWordLen As Integer
Dim HighWordLen As Integer
Dim AltCurrentWord As String
Dim FinalWord As String
Dim OurDef As String
Dim FinalDefCount As Integer
DebugPrint ("STATEMENT RAW DATA " & what)
what = Replace$(what, "!", " ! ")
what = Replace$(what, "?", " ? ")
what = Replace$(what, ".", " . ")
what = Replace$(what, ",", " , ")
what = Replace$(what, "rocko is", nick & " is")
what = Replace$(what, "rocko si", nick & " si")
what = Replace$(what, "rocko", vbNullString)
what = Replace$(what, "Rocko", vbNullString)
For i = 1 To Len(what)
what = Replace$(what, " ", " ")
Next i
DebugPrint ("STATEMENT PARSED DATA " & what)
FilteredLine = vbNullString
'First filter out low priority words
With Form1
.txtParse.text = .txtLowPriority.text
.txtParse.text = Replace$(.txtParse.text, "{LOWPRIORITYWORDS=", vbNullString)
.txtParse.text = Replace$(.txtParse.text, "}", vbNullString)
lowpriorargs = Split(.txtParse.text, " ")
End With 'Form1
lineargs = Split(what, " ")
For i = 0 To UBound(lineargs)
For i2 = 0 To UBound(lowpriorargs)
If lineargs(i) = lowpriorargs(i2) Then
lineargs(i) = vbNullString
End If
Next i2
Next i
For i = 0 To UBound(lineargs)
If LenB(lineargs(i)) = 0 Then
'nothing
Else
FilteredLine = FilteredLine & " " & lineargs(i)
End If
Next i
FilteredLine = Replace$(FilteredLine, " ", " ")
DebugPrint ("FILTERED LINE " & FilteredLine)
'FilteredLine now has no low priority words
'Let's see which remaining word has the most defs
ourword = Split(FilteredLine, " ")
For i = 0 To UBound(ourword)
'cycle through all words said
'and grab the # of defs they have, if any
Dim strOurWord As String
strOurWord = ourword(i)
If Len(GetDefs(strOurWord)) > 0 Then
DefCount = 1
Else
DefCount = 0
End If
If DefCount > 0 Then 'our word has atleast 1 def
'lets find out how many exactly
With Form1
.txtParse.text = GetDefs(strOurWord)
Worddefs = Split(.txtParse.text, "{")
End With 'Form1
DefCount = UBound(Worddefs)
If Len(strOurWord) < 1 Then
'do nothing
Else
Form1.txtDefCount.text = Form1.txtDefCount.text & "{" & strOurWord & "{=" & DefCount & "}}"
End If
Else
If Len(strOurWord) < 1 Then
'do nothing
Else
Form1.txtDefCount.text = Form1.txtDefCount.text & "{" & strOurWord & "{=0}}"
End If
End If
Next i
'we now have a list of words and how many defs they each have
'lets find out which one, if any, has the most defs
HighDefCount = 0
wordcount = Split(Form1.txtDefCount.text, "{=")
intwordcount = UBound(wordcount) - 1
'{you{=0}}{shot{=0}}{who{=0}}{now{=0}}
For i = 0 To intwordcount
With Form1
intSearch = InStr(1, .txtDefCount.text, "{")
intSearch2 = InStr(intSearch, .txtDefCount.text, "}}")
.txtDefCount.SelStart = intSearch - 1
.txtDefCount.SelLength = intSearch2 - intSearch + 2
.txtParse.text = .txtDefCount.SelText
.txtDefCount.SelText = vbNullString
intSearch = InStr(1, .txtParse.text, "{=")
intSearch2 = InStr(intSearch, .txtParse.text, "}}")
.txtParse.SelStart = intSearch + 1
.txtParse.SelLength = intSearch2 - intSearch - 2
NewDefCount = .txtParse.SelText
End With 'Form1
If NewDefCount > HighDefCount Then
HighDefCount = NewDefCount
'{you{=0}}
With Form1
intSearch = InStr(1, .txtParse.text, "{")
intSearch2 = InStr(intSearch, .txtParse.text, "{=")
.txtParse.SelStart = intSearch
.txtParse.SelLength = intSearch2 - intSearch - 1
.txtParse.text = .txtParse.SelText
CurrentWord = .txtParse.text
End With 'Form1
End If
Next i
'CurrentWord is now the word with the most defs
'Now lets find the word with the longest # of chars
ourword = Split(FilteredLine, " ")
HighWordLen = 0
For i = 0 To UBound(ourword)
NewWordLen = Len(ourword(i))
If NewWordLen > HighWordLen Then
HighWordLen = NewWordLen
AltCurrentWord = ourword(i)
Else
End If
Next i
'AltCurrentWord is the longest word in the persons line of text
'flip a coin for final word, either most defs or longest chars
Randomize 'makes it random
'makes a random number, 1 - 100 in Label
' 1
Value = Int(2 * Rnd)
If Value = 0 Then
FinalWord = CurrentWord
Else
If Value = 1 Then
FinalWord = AltCurrentWord
End If
End If
'CurrentWord and AltCurrentWord may be null, re add low priority words...
If Len(CurrentWord) < 1 Then
If Len(AltCurrentWord) < 1 Then
'<:-):WARNING: Short Curcuit: 'If <condition1> And <condition2> Then' expanded
ourword = Split(what, " ")
FinalDefCount = UBound(ourword)
Randomize
Value = Int(FinalDefCount * Rnd)
FinalWord = ourword(Value)
End If
End If
'<:-)Short Circuit inserted this line
'15 percent chance we just pick any word in the line
Randomize
Value = Int(101 * Rnd)
If Value < 15 Then
ourword = Split(what, " ")
FinalDefCount = UBound(ourword)
Randomize
Value = Int(FinalDefCount * Rnd)
FinalWord = ourword(Value)
End If
'FinalWord is now the word we are going to respond to
'SO let's pick a responce...
If Len(GetDefs(FinalWord)) > 0 Then 'word has a def
With Form1
.txtParse.text = GetDefs(FinalWord)
Worddefs = Split(.txtParse.text, "{")
End With 'Form1
FinalDefCount = UBound(Worddefs)
Randomize
Value = Int(FinalDefCount * Rnd)
Value = Value + 1
OurDef = Worddefs(Value)
OurDef = Replace$(OurDef, "}", vbNullString)
DebugPrint "VALUE " & Value & " " & OurDef
If OurDef = "-" Then
'nothing
Else
If IsIn(OurDef, "<") = False And IsIn(OurDef, ">") = False And IsIn(OurDef, "[") = False And IsIn(OurDef, "]") = False Then
SendChat ("PRIVMSG " & channel & " :" & OurDef)
End If
End If
End If
'Ok so we responded to them, let's learn from them!
DebugPrint "WHAT = " & what
learnargs = Split(what, " ")
FinalDefCount = UBound(learnargs)
If FinalDefCount > 0 Then 'has more than just one word
For i = 0 To FinalDefCount
NewLearnedWord = learnargs(i)
Call AddDef(NewLearnedWord, what) 'learn word
Next i
End If
End Sub
Public Sub SendChat(what As String)
Dim Value As Integer
Dim RandomNumber As Integer
what = Replace(what, " . ", ".")
what = Replace(what, " , ", ",")
what = Replace(what, " ? ", "?")
what = Replace(what, " ! ", "!")
If Form1.chckLearn.Value = 0 Then
If AttentionLevel < 1 Then
RandomNumber = 0
Else
If AttentionLevel < 26 Then
RandomNumber = 5 '5 percent chance you have my attention
Else
If AttentionLevel < 51 Then
RandomNumber = 10 '10 percent
Else
If AttentionLevel < 101 Then
RandomNumber = 15 'etc...
Else
If AttentionLevel < 151 Then
RandomNumber = 20
Else
If AttentionLevel < 201 Then
RandomNumber = 30
Else
If AttentionLevel < 301 Then
RandomNumber = 50
Else
If AttentionLevel < 401 Then
RandomNumber = 60
Else
If AttentionLevel < 451 Then
RandomNumber = 80
Else
If AttentionLevel > 451 Then
RandomNumber = 90
Else
If AttentionLevel > 499 Then
RandomNumber = 101 'you have my attention and i'm going to respond
Else
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
If AttentionLevel = 500 Then
Send (what)
AttentionDecrease (15) 'said something so not as interested
Else
Randomize 'makes it random
'makes a random number, 1 - 100 in Label
' 1
Value = Int(100 * Rnd)
If Value < RandomNumber And Value > -1 Then
Send (what)
AttentionDecrease (15) 'said something so not as interested
End If
End If
End If
End Sub
Public Sub ReportStatus(channel As String)
On Error Resume Next
Dim myconn As New ADODB.Connection
Dim myrs As New Recordset
Dim mySQL As String
Dim myrows As Long
Dim myData As String
myconn.Open "DSN=rocko"
mySQL = "SELECT * FROM words"
myrs.Source = mySQL
Set myrs.ActiveConnection = myconn
myrs.CursorLocation = adUseClient
myrs.Open
myrows = myrs.RecordCount
myData = myrs.GetString(, , "{-", "{-")
myData = Replace(myData, strWord & "{-", "")
Send ("PRIVMSG " & strChannel & " :I am Rocko, a learning computer. My Neural Network is currently consuming " & Len(myData) & " bytes of data. My SQL database is referencing " & myrs.RecordCount & " words. I was created by MikeJ.")
myrs.Close
myconn.Close
End Sub
Public Function IsIn(ByVal main, _
ByVal what) As Boolean
Dim intSearch As Integer
On Error Resume Next
intSearch = InStr(1, main, what)
If intSearch <> 0 Then
IsIn = True
Else
IsIn = False
End If
End Function
Public Sub RaiseAttention(ByVal HowMuch As Integer)
AttentionLevel = AttentionLevel + HowMuch
If AttentionLevel > 500 Then
AttentionLevel = 500
End If
Form1.lblAttention.Caption = AttentionLevel
End Sub
Public Sub AttentionDecrease(ByVal HowMuch As Integer)
If AttentionLevel < 0 Then
'do nothing
Else
AttentionLevel = AttentionLevel - HowMuch
If AttentionLevel < 0 Then
AttentionLevel = 0
End If
Form1.lblAttention.Caption = AttentionLevel
End If
End Sub
Public Function GetDefs(strWord As String) As String
On Error Resume Next
Dim myconn As New ADODB.Connection
Dim myrs As New Recordset
Dim mySQL As String
Dim myrows As Long
Dim myData As String
myconn.Open "DSN=rocko"
mySQL = "SELECT * FROM words WHERE word='" & strWord & "'"
myrs.Source = mySQL
Set myrs.ActiveConnection = myconn
myrs.CursorLocation = adUseClient
myrs.Open
myrows = myrs.RecordCount
myData = myrs.GetString(, , "{-", "{-")
myData = Left(myData, Len(myData) - 2)
myData = Replace(myData, strWord & "{-", "")
GetDefs = myData
myrs.Close
myconn.Close
End Function
Public Sub AddDef(strWord As String, strDef As String)
On Error Resume Next
Dim myconn As New ADODB.Connection
Dim myrs As New Recordset
Dim mySQL As String
Dim myrows As Long
Dim myData As String
Dim FinalDefs As String
Dim blnBUG As Boolean
If strWord = " " Or strWord = vbNullString Then
'nothing
Else
'me','{molest me }i think david would kick me out}{only if you give me head}{and let me finish on your face}{give me my loan right now}{u all look older than me lol}{and u fly back on the same plane as me bug :d}{hello do u want me to keep u warms}{where r u making me tea}{he rox me}{mary me}{me 2 o . k . }{hay me too 10]}{someone plz write me paper about john adams pls}{also , pay pal me 50 bux}{tell me y o y dimmu borgir is so gr8}{recently me and this girl up the street (shes around 17 , me 16) were up the street and we were jumping on her trampoline that is huge . well i accidentally fell on her and my hand landed on her tit . . . i just laid there all embarrassed and then she looked at me then at my hand and went "woah" . her tits are pretty huge so it felt interesting . . . it was only the second time i ever squeezed a girls boobs . }{nekton answer me plz}{pika go give shep a goodnight kiss n snuggle for me}{dont go witout me}{if ne of u were here earlier someone called me michael when i sed some of
'the younger otfers names}{only if you pay me }{will you make love to me ? }{does that make me gay ? }{fap me john stamos}{fap me john stamos}{fap me}{molest me }'
DebugPrint "LEARNING WORD " & strWord & " WITH DEF " & strDef
Form1.txtParse.text = GetDefs(strWord)
Form1.txtParse.text = Replace(Form1.txtParse.text, "{" & strDef & "}", "")
Form1.txtParse.text = Form1.txtParse.text & "{" & strDef & "}"
FinalDefs = Form1.txtParse.text
myconn.Open "DSN=rocko"
mySQL = "SELECT * FROM words WHERE word='" & strWord & "'"
myrs.Source = mySQL
Set myrs.ActiveConnection = myconn
myrs.CursorLocation = adUseClient
myrs.Open
myrows = myrs.RecordCount
myData = myrs.GetString(, , "{-", "{-")
myData = Left(myData, Len(myData) - 2)
myData = Replace(myData, strWord & "{-", "")
Form1.txtParse.text = FinalDefs
intSearch = InStr(1, Form1.txtParse.text, "{-")
If intSearch <> 0 Then 'bug
blnBUG = True
DebugPrint "FIXED BUG"
Form1.txtParse.SelStart = 0
Form1.txtParse.SelLength = intSearch + 1
Form1.txtParse.SelText = ""
FinalDefs = Form1.txtParse.text
End If
If Len(FinalDefs) > 1200 Then
blnBUG = True
DebugPrint "FIXING LENGTH"
Form1.txtParse.text = FinalDefs
intSearch = InStr(1, Form1.txtParse.text, "}")
Form1.txtParse.SelStart = 0
Form1.txtParse.SelLength = intSearch
Form1.txtParse.SelText = ""
FinalDefs = Form1.txtParse.text
End If
If Len(myData) > 0 Then 'defs exist
mySQL = "UPDATE words SET word = '" & strWord & "',defs = '" & FinalDefs & "' WHERE word = '" & strWord & "'"
myrs.Source = mySQL
myconn.Execute mySQL
Set myrs.ActiveConnection = myconn
myrs.CursorLocation = adUseClient
myrs.Open
Else 'no def exist
mySQL = "INSERT INTO words VALUES ('" & strWord & "','" & FinalDefs & "')"
myrs.Source = mySQL
myconn.Execute mySQL
Set myrs.ActiveConnection = myconn
myrs.CursorLocation = adUseClient
myrs.Open
End If
DebugPrint "FINAL DEFs = " & FinalDefs
myrs.Close
myconn.Close
If blnBUG = True Then
'Call File_Save("C:\rocko\bugs\bug" & Len(Form1.txtDebug.text) & ".txt", Form1.txtDebug.text)
Form1.txtDebug.text = ""
End If
End If
End Sub
Public Sub Send(ByVal strData As String)
On Error Resume Next
Form1.Winsock1.SendData strData & vbNewLine
End Sub
Public Function File_Save(File As String, text As String)
On Error Resume Next
'Saves text to a file
Dim Fle As Integer
Fle% = FreeFile()
Open File$ For Output As Fle%
Print #Fle%, text$
Close #Fle%
End Function
When programming VB you are allowed to use the worst coding conventions and unstructered syntax possible LOL
:cool:
