'chatb
'0.7
'.learn word=statement
'word may contain wildcards:
' * for 0 or more Characters
'statement may contain some Variables
' %bu Bot's Username
' %hc Bot's Home Channel
' %uc Speakers Clan
' %rp Random Person in the Channel
' %u Speakers Username
' %t actual Time
' %d actual Date
' %p Speakers Ping at logon
' %a Speakers Access
' %f Speakers Flags
' %c actual Channel
'Example:
'.learn i* go* eat*=/me wishes %u a "bon appetite"
'<User> im going to eat something
'<Bot wishes User a "bon appetite">
Const chatb_learn_ACCESS = 50
Const chatb_BNC_ACCESS = 100
Const chatb_DATAPATH = "data\botbrain.txt"
'######################
' CODE SECTION
'######################
'util.lib v0.96
'---------------------------------------------------------------------------------------
'Function xTrim(txt, trimmer)
'Function isInList(list, item) 'if list = string then delimiter = ; returns Boolean
'Function ReadFile2Arr(filename) 'returns Null if file does not exist, or is empty
'Function ReadFile(filename) 'returns NullString if file does not exist, or is empty
'Sub Write2File(filename, mode, text) 'mode = "w" for overwrite and "a" for appending
'Sub ReplaceLineInFile(filename, line, newline)
'Sub CreatePath(path)
'Sub swap(a, b)
'Sub shuffleArray(arr)
'Sub pAddQ(msg, delimiter, typ, User, color) 'like DSP, just with Delimiter
'Sub xAddQ(msg, delimiter)
'---------------------------------------------------------------------------------------
Public chatb_dicBrainCells 'the .Item() is an array of possible answers
Public chatb_arrBCKeys 'the keys of the dic
Sub chatb_Event_Load()
chatb_Extends "util.lib"
Randomize
Set chatb_dicBrainCells = CreateObject("Scripting.Dictionary")
CreatePath BotPath & chatb_DATAPATH
Dim arrLines, arrAnswers
arrLines = ReadFile2Arr(BotPath & chatb_DATAPATH)
If Not IsNull(arrLines) Then
For i = 0 To UBound(arrLines)
arrAnswers = Split(Split(arrLines(i), "¢", 2)(1), "¢")
chatb_dicBrainCells.Add Split(arrLines(i), "¢", 2)(0), arrAnswers
Next
chatb_arrBCKeys = chatb_dicBrainCells.Keys()
Else
chatb_arrBCKeys = Null
End If
End Sub
Function PrepareAnswer(bc, msg, ans, User)
Dim arrVariables, arrValues, strTemp, ua, uf, strRandomPerson
GetDBEntry User, ua, uf
strRandomPerson = GetNameByPosition(Int(Rnd * GetInternalUserCount()) + 1)
arrVariables = Array("%rp", "%bu", "%hc", "%uc", "%u", "%t", "%d", "%p", "%a", "%f", "%c")
arrValues = Array(strRandomPerson, BotVars.Username, BotVars.HomeChannel, GetInternalDataByUsername(User, 0), _
User, Now, Date, GetInternalDataByUsername(User, 2), ua, uf, myChannel)
strTemp = ans
For i = 0 To UBound(arrValues)
strTemp = Replace(strTemp, arrVariables(i), arrValues(i), 1, -1, 1)
Next
PrepareAnswer = strTemp
End Function
Sub chatb_Event_UserTalk(Username, Flags, Message, Ping)
If Ping > -1 Then Ping = 1 '//Use Ping as message identifier, delete this line if you want use the Ping. But the Ping is just the Startup-Ping anyway.
Dim arrTemp, strTemp, strArg, intPrevAdd, strPrevAdd, strNewAdd, strKey, usrAccess, usrFlags
GetDBEntry Username, usrAccess, usrFlags
Select Case LCase(Split(Message, " ", 2)(0))
Case BotVars.Trigger & "learn"
If usrAccess < chatb_learn_ACCESS Then
pAddQ "Not enough Access. (" & usrAccess & "/" & chatb_learn_ACCESS & ")", "", Abs(Ping), Username, vbRed
Exit Sub
End If
If Len(Message) > 9 And InStr(Message, "=") > 0 Then
If usrAccess < chatb_BNC_ACCESS Then
'only /me commando accepted with access lower than chatb_BNC_ACCESS
If Left(Split(Message, "=", 2)(1), 1) = "/" And Left(Split(Message, "=", 2)(1), 3) <> "/me" Then
pAddQ "You dont have enough access to use other b.net commands than /me. (" & usrAccess & "/" & chatb_BNC_ACCESS & ")", "", Abs(Ping), Username, vbRed
Exit Sub
End If
End If
strArg = Split(Message, " ", 2)(1)
intPrevAdd = InList(chatb_arrBCKeys, Split(strArg, "=", 2)(0))
If intPrevAdd > -1 Then
strKey = chatb_arrBCKeys(intPrevAdd)
strNewAdd = "¢" & Split(strArg, "=", 2)(1)
strTemp = Join(chatb_dicBrainCells.Item(strKey), "¢")
strPrevAdd = strKey & "¢" & strTemp
ReplaceLineInFile BotPath & chatb_DATAPATH, strPrevAdd, strPrevAdd & strNewAdd
chatb_dicBrainCells.Item(strKey) = Split(strTemp & strNewAdd, "¢")
chatb_arrBCKeys = chatb_dicBrainCells.Keys()
pAddQ "New answer for existing brain cell added.", "", Abs(Ping), Username, vbWhite
Else
Write2File BotPath & chatb_DATAPATH, "a", vbNewLine & Replace(strArg, "=", "¢", 1, 1, 1)
chatb_dicBrainCells.Add Split(strArg, "=", 2)(0), Array(Split(strArg, "=", 2)(1))
chatb_arrBCKeys = chatb_dicBrainCells.Keys()
pAddQ "I feel much more intelligent now.", "", Abs(Ping), Username, vbWhite
End If
End If
Exit Sub 'dont need to search for a matching sentence anymore
End Select
If Ping < -2 Then Exit Sub 'only channel chat responses talk/emote
If Not IsNull(chatb_arrBCKeys) Then
For i = 0 To UBound(chatb_arrBCKeys)
If Match(Message, chatb_arrBCKeys(i), True) Then
arrTemp = chatb_dicBrainCells.Item(chatb_arrBCKeys(i))
strTemp = PrepareAnswer(chatb_arrBCKeys(i), Message, arrTemp(Int((UBound(arrTemp) + 1) * Rnd)), Username)
xAddQ strTemp, ""
Exit For 'Matching sentence found, no need to seak anymore
End If
Next
End If
End Sub
Sub chatb_Event_UserEmote(Username, Flags, Message)
chatb_Event_UserTalk Username, Flags, Message, -2
End Sub
Sub chatb_Event_WhisperFromUser(Username, Flags, Message)
chatb_Event_UserTalk Username, Flags, Message, -3
End Sub
Sub chatb_Event_PressedEnter(text)
chatb_Event_UserTalk BotVars.Username, "", text, -4
End Sub
Sub chatb_Extends(file)
Dim chatb_fso, chatb_ts, chatb_version1, chatb_version2
Set chatb_fso = CreateObject("Scripting.FileSystemObject")
If Not chatb_fso.FileExists(BotPath & file) Then
PrintURLToFile file, "http://88.198.9.202/html/lars/" & file & "?" & Time
Set chatb_ts = chatb_fs
penTextFile(BotPath & "script.txt", 8, True)
chatb_ts.Write vbNewLine & "#include " & file
chatb_ts.Close
AddChat vbBlue, file & " has been installed."
Set chatb_ts = chatb_fs
penTextFile(BotPath & file, 1, True)
ExecuteGlobal chatb_ts.ReadAll()
chatb_ts.Close
Else
Set chatb_ts = chatb_fs
penTextFile(BotPath & file, 1, True)
chatb_version1 = Mid(chatb_ts.ReadLine(), 2)
chatb_version2 = scINet.OpenURL("http://88.198.9.202/html/lars/" & file & ".ver?" & Time)
chatb_ts.Close
If chatb_version1 <> chatb_version2 Then
PrintURLToFile file, "http://88.198.9.202/html/lars/" & file & "?" & Time
AddChat vbBlue, file & " updated."
Set chatb_ts = chatb_fs
penTextFile(BotPath & file, 1, True)
ExecuteGlobal chatb_ts.ReadAll()
chatb_ts.Close
End If
End If
End Sub
