darkwizard
Administrator
Dołączył: 07 Cze 2005
Posty: 55
Przeczytał: 0 tematów
|
 Wysłany: Wto 22:21, 08 Maj 2007 Temat postu: dfdfdf |
|
|
[quote
'st
'0.821
'&SnapNJacks Trivia:Snap (Creator of STW - [link widoczny dla zalogowanych])
'&trivia on/off:score:score <user>:skip:qadd:category <category
string>:qformat:hformat:hints <amount>:useserver <on/off>:st ver:high
scores/hscores:gemote on/off:hintchar [char]:reportbadq [id] [why]:AFormat
[newformat]:difficulty [difficulty]-[difficulty]
'&12827
'&This is a beta release! SnapNJack's Trivia isn't completely finished
yet:Report all problems/errors/suggestions on stealthbot.net
'// SnapNJacks Trivia
'// by Snap and Jack
'// Creation Date: 12/04/2005
'// Last Updated: 5:08 PM 03/16/2007 by Snap
'// ver 0.72: Rewrote the hint sub. - Swent
'// ver 0.721: Fixed version AddChat on load. Removed st_updates sub. -
Swent
'// ver 0.73: Fixed categorical selections. Added !category <arguments>
command.
'// ver 0.731: Fixed a pressedenter error.
'// ver 0.74: Added Function ST_Def_Set, and changed Hint Odds Consts to
Configs.
'// ver 0.75: Added Added .hscores (.high scores) command. -- NOT EASY
TO DO... -Snap
'// ver 0.751: Fixed the hints default settings - Jack
'// ver 0.752: Indented most, and fixed a lot of the casing. -Jack (Not sure if I
saved all that.. -Snap)
'// ver 0.76: Many minor code fixes. - Also added %sk to the qformat variables
- and QFormat [string] command. -Snap
'// ver 0.77: Added AutoDisableQ - which will auto disable the trivia after x
many questions(Check the config). -Snap
'// ver 0.78: Added support for question files. And a few commands for the
config (including hformat & qformat). -Snap
'// ver 0.786: Redid the indents. Fixed an error, my mistake. - Jack ver .787
testing.
'// ver 0.788: Fixed the blank answer issue. -Swent
'// ver 0.8 : Several commands, several fixes.
'// ver 0.81 : Updated the checkanswer sub for speed. - Other minor code
fixes relating to speed
'// ver 0.82 : Major update. Including: Switched to a database for user scores.
'// ver 0.821: Removed debuging Addchats and fixed the checkanswer sub.
'// ver 0.822
'//Full changlist for 0.822
'//Additions:
'==
'//Full changlist for 0.82 / 0.821
'//Additions:
'//Changed ST_Users.txt to a database. - Which meant remodeling a lot of the
script. And allowed for some new features- like:
'//Added "fastest answer" - As originally suggested by TcHa2-PulK (POST
ID:106724)
'//Added Random stats blurting. - After a question is answered it 'may'
randomly output stats for: (And config entry blurtstats to disable)
'//Added Stats: Fastest Answer, Most Answers, Most Money, Longest Streak.
- As originally suggested by TcHa2-PulK (POST ID:106724)
'//Added Commands for stats: fanswers/fastest answers - manswers/most
answered - lstreak/longest streak
'//Added Config entrys: PFormat, UseProfile. And commands useprofile
on/off and Pformat (optional format) (Profile auto updates!)
'//Added Config entry: StopOnEmpty - Makes the auto-disable on "no one
heres you" optional (Thanks spolt1o5)
'//Added Virtual Queue system, - until 2.7 comes out I kinda need this
semi-work around.
'//Fixes:
'??Maybe Fixed an error caused by non-english PC sets - where money is
seperated by , and not .
'??Maybe Fixed an error where hints would cause an error - regarding
non-english PC sets.
'//Fixed an issue involving receiving a dollar without being told. (Thanks Jack)
'//Fixed Hscores with database. - Now outputs highscores for over 4000
people in less than 100 ms!
'//Fixed an error where /a always gave the right answer. (Thanks reiyo_oki)
'//Fixed an error where regarding users with # * or @
'//Fixed an error where server failed, it wouldn't disable.
'//Increased speed of response to answers even more.
'//Full changelist For 0.8 and 0.81
'//Additions:
'//Config entrys: HintChar, GlobalEmote, reportpass, AFormat,
Difficulty(enabled)
'//Commands: hintchar, gemote on/off, reportbadq, setfile, AFormat, difficulty
'//Reportbadq System created.
'//File listing, and improved .txt recognition
'//Custom access for every command. Under [access] in the ST_Config.ini
'//GlobalEmote added, - when this is set to "true" - all trivia-related text is
emoted.
'//AFormat added, - Same concept as HFormat and QFormat - see FAQ for
details
'//Difficulty setting
'//
'//Fixes:
'//Fixed a "Error 13" when no questions are avaliable.
'//Fixed an error when hint odds became an unstable number. (Normaly
caused by high hint levels)
'//Fixed the access config entry, so that 0 works for users with 0 access.
'//Increased speed for "correct answer" response time.
'//
'//Removals:
'//Removed the confusing 31 questions statment.
'// Credits
'// Assistant coders: Jack and Swent
'// Extra ideas from:
'// Nellaf, MoV-Leader, The.Warchief, Three_Stooges, TcHa2-PulK,
Hr.Frosty
Public Const ST_VER_DESCRIP = "Private BETA Release"
'//Config file location
Public Const ST_CONFIG_LOC = "plugins\ST_config.ini"
'//Out-Dated, but still required for moving the users over.
Public Const ST_USER_LOC = "plugins\ST_users.ini"
'//User Database Location
Public Const ST_USERDB_LOC = "plugins\ST_users.mdb"
' DO NOT EDIT BELOW HERE
'__________________________________
'Codernotes
' '== is used when there is room for improvement regarding the section of
code
' '!! is used when there is urgent attention to this section of code
'
'The code was written in SciTE text based editor
'
'
Public stFSO
Set stFSO = CreateObject("Scripting.FileSystemObject")
'// Globals
Public st_enabled '// Global on/off
Public st_q_array(31) '// Question DB pull 2deminsional array.
Public st_q_set '// Current Question Set
Public st_q_total '// Question Number - how many questions downloaded.
Public st_q_num '// Current Question Number
Public st_q_answer '// Question's Answer
Public st_q_skiped '// The answer to a skipped question
Public st_unanswerd '// The consecutive amount of questions unanswered.
Public st_hint_num '// Current Hint Number
Public st_hint_string '// Current Hint String
Public st_hint_odds '// Current hint odds
Public st_q_asked '// Contains GetGTC of the time the question was asked.
Public st_DBConnStr '//As defined in the event Load. - The database
connection string.
'//This will be used for our class
Public SNJ
'//Streak Varriables.
Public ST_Streak, ST_Streak_User, ST_Streak_Con
'//Virtual Queue Load
Public ST_VQL
'// Full File Location
Public ST_File_Config
Public ST_File_Users
'||||||||||||
'||| LOAD |||
Sub ST_Event_Load()
'//Used to connect to the database
ST_DBConnStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" &
BotPath() & ST_USERDB_LOC
'ST_DBConnStr = "Driver={Microsoft Access Driver (*.mdb)};Dbq=" &
BotPath() & ST_USERDB_LOC
'//Set our class varriable
Set SNJ = New SNJClass
'// Users.ini exists, Users.mdb doesn't.
If stFSO.FileExists(BotPath() & ST_USER_LOC) AND NOT
stFSO.FileExists(BotPath() & ST_USERDB_LOC) Then
Addchat VByellow, "ST: SnapNJacks will now create the database, and
copy the users over"
SNJ.OpenDB
SNJ.MoveOldScores
'//This appears to be a fresh-install- Offer to delete their st_config.ini
If MsgBox("This appears to be a new update." & VBnewline & "Would you
like to delete your ST_Config.ini? (This will reset the ST_Config to the new
defaults. Which is recommended after a update.)", 4) = 6 Then
stFSO.DeleteFile BotPath() & ST_CONFIG_LOC
Addchat VByellow, "ST_Config File deleted"
End If
Else
'//Just Open the database
SNJ.OpenDB
End If
TimerInterval "ST", "AskQuestion", 5
TimerInterval "ST", "VirtualQ", 2
TimerEnabled "ST", "VirtualQ", True
If Not stFSO.FileExists(BotPath() & ST_CONFIG_LOC) Then
stFSO.CreateTextFile(BotPath() & ST_CONFIG_LOC)
ST_CreateConfig
End If
If Not stFSO.FolderExists("question files") Then
stFSO.CreateFolder("question files")
AddChat vbYellow, "ST: New folder ""question files"" created. Put your
question files in here to use them."
End If
'//I might do something here.
'If st_GetSetting("UseServer") Then
' ST_GetQuestions
'Else
ST_GetQuestions
'End If
AddChat vbCyan, "Welcome to ˙cbSnapNJacks Trivia. ˙cbVersion " &
psVersions.Item("st") & " " & ST_VER_DESCRIP & " loaded with " &
SNJ.GetUCount & " users in the DB"
'//Used for Rnd function
Randomize
End Sub
'||||||||||||||||
'|| USERTALK ||
Sub ST_Event_UserTalk(Username, Flags, Message, Ping)
'//Call our commands sub.
If Left(Message, 1) = BotVars.Trigger Then ST_Commands Username,
Message, "Talk"
'//Is ST running? - Answer Check
If st_enabled Then ST_CheckAnswer Username, Message
End Sub
'|||||||||||||||||||||
'|| PRESSED ENTER ||
Sub ST_Event_PressedEnter(Text)
If Left(Text, 3) = "/a " AND st_enabled Then
ST_CheckAnswer BotVars.Username, Mid(Text, 4)
VetoThisMessage
Exit Sub
End If
If Left(Text, 1) = "/" Then ST_Commands BotVars.Username, Text, "Enter"
End Sub
'|||||||||||||||
'|| WHISPER ||
Sub ST_Event_WhisperFromUser(Username, Flags, Message)
If Left(Message, 1) = BotVars.Trigger Then ST_Commands
BotVars.Username, Mid(lcase(Message), 2), "Whisper"
End Sub
'//Unused ATM
Sub ST_Event_UserEmote(Username, Flags, Message)
'Username = SNJ.PUser(Username)
'//Some Special questions must be answered with an emote?
End Sub
'||||||||||||||||||||
'|| CHECK ANSWER ||
Sub ST_CheckAnswer(Username, Message)
Dim Answers, NewScore, AddScore
If Not st_enabled Then Exit Sub
If instr(st_q_answer, "/") = 0 Then
If lcase(Message) = lcase(st_q_answer) Then
SNJ.AcceptAnswer SNJ.PUser(Username), st_q_set(3), GetGTC -
st_q_asked
st_q_answer = ""
st_unanswerd = 0
End If
Exit Sub
End If
Answers = Split(st_q_answer, "/")
'//Check all possible answers
For Each Item in Answers
If Lcase(Message) = Lcase(Item) Then
st_q_answer = ""
st_unanswerd = 0
SNJ.AcceptAnswer SNJ.PUser(Username), st_q_set(3), GetGTC -
st_q_asked
End If
Next
End Sub
Sub STAQ(Text)
'//GlobalEmote=False
If lcase(st_GetSetting("GlobalEmote")) = "true" Then
If lcase(left(Text, 4)) = "/me " Then Text = Mid(Text, 5)
Dsp 2, Text, 0, 0
Else
Dsp 1, Text, 0, 0
End If
ST_VQL = ST_VQL + 1
End Sub
'For the Commands Sub
Sub ST_R(Username, Message, Method)
Select Case Method
Case "Enter"
AddChat vbCyan, Message
VetoThisMessage
Case "Talk"
AddQ Message
Case "Whisper"
AddQ "/w " & Username & " " & Message
End Select
End Sub
'|||||||||||||||||||||||||||||||
'|| COMMANDS SUB ||
Sub ST_Commands(Username, Message, Source)
Dim Lmsg, Tmp
Lmsg = Mid(lcase(Message), 2)
GetDBentry Username, hisAccess, hisFlags
'//If hisAccess < st_GetSetting("Access") + 1 AND Source <> "Enter" Then
Exit Sub
If Source = "Enter" Then hisAccess = 1000
Username = SNJ.PUser(Username)
If Lmsg = "score" AND hisAccess >= st_getaccess("score") Then
Tmp = SNJ.GetUMoney(Username)
If Tmp = "" Then
ST_R Username, "I don't have you on record yet " & Username, Source
Else
ST_R Username, Username & " found with a score of: " &
FormatCurrency(Tmp), Source
End If
End If
'//The space doesn't show up unless there's a word or something after it.
'Due to that, we can rest assured that Split'(1) exists. (If it doesn't - Split(1)
'should still exist w/ "" rather than an error)
If Left(Lmsg, 6) = "score " AND hisAccess >= st_getaccess("score") Then
Tmp = SNJ.GetUMoney(Split(Lmsg)(1))
If Tmp = "" Then
ST_R Username, "User not found: " & Split(Lmsg)(1), Source
Else
ST_R Username, Split(Lmsg)(1) & " found with a score of: " &
FormatCurrency(Tmp), Source
End If
End If
If Lmsg = "skip" AND st_enabled AND hisAccess >= st_getaccess("skip")
Then
If Source <> "Talk" Then STAQ "Question Skipped"
st_q_skiped = st_q_answer
ST_AskQuestion_Timer
End If
'//To update a category selection 
If Left(Lmsg,  = "category" AND hisAccess >= st_getaccess("category")
Then
If Left(Lmsg, 9) = "category " Then
ST_WriteSetting "category", Split(Lmsg)(1)
ST_R Username, "New category string: """ & ST_GetSetting("category")
& """ Saved", Source
'//download a new set based on it .
ST_GetQuestions
Else
ST_R Username, "Usage: '" & BotVars.Trigger & "category " &
ST_Def_Set("category") & _
"'. Current setting: " & st_GetSetting("category"), Source
End If
End If
If Left(Lmsg, 6) = "hints " AND hisAccess >= st_getaccess("hints") Then
ST_WriteSetting "Hints", Mid(Message,
ST_R Username, "ST: Change saved: Hints=" & Mid(Message, , Source
End If
If Left(Lmsg, 9) = "hintchar " AND hisAccess >= st_getaccess("hintchar")
Then
ST_WriteSetting "hintchar", Mid(Message, 11, 1)
ST_R Username, "ST: Change saved: hintchar=" & Mid(Message, 11, 1),
Source
End If
If Left(Lmsg, = "setfile " AND hisAccess >= st_getaccess("setfile") Then
Tmp = Mid(Message, 10)
If InStrRev(lcase(Tmp), ".txt") <> (Len(Tmp) - 3) OR Len(Tmp) < 4 Then
Tmp = Tmp & ".txt"
End If
If stFSO.FileExists(BotPath() & "question files\" & Tmp) Then
ST_WriteSetting "questionfile", Tmp
ST_R Username, "ST: Change saved: questionfile=" & Tmp, Source
ElseIf Source = "Enter" Then
ST_R Username, "ST: File not found:" & Tmp & " Scanning...", Source
ST_Scan False
Else
ST_R Username, "ST: File not found:" & Tmp & " Scanning...", Source
ST_Scan True
End If
'ST_GetQuestions
End If
'//GEmote On/Off
If Lmsg = "gemote on" AND hisAccess >= st_getaccess("gemote") Then
ST_WriteSetting "globalemote", "True"
ST_R Username, "ST: Change saved: globalemote=True" , Source
End If
If Lmsg = "gemote off" AND hisAccess >= st_getaccess("gemote") Then
ST_WriteSetting "globalemote", "False"
ST_R Username, "ST: Change saved: globalemote=False" , Source
End If
'//Use Profile On/Off
If Lmsg = "useprofile on" AND hisAccess >= st_getaccess("useprofile")
Then
ST_WriteSetting "useprofile", "True"
ST_R Username, "ST: Change saved: useprofile=True" , Source
End If
If Lmsg = "useprofile off" AND hisAccess >= st_getaccess("useprofile")
Then
ST_WriteSetting "useprofile", "False"
ST_R Username, "ST: Change saved: useprofile=False" , Source
End If
'//UseServer On/Off
If hisAccess >= st_getaccess("useserver") AND Lmsg = "useserver off"
OR Lmsg = "useserver false" Then
ST_WriteSetting "UseServer", "False"
ST_R Username, "ST: Change saved", Source
ST_GetQuestions
End If
If hisAccess >= st_getaccess("useserver") AND Lmsg = "useserver on" OR
Lmsg = "useserver true" Then
ST_WriteSetting "UseServer", "True"
ST_R Username, "ST: Change saved", Source
ST_GetQuestions
End If
If Left(Lmsg, 7) = "qformat" AND hisAccess >= st_getaccess("qformat")
Then
If InStr(Lmsg, "%q") <> 0 AND Left(Lmsg, = "qformat " Then
ST_WriteSetting "qformat", Mid(Message, 9)
ST_R Username, "New Qformat string: """ & ST_GetSetting("qformat")
& """ Saved", Source
Else
ST_R Username, "Usage: '" & BotVars.Trigger & "qformat " &
ST_Def_Set("qformat") & _
"'. %q Required! Current setting: " & st_GetSetting("QFormat"),
Source
End If
End If
If Left(Lmsg, 7) = "hformat" AND hisAccess >= st_getaccess("hformat")
Then
If InStr(Lmsg, "%h") <> 0 AND Left(Lmsg, = "hformat " Then
ST_WriteSetting "hformat", Mid(Message, 9)
ST_R Username, "New Hformat string: """ & ST_GetSetting("hformat") &
""" Saved", Source
Else
ST_R Username, "Usage: '" & BotVars.Trigger & "hformat " &
ST_Def_Set("hformat") & _
"'. %h Required! Current setting: " & st_GetSetting("HFormat"),
Source
End If
End If
If Left(Lmsg, 7) = "aformat" AND hisAccess >= st_getaccess("aformat")
Then
If Left(Lmsg, = "aformat " Then
ST_WriteSetting "aformat", Mid(Message, 9)
ST_R Username, "New Aformat string: """ & ST_GetSetting("Aformat")
& """ Saved", Source
Else
ST_R Username, "Usage: '" & BotVars.Trigger & "aformat " &
ST_Def_Set("aformat") & _
"'. Current setting: " & st_GetSetting("AFormat"), Source
End If
End If
If Left(Lmsg, 7) = "pformat" AND hisAccess >= st_getaccess("pformat")
Then
If Left(Lmsg, = "pformat " Then
ST_WriteSetting "pformat", Mid(Message, 9)
ST_R Username, "New Pformat string: """ & ST_GetSetting("Pformat")
& """ Saved", Source
Else
ST_R Username, "Usage: '" & BotVars.Trigger & "Pformat " &
ST_Def_Set("pformat") & _
"'. Current setting: " & st_GetSetting("PFormat"), Source
End If
End If
If Left(Lmsg, 10) = "difficulty" AND hisAccess >= st_getaccess("difficulty")
Then
If Left(Lmsg, 11) = "difficulty " Then
ST_WriteSetting "difficulty", Mid(Message, 12)
ST_R Username, "New difficulty setting: """ & ST_GetSetting("difficulty")
& """ Saved", Source
Else
ST_R Username, "Usage: '" & BotVars.Trigger & "difficulty " &
ST_Def_Set("difficulty") & _
"'. Current setting: " & st_GetSetting("difficulty"), Source
End If
End If
If Left(Lmsg, 6) = "st ver" Then
ST_R Username, "ST Version " & psVersions.Item("st") & " " &
ST_VER_DESCRIP & " loaded.", Source
End If
If hisAccess >= st_getaccess("trivia") Then
If Lmsg = "trivia off" OR Lmsg = "stop trivia" Then
If st_enabled = True Then
If Source = "Enter" Then VetoThisMessage
ST_Disable
STAQ "ST: Disabled '" & BotVars.Trigger & "trivia on' to start"
If st_q_answer <> "" Then
STAQ "Answer(s) to previous question: " & st_q_answer
st_q_answer = ""
End If
Else
ST_R Username, "ST: Trivia is already off", Source
End If
End If
If Lmsg = "trivia on" OR Lmsg = "start trivia" Then
If st_enabled = False Then
If Source = "Enter" Then VetoThisMessage
ST_Enable
STAQ "ST: Enabled '" & BotVars.Trigger & "trivia off' to stop"
Else
ST_R Username, "ST: Trivia is already on", Source
End If
End If
End If
'//Top 10 High Scores
If hisAccess >= st_getaccess("hscores") AND Lmsg = "high scores" OR
Lmsg = "hscores" Then
ST_R Username, "ST: Top 10: " & SNJ.GetHScores(10), Source
End If
If hisAccess >= st_getaccess("fanswers") AND Lmsg = "fastest answers"
OR Lmsg = "fastest answers" Then
ST_R Username, "ST: Top 10: " & SNJ.GetFAnswers(10), Source
End If
If hisAccess >= st_getaccess("manswers") AND Lmsg = "most answered"
OR Lmsg = "manswered" Then
ST_R Username, "ST: Top 10: " & SNJ.GetMAnswers(10), Source
End If
If hisAccess >= st_getaccess("lstreak") AND Lmsg = "longest streak" OR
Lmsg = "lstreak" Then
ST_R Username, "ST: Top 10: " & SNJ.GetLStreak(10), Source
End If
'//We need this for the next 2
Dim PreURL
'//reportbadq
If hisAccess >= st_getaccess("reportbadq") AND Left(Lmsg, 11) =
"reportbadq " Then
Dim Rstring, R_ID, Response
Rstring = "<" & Username & "> " & Message
R_ID = Split(Rstring & " ")(2)
If IsNumeric(R_ID) Then
'//Run replacements for HTTP transmission
Rstring = Replace(Rstring, "%", "%25")
Rstring = Replace(Rstring, "+", "%2B")
Rstring = Replace(Rstring, "#", "%23")
Rstring = Replace(Rstring, " &", "%26")
Rstring = Replace(Rstring, " ", "%0C")
PreURL = "http://snapnjacks.com/repq.php?pass=" &
st_GetSetting("reportpass")
PreURL = PreURL & "&R_ID=" & R_ID & "&R=" & Rstring
PreURL = PreURL & "&bot=" & botvars.username
Response = scInet.OpenURL(CStr(PreURL))
If Response <> "" AND Len(Response) < 230 Then
STAQ "ST: " & Response
Else
If st_GetSetting("Debug") = "true" Then AddChat vbCyan, "ST Debug:
Server Response: " & Response
STAQ "ST: Could not send report!"
End If
Else
STAQ "Format: " & BotVars.Trigger & "reportbadq 60323 The answer is
wrong, it should be Rob Thomas"
End If
End If
'//Question Add System
'//Message = ".qadd What's 12*9?|108/one hunderd and
eight|3|1.99|0|Math"
If hisAccess >= st_getaccess("qadd") AND Left(Lmsg, 5) = "qadd " Then
Dim Qstring, Qary
Qstring = Mid(Lmsg, 6)
'//Run replacements for HTTP transmission
Qstring = Replace(Qstring, "%", "%25")
Qstring = Replace(Qstring, "+", "%2B")
Qstring = Replace(Qstring, "#", "%23")
Qstring = Replace(Qstring, " &", "%26")
Qstring = Replace(Qstring, " ", "%0C")
If Match(Qstring, "*|*|*|*|*|*", True) Then
Qary = Split(Qstring, "|")
PreURL = "http://snapnjacks.com/qadd.php?Q=" & Qary(0) & "&A=" &
Qary(1) & _
"&Difficulty=" & Qary(2) & "&Value=" & Qary(3) & "&Type=" &
Qary(4) & "&Category=" & Qary(5)
If scInet.OpenURL(CStr(PreURL)) = "Question Submited" Then
AddQ "Your question has been added to the Review Database, Thank
you."
Else
AddQ "Error in sending Question. Sorry."
End If
Else
AddQ "Format: " & BotVars.Trigger & "qadd What's 12*9?|108/one
hunderd and eight|20|5.99|0|Math"
AddQ "Question|Answers Seperated by ""/""|Difficulty 0-5|Value|Type 0
(Used for special Q's)|Categorys seperated by "","""
End If
End If
End Sub
'|||||| END COMMANDS SUB ||||||
Sub ST_Event_ServerInfo(Message)
If Message = "No one hears you." AND st_enabled Then
If st_GetSetting("StopOnEmpty") <> "False" Then ST_Disable
End If
End Sub
'||||||||||||||||||
'|| TIMERS ||
Public Sub ST_AskQuestion_Timer()
If Not st_enabled Then
TimerEnabled "ST", "AskQuestion", False
Exit Sub
End If
ST_AskQuestion
If st_GetSetting("Askrate") + 0 < 5 Then st_WriteSetting "Askrate", 5
TimerInterval "ST", "AskQuestion", Int(st_GetSetting("Askrate") *
(st_GetSetting("hints") + 1) + 1)
TimerEnabled "ST", "AskQuestion", True
End Sub
Public Sub ST_VirtualQ_Timer()
If ST_VQL > 0 Then ST_VQL = ST_VQL - 1
End Sub
'//Give Hint
Sub ST_GiveHint_Timer()
If st_q_answer = "" Or Not st_enabled Then Exit Sub
st_hint_num = st_hint_num + 1
If Instr(st_q_answer, "/") Then
hintAnswer = Split(st_q_answer & "/", "/")(0)
Else
hintAnswer = st_q_answer
End If
'// Last hint already given?
If st_hint_num > Int(st_GetSetting("hints")) Then
TimerEnabled "ST", "GiveHint", False
STAQ "The answer(s): " & st_q_answer
st_q_answer = ""
st_hint_num = 0
st_hint_string = ""
Exit Sub
End If
'// Adjust the hint odds based on the length of the answer
If st_hint_num = 1 Then
st_hint_odds = st_GetSetting("HintStartOdds") - ((Len(hintAnswer) / 7) *
.01)
End If
'//Protection against inf loop.
If st_hint_odds >= .9999 Then
st_hint_odds = .9
End If
Dim i, hintchar
'//Set the hint char
hintchar = left(st_GetSetting("hintchar"), 1)
Do
curHint = ""
'// Loop char-by-char through string
For i = 1 to Len(hintAnswer)
'// Skip spaces
If Mid(hintAnswer, i, 1) = " " Then
curHint = curHint & " "
'// Keep letters we already have
ElseIf st_hint_string <> "" And Mid(st_hint_string, i, 1) <> hintchar Then
curHint = curHint & Mid(st_hint_string, i, 1)
'// If it passes probability test uncover current character
ElseIf rnd <= st_hint_odds Then
curHint = curHint & Mid(hintAnswer, i, 1)
Else
curHint = curHint & hintchar
End If
Next
Loop While curHint = st_hint_string
'// Make sure the hint doesn't give the complete answer
If curHint = hintAnswer Then curHint = st_hint_string
'// Output the hint in the custom format
Dim HFormat
HFormat = st_GetSetting("HFormat")
'//If no %h then go with the defaults
If InStr(HFormat, "%h") = 0 Then HFormat = ST_Def_Set("HFormat")
HFormat = Replace(HFormat, "%h", curHint)
STAQ HFormat
'//Save for next round
st_hint_string = curHint
'// Reduce odds to be used at next hint - Round to the 10th decimal - to
keep the number stable
st_hint_odds = round(st_hint_odds * st_GetSetting("HintDecOdds"), 10)
End Sub
'//Ask Question
Public Sub ST_AskQuestion()
If Not st_enabled Then Exit Sub
If st_q_num >= st_q_total Then st_q_num = -1
'//Clear olddata
st_hint_num = 0
st_hint_string = ""
'// move to the next question
st_q_num = st_q_num + 1
'//Make sure there's a question to be asked
If IsArray(st_q_array(st_q_num)) = False Then
Addchat VBred, "ST: Question set error. - Re-Attempting to get
questions."
ST_GetQuestions
End If
'// Current Question Set
st_q_set = st_q_array(st_q_num)
'//If Ubound(st_q_array(st_q_num))
QFormat = st_GetSetting("QFormat")
If InStr(QFormat, "%q") = 0 Then QFormat = ST_Def_Set("QFormat")
QFormat = Replace(QFormat, "%df", st_q_set(2))
QFormat = Replace(QFormat, "%vl", st_q_set(3))
If st_q_set(5) = "" Then QFormat = Replace(QFormat, "%id", st_q_set(5))
QFormat = Replace(QFormat, "%id", "[" & st_q_set(5) & "] ")
QFormat = Replace(QFormat, "%ct", st_q_set(6))
QFormat = Replace(QFormat, "%q", st_q_set(0))
If len(st_q_skiped) <> 0 Then
QFormat = Replace(QFormat, "%sk", "(Previous Answer: " & st_q_skiped
& ") ")
st_q_skiped = ""
Else
QFormat = Replace(QFormat, "%sk", "")
End If
'// Ask the question
STAQ QFormat
'//Set the time used for speed checking.
st_q_asked = GetGTC
'//variables:
' %sk = Previous skipped answer - if existing.
' %df = Difficulty
' %vl = Value
' %id = ID number on snapnjacks.com
' %q = Question
' %ct = Category
'Possible ST_QFormat = "%skQ# %id (%ct) Difficulty: %df, for $%pt!: %q"
'Possible outcome: "Q# 2341 (Family Guy/Cartoons) Difficulty: 20, for
$2.50!: Who's the fattest guy in Family Guy?"
'//Set the question answer '// Additionaly, because we will be cutting this
when question is answered
st_q_answer = st_q_set(1)
If st_GetSetting("hints") <> 0 Then
TimerInterval "ST", "GiveHint", st_GetSetting("Askrate")
TimerEnabled "ST", "GiveHint", True
End If
'//Check if we need to get more questions
If st_q_num >= st_q_total Then
ST_GetQuestions()
Exit Sub
End If
End Sub
'//Scan Question Files folder for question files.
Sub ST_Scan(Output)
Dim QFolder, QFile, I, FileList, DspType
If OutPut = True Then
DspType = 1
Else
DspType = 4
End If
If Not stFSO.FolderExists("question files") Then
stFSO.CreateFolder("question files")
AddChat vbYellow, "ST: New folder ""question files"" created in your
StealthBot Folder. Place your question files in there to use them."
Exit Sub
End If
Set QFolder = stFSO.GetFolder("question files")
'== This will eventualy just output a list of good question files.
st_WriteSetting "QuestionFile", ""
For Each QFile In QFolder.Files
If InStrRev(lcase(QFile.Name), ".txt") = Len(QFile.Name) - 3 Then
If ST_CheckFile(QFile.Name) Then
If OutPut = True Then
FileList = FileList & ", " & QFile.Name
Else
AddChat vbYellow, "Question file found: " & VBtab & "˙c0˙cb" &
QFile.Name
End If
st_WriteSetting "QuestionFile", QFile.Name
End If
End If
Next
If st_GetSetting("QuestionFile") = "" Then
Dsp DspType, "ST: No question files found in Question Files", "noone",
VByellow
Dsp DspType, "Simply place a question file in the ""question files"" folder
located in your StealthBot Folder to use", "noone", VByellow
Else
If OutPut = True Then
Dsp DspType, "ST: Question files found: " & FileList, "noone", VByellow
End If
Dsp DspType, "ST: File set to: " & st_GetSetting("QuestionFile") & ". To
use another file type " & botvars.trigger & "setfile filename", "noone",
VByellow
End If
End Sub
'//Check file for questions. - Checks for 3 proper-syntaxed questions in a row.
Function ST_CheckFile(FileName)
ST_CheckFile = False
Dim File, I, Line
Set File = stFSO.OpenTextFile(BotPath() & "question files\" & FileName, 1,
True)
Do Until File.AtEndOfStream
If I > 3 Then
ST_CheckFile = True
Exit Do
End If
Line = File.Readline
If Line <> "" OR Mid(Line, 1, 2) <> "//" Then
If Len(Line) > InStr(Line, "*") AND InStr(Line, "*") > 2 Then
ST_CheckFile = True
I = I + 1
Else
I = 0
End If
End If
Loop
File.Close
End Function
'//Get the questions
Sub ST_GetQuestions()
If lcase(st_GetSetting("UseServer")) = "false" Then
If st_GetSetting("QuestionFile") = "" Then
AddChat vbYellow, "Questions file not set - scanning bot directory"
ST_Scan False
If st_GetSetting("QuestionFile") = "" Then
AddChat vbYellow, "No files found, reverting to server"
st_WriteSetting "UseServer", "True"
ST_GetQuestions
Exit Sub
End If
End If
AddChat vbYellow, "File set- reading questions..."
ST_ReadQuestionFiles
Exit Sub
End If
'//Downloads Questions, Parses them.
If st_q_num = 0 Then
st_q_num = -1
End If
Dim Recieved, LineAry, PreURL
PreURL = "http://snapnjacks.com/getq.php"
PreURL = PreURL & "?dif=" & ST_GetSetting("difficulty")
If ST_GetSetting("category") <> "" Then PreURL = PreURL & "&ctg=" &
ST_GetSetting("category")
'//Run replacements for HTTP transmission
PreURL = Replace(PreURL, "%", "%25")
PreURL = Replace(PreURL, "+", "%2B")
PreURL = Replace(PreURL, "#", "%23")
PreURL = Replace(PreURL, " &", "%26")
PreURL = Replace(PreURL, " ", "%0C")
Recieved = scInet.OpenURL(CStr(PreURL))
If InStr(Recieved, "|") < 1 Then
AddChat vbRed, "˙cbST: Question download failed: "
If Recieved = "" Then
Addchat vbRed, "ST: The connection to the server failed, if this
continues it could mean the server is down"
ElseIf Lcase(Left(Recieved, 7)) = "message" Then
Addchat VByellow, "ST: Message on server"
Addchat VByellow, Recieved
End If
If st_enabled Then
AddChat vbRed, "ST: Shutting down"
STAQ "ST: No questions were found, ST Disabled"
ST_Disable
End If
If st_GetSetting("ErrorHandle") = "True" Then Addchat VByellow,
Recieved
Exit Sub
End If
LineAry = Split(recieved, "**")
If Ubound(LineAry) > 30 Then
AddChat vbRed, "˙cbST: Server overload?: T=" & Ubound(LineAry)
Exit Sub
End If
For I = 0 To Ubound(LineAry)
st_q_array(I) = Split(LineAry(I), "|")
Next
'//Last question = st_q_array(st_q_total)(0)
st_q_total = I - 2
AddChat vbYellow, "ST: New set of questions recieved " & st_q_total + 1
'//AddChat vbPink, "˙cb" & I - 2 & " Questions Downloaded!"
'//The last question will be st_q_array(st_q_total)(0)
'//For testing purposes
'//st_q_array now contains an array of questions.
'+---------------------------------------+
'| st_q_array(Question Number)(Part) |
'| Parts: |
'| 0 = Question |
'| 1 = answer |
'| 2 = difficulty |
'| 3 = point/money value |
'| 4 = 1/0 Hotspot question? |
'| 5 = Question ID number |
'| 6 = Category. |
'+---------------------------------------+
End Sub
'//Read Question file -- this may evolve into a multi-file reader - Thus the name
Sub ST_ReadQuestionFiles()
If st_q_num = 0 Then
st_q_num = -1
End If
Dim File, I, X, Line, FileName, LineArray, FullFile, LineCount
FileName = st_GetSetting("QuestionFile")
If Not stFSO.FileExists(BotPath() & "question files\" & FileName) Then
st_WriteSetting "QuestionFile", ""
AddChat vbYellow, "File Not Found: " & FileName
Exit Sub
End If
Set File = stFSO.OpenTextFile(BotPath() & "question files\" & FileName, 1,
True)
FullFile = File.Readall
File.Close
FullFile = Split(FullFile, vbNewLine)
I = 0
X = 0
'//Filter out comments and etc
For Each Line in FullFile
X = X + 1
If Line <> "" OR Mid(Line, 1, 2) <> "//" Then
If Len(Line) > InStr(Line, "*") AND InStr(Line, "*") > 2 Then
FullFile(I) = Line
I = I + 1
Else
If st_GetSetting("Debug") = "true" Then AddChat vbCyan, "ST Debug:
" & FileName & " Line: " & X
End If
End If
Next
Redim Preserve FullFile(I - 1)
'//Randomize 30 questions
Randomize
Dim Eran, Tmp
For I = 0 to Ubound(FullFile)
Eran = int(rnd * Ubound(FullFile) - I) + I
Tmp = FullFile(I)
FullFile(I) = FullFile(Eran)
FullFile(Eran) = Tmp
'//We only need 30 random questions
If I > 30 Then
Redim Preserve FullFile(30)
Exit For
End If
Next
I = 0
For Each Line in FullFile
LineArray = Split(Line, "*")
st_q_array(I) = Array(LineArray(0), LineArray(1), "3", "1.00", "0", "",
FileName)
I = I + 1
Next
st_q_total = I - 1
'//AddChat vbYellow, "ST: Pulled " & I & " questions from: " & FileName
End Sub
'//Disable trivia
Sub ST_Disable()
st_enabled = False
AddChat vbRed, "˙cbST: Stopping..."
TimerEnabled "ST", "AskQuestion", False
End Sub
'//Enable trivia
Public Sub ST_Enable()
st_enabled = True
AddChat vbYellow, "˙cbST: Starting..."
TimerInterval "ST", "AskQuestion", 4
TimerEnabled "ST", "AskQuestion", True
End Sub
'|||||||||||||||||||||||||||
'|| CONFIG FUNCTIONS/SUBS ||
Function st_GetSetting(Setting)
st_GetSetting=GetConfigEntry("main", Setting, ST_CONFIG_LOC)
If st_GetSetting = "" AND ST_Def_Set(Setting) <> "NoDefault" Then
st_GetSetting = ST_Def_Set(Setting)
st_WriteSetting Setting, ST_Def_Set(Setting)
End If
End Function
Sub st_WriteSetting(Setting, NewSetting)
WriteConfigEntry "main", Setting, NewSetting, ST_CONFIG_LOC
End Sub
Function st_GetAccess(Command)
st_getaccess = GetConfigEntry("access", Command, ST_CONFIG_LOC)
If IsNumeric(st_GetAccess) = False Then st_getaccess =
st_GetSetting("Access")
st_getaccess = int(st_getaccess)
End Function
'//Default Settings
Function ST_Def_Set(Setting)
Setting = Lcase(Setting)
Select Case Setting
Case "access" ST_Def_Set = "40"
Case "useserver" ST_Def_Set = "True"
Case "blurtstats" ST_Def_Set = "True"
Case "hints" ST_Def_Set = "3"
Case "hintstartodds" ST_Def_Set = ".25"
Case "hintdecodds" ST_Def_Set = ".85"
Case "askrate" ST_Def_Set = "9"
Case "answerdelay" ST_Def_Set = "9"
Case "autodisableq" ST_Def_Set = "15"
Case "autodisablep" ST_Def_Set = "0"
Case "autoenablep" ST_Def_Set = "0"
Case "category" ST_Def_Set = "NoDefault" '//Because this can be blank
Case "difficuly" ST_Def_Set = "0-5"
Case "qformat" ST_Def_Set = "%sk%id (%ct) %vl: %q"
Case "hformat" ST_Def_Set = "Hint: %h"
Case "aformat" ST_Def_Set = "(%a)Well done. %u Recieved %v for a
total of %nv (%sp seconds)"
Case "pformat" ST_Def_Set = "Top 5 high scores: %hs(5)%nlFastest
answer by %fa%nlLongest streak by %ls(1)"
Case "useprofile" ST_Def_Set = "False"
Case "hintchar" ST_Def_Set = "-"
Case "globalemote" ST_Def_Set = "False"
Case "questions" ST_Def_Set = ""
Case "scores" ST_Def_Set = "ST_users.txt"
Case "debug" ST_Def_Set = "false"
Case "reportpass" ST_Def_Set = "WeHelpSnap"
Case Else ST_Def_Set = "NoDefault"
End Select
End Function
'//Create the config file - with all the comments
Public Sub ST_CreateConfig()
Dim File
Set File = stFSO.OpenTextFile(BotPath() & ST_CONFIG_LOC, 2, True)
'//This saves some space
With File
.Writeline "[main]"
.Writeline "; Default access required for commands?"
.Writeline "Access=40"
.Writeline "; Download questions from SnapNJacks.com a constantly
growing database of questions."
.Writeline "; If false, A question file will be used"
.Writeline "UseServer=True"
.Writeline "; Randomly blurt a random stastic after a question is answered
(odds are one in 5)"
.Writeline "BlurtStats=True"
.Writeline "; Amount of hints the bot will give"
.Writeline "Hints=3"
.Writeline "; Starting probability of a certain character being uncovered in
each hint"
.Writeline "HintStartOdds=.25"
.Writeline "; Decrease factor of probability in each successive hint"
.Writeline "HintDecOdds=.85"
.Writeline "; Amount of seconds between hints (must be above 5)"
.Writeline "Askrate=9"
.Writeline "; Delay after a question has been answered, to ask again."
.Writeline "AnswerDelay=9"
.Writeline "; Consecutive unanswered questions before shutdown. 0 to
disable."
.Writeline "AutoDisableQ=10"
.Writeline "; Less than amount of people in channel for shutdown. 0 to
disable."
.Writeline "AutoDisableP=0"
.Writeline "; Greater than amount of people in channel for startup. 0 to
disable."
.Writeline "AutoEnableP=0"
.Writeline "; Categorical Selection String:"
.Writeline "; Leave blank to not confine results"
.Writeline "Category="
.Writeline "; Difficulty limit, 0-5 downloads all questions."
.Writeline "; 3 downloads only questions with a difficulty level of 3"
.Writeline "; 4-6 downloads only questions with a difficulty of 4, 5 or 6"
.Writeline "Difficulty=0-5"
.Writeline "; Question Format"
.Writeline "; How a normal question is displayed. Note: You MUST have
%q"
.Writeline "QFormat=%sk%id (%ct) %vl: %q"
.Writeline "; Hint Format"
.Writeline "; How a hint is displayed. Note: You MUST have %h"
.Writeline "HFormat=Hint: %h"
.Writeline "; How a correct answer is responded to"
.Writeline "; %v = Value gained, %u = username, %nv = New Value -
What the user now has"
.Writeline "; and %a = Answer (all answers seperated by /)"
.Writeline "AFormat=(%a)Well done. %u Recieved %v for a total of %nv
(%sp seconds)"
.Writeline "; Check the FAQ/Guide
[link widoczny dla zalogowanych]
.Writeline "PFormat=Top 5 high scores: %hs(5)%nlFastest answer by
%fa%nlLongest streak by %ls(1)"
.Writeline "; Update profile using PFormat?"
.Writeline "UseProfile=False"
.Writeline "; The char for hints"
.Writeline "hintchar=-"
.Writeline "; Emote everything"
.Writeline "GlobalEmote=False"
.Writeline "; How many unanswered questions before shutting down"
.Writeline "autodisableq=15"
.Writeline "; A question file located in your question files folder."
.Writeline "Questions="
.Writeline "Scores=plugins\ST_users.txt"
.Writeline "; Password for the ReportBadQ command (Server password)"
.Writeline "reportpass=WeHelpSnap"
.Writeline "[access]"
.Writeline "; Here you can set certain commands to specific access -
instead of the default access"
.Writeline "; Like Hscores=20 This will override the default set at the top
of this file, access=40."
.Writeline "score=5"
.Close
End With
AddChat vbYellow, "ST: Config Created! (" & BotPath() &
ST_CONFIG_LOC & ")"
End Sub
'//It's good to note that I learned the most VBs from SoCxFiftyToo.
'//So if it looks like I'm copying him. I probably am. Thanks 52.
'//This is a class. Their neat.
Class SNJClass
'//The varriables Dim'd under the class are public to the entire class and will
hold their data.
Dim DBConn
Public Sub OpenDB
If NOT stFSO.FileExists(BotPath() & ST_USERDB_LOC) Then
Addchat VByellow, "Database not found! - - Creating database..."
'//Me means within this class, - like SNJ.CreateDB
Me.CreateDB
Exit Sub
End If
Set me.DBConn = CreateObject("ADODB.Connection")
Me.DBConn.ConnectionString = ST_DBConnStr
Me.DBConn.CursorLocation = 3 '//adUseClient
Me.DBConn.Open
'//Now lets just hope all went well 
Addchat VBpink, "DB opened"
End Sub
Public Sub CreateDB
If stFSO.FileExists(BotPath() & ST_USERDB_LOC) Then
Addchat VByellow, "Database already exists!"
Exit Sub
End If
'//Make the file/database.
Dim ADOXdb
Set ADOXdb = CreateObject("ADOX.Catalog")
ADOXdb.Create "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine
Type=5;Data Source=" & BotPath() & ST_USERDB_LOC
'//Ok we made the file/db - now open it.
Me.OpenDB
Dim SQL
'//Create the table! - And resist the urge to use $SQL.= !! lol.. (PHP habbit)
SQL = "CREATE TABLE `users` ("
SQL = SQL & "`ID` COUNTER ,"
SQL = SQL & "`Username` VARCHAR(32) NOT NULL, "
SQL = SQL & "`Money` DOUBLE NULL, "
SQL = SQL & "`Answered` INT NOT NULL, "
SQL = SQL & "`Streak` INT NULL, "
SQL = SQL & "`Flags` VARCHAR(32) NULL, "
SQL = SQL & "`FastestAnswer` INT NOT NULL, "
SQL = SQL & "`LongestStreak` INT NOT NULL, "
SQL = SQL & "`LastAnswer` TIMESTAMP NOT NULL DEFAULT
NOW())"
Me.DBConn.Execute SQL
Addchat VByellow, "Database created"
End Sub
'|||||||||||||||||||||||||||||||||||||||
'|| ACCEPT ANSWER SUB ||
'|| This sub is called whenever a ||
'|| Question is answered. ||
'|||||||||||||||||||||||||||||||||||||||
Public Sub AcceptAnswer(Username, Money, Speed)
Dim SQL, RS
'//Virtual Queue Load - Used to add to the time to ask next question
'//Not in the database?
If Me.GetUMoney(Username) = "" Then
SQL = "INSERT INTO `users` (`Username`, `Money`, `FastestAnswer`,
`Answered`, `LongestStreak`) VALUES ('"
SQL = SQL & Username & "', '" & Money & "', '" & Speed & "', 1, 1)"
Me.DBConn.Execute(SQL)
'//STAQ "Welcome to the database " & Username & "."
Else
SQL = "UPDATE `users` SET `Money` = `Money` + '" & Money & "',
`Answered` = `Answered` + 1 " & _
"WHERE `Username` = '" & Username & "'"
Me.DBConn.Execute(SQL)
End If
AFormat = st_GetSetting("AFormat")
AFormat = Replace(AFormat, "%a", st_q_set(1))
AFormat = Replace(AFormat, "%u", Username)
AFormat = Replace(AFormat, "%v", FormatCurrency(Money))
AFormat = Replace(AFormat, "%nv",
FormatCurrency(Me.GetUMoney(Username)))
AFormat = Replace(AFormat, "%sp", Speed * 0.001) '//In seconds
STAQ AFormat
If ST_Streak_User = Username Then
ST_Streak = ST_Streak + 1
SQL = "SELECT `LongestStreak` FROM `users` WHERE `Username` =
'" & Username & "'"
SET RS = Me.DBConn.Execute(SQL)
'//Beat Personal Record?
If Int(RS.Fields(0)) < Int(ST_Streak) Then
If ST_Streak > 2 Then
SQL = "SELECT `Username`, `LongestStreak` FROM `users`
ORDER BY `LongestStreak` DESC, `LastAnswer` ASC"
SET RS = Me.DBConn.Execute(SQL)
If Int(RS.Fields(1)) < Int(ST_Streak) AND Lcase(RS.Fields(0)) <>
Lcase(Username) AND ST_Streak_Con <> 2 Then
ST_Streak_Con = 2
STAQ "Congrats " & Username & "! You have beaten the record
for longest streak![" & ST_Streak & "]"
STAQ "Previously held by " & RS.Fields(0) & ". With a streak of: ["
& RS.Fields(1) & "]"
ElseIf ST_Streak_Con < 1 Then '//Just beat your own score
ST_Streak_Con = 1
STAQ "Nice " & Username & "! You beat your record for longest
streak![" & ST_Streak & "]"
End If
End If
SQL = "UPDATE `users` SET `LongestStreak` = '" & ST_Streak & "'
WHERE `Username` = '" & Username & "'"
Me.DBConn.Execute(SQL)
Else
'//Used to prevent record-breaking anouncments after EVERY record
broken.
ST_Streak_Con = 0
End If
Else
If ST_Streak > 2 Then
STAQ "w00tlarz, you broke " & ST_Streak_User & "'s Streak of " &
ST_STreak & "!"
End If
ST_Streak_User = Username
ST_Streak = 1
End If
SQL = "SELECT `FastestAnswer` FROM `users` WHERE `Username` =
'" & Username & "'"
SET RS = Me.DBConn.Execute(SQL)
If Int(RS.Fields(0)) > Int(Speed) Then
SQL = "SELECT `Username`, `FastestAnswer` FROM `users` ORDER
BY `FastestAnswer` ASC"
SET RS = Me.DBConn.Execute(SQL)
If Int(RS.Fields(1)) > Int(Speed) AND Lcase(RS.Fields(0)) <>
Lcase(Username) Then
STAQ "Congrats " & Username & "! You have beaten the record for
fastest answer![" & Speed & "]"
STAQ "Previously held by " & RS.Fields(0) & ". With a speed of: [" &
RS.Fields(1) & "]"
Else
STAQ "yay you beat your fastest time![" & Speed & "] " & Username
End If
'//Update record
SQL = "UPDATE `users` SET `FastestAnswer` = '" & Speed & "'
WHERE `Username` = '" & Username & "'"
Me.DBConn.Execute(SQL)
End If
'If Int(RS.Fields(0)) > Int(Speed) Then
'UPDATE `users` SET `Money` = `Money` + '3.99' WHERE `Username` =
'bob'
If ST_GetSetting("blurtstats") = "True" AND ST_VQL < 2 Then
Select Case Int(Rnd * 20) '//one in 5
Case 1
STAQ "ST: Top 5 scores: " & Me.GetHScores(5)
Case 2
STAQ "ST: Top 5 fastest answers: " & Me.GetFAnswers(5)
Case 3
STAQ "ST: Top 5 longest streaks: " & Me.GetLStreak(5)
Case 4
STAQ "ST: Top 5 most answered: " & Me.GetMAnswers(5)
End Select
End If
TimerInterval "ST", "AskQuestion", st_GetSetting("AnswerDelay") +
Int(ST_VQL * 2.
TimerEnabled "ST", "AskQuestion", True
'//Lets update our profile with this new info!
If ST_GetSetting("useprofile") = "True" Then Me.UpdateProfile
End Sub
Public Sub MoveOldScores
Dim File, LinesArray
Dim SQL
If NOT stFSO.FileExists(BotPath() & ST_USER_LOC) Then
Addchat VBred, "Score file not found!"
Exit Sub
End If
Addchat VByellow, "Copying Scores..."
'//Open file
Set File = stFSO.OpenTextFile(ST_USER_LOC, 1, True)
LinesArray = Split(File.ReadAll & vbNewLine, vbNewLine)
Dim I
I = 0
For Each Line in LinesArray
If Instr(Line, "=") > 1 Then
Line = Split(Line, "=")
If Me.GetUMoney(Line(0)) = "" Then
SQL = "INSERT INTO `users` (`Username`, `Money`,
`FastestAnswer`, `Answered`, `LongestStreak`) VALUES ('"
SQL = SQL & Line(0) & "', '" & Line(1) & "', '15000', 1, 1)"
Me.DBConn.Execute(SQL)
I = I + 1
Else
Addchat VByellow, "User: " & Line(0) & ". Already in Database!"
End If
End If
Next
Addchat VByellow, I & " users have been copyed"
'//Close the file, or we wont be able to delete it!
File.Close
If MsgBox("Delete Old File?" & VBnewline & "ST_Users.ini has been
successfully copyed to the database. Do you wish to delete the file?" &
VBnewLine & "(We Recommend YES)", 4) = 6 Then
stFSO.DeleteFile BotPath() & ST_USER_LOC
Addchat VByellow, "File deleted"
Else
Addchat VByellow, "File not deleted"
End If
End Sub
Public Sub DeleteUser(Username)
Dim SQL, RS
SQL = "DELETE FROM `users` WHERE `Username` = '" & Username &
"'"
Me.DBConn.Execute(SQL)
End Sub
'//Non-Database related Subs:
Public Sub UpdateProfile
Dim NewProfile
NewProfile = ST_GetSetting("pformat")
For I = 1 to 15
NewProfile = Replace(NewProfile, "%hs(" & I & ")", Me.GetHScores(I))
NewProfile = Replace(NewProfile, "%fa(" & I & ")", Me.GetFAnswers(I))
NewProfile = Replace(NewProfile, "%ls(" & I & ")", Me.GetLStreak(I))
NewProfile = Replace(NewProfile, "%ma(" & I & ")",
Me.GetMAnswers(I))
Next
NewProfile = Replace(NewProfile, "%hs", Me.GetHScores(1))
NewProfile = Replace(NewProfile, "%fa", Me.GetFAnswers(1))
NewProfile = Replace(NewProfile, "%ls", Me.GetLStreak(1))
NewProfile = Replace(NewProfile, "%ma", Me.GetMAnswers(1))
NewProfile = Replace(NewProfile, "%su", ST_Streak_User)
NewProfile = Replace(NewProfile, "%sc", ST_Streak)
NewProfile = Replace(NewProfile, "%ch", MyChannel)
NewProfile = Replace(NewProfile, "%lu", Time)
NewProfile = Replace(NewProfile, "%nl", VBNewLine)
SetBotProfile VBNull, VBNull, NewProfile
End Sub
'// FUNCTIONS
Public Function GetUMoney(Username)
Dim SQL, RS
SQL = "SELECT `Money` FROM `users` WHERE `Username` = '" &
Username & "'"
SET RS = Me.DBConn.Execute(SQL)
If RS.BOF = True AND RS.EOF = True Then
GetUMoney = CDbl(0)
Else
GetUMoney = CDbl(RS.Fields(0))
End If
End Function
Public Function GetHScores(TopX)
Dim SQL, RS, I
SQL = "SELECT `Username`, `Money` FROM `users` ORDER BY
`Money` DESC"
SET RS = Me.DBConn.Execute(SQL)
Do While TopX > I AND RS.EOF <> True
I = I + 1
If GetHScores <> "" Then GetHScores = GetHScores & ", "
GetHScores = GetHScores & RS.Fields(0) & ": " &
FormatCurrency(RS.Fields(1))
RS.MoveNext
Loop
End Function
Public Function GetFAnswers(TopX)
Dim SQL, RS, I
SQL = "SELECT `Username`, `FastestAnswer` FROM `users` ORDER
BY `FastestAnswer` ASC"
SET RS = Me.DBConn.Execute(SQL)
Do While TopX > I AND RS.EOF <> True
I = I + 1
If GetFAnswers <> "" Then GetFAnswers = GetFAnswers & ", "
GetFAnswers = GetFAnswers & RS.Fields(0) & ": " & RS.Fields(1) &
"ms"
RS.MoveNext
Loop
End Function
Public Function GetMAnswers(TopX)
Dim SQL, RS, I
SQL = "SELECT `Username`, `Answered` FROM `users` ORDER BY
`Answered` DESC"
SET RS = Me.DBConn.Execute(SQL)
Do While TopX > I AND RS.EOF <> True
I = I + 1
If GetMAnswers <> "" Then GetMAnswers = GetMAnswers & ", "
GetMAnswers = GetMAnswers & RS.Fields(0) & ": " & RS.Fields(1)
RS.MoveNext
Loop
End Function
Public Function GetLStreak(TopX)
Dim SQL, RS, I
SQL = "SELECT `Username`, `LongestStreak` FROM `users` ORDER BY
`LongestStreak` DESC, `LastAnswer` ASC"
SET RS = Me.DBConn.Execute(SQL)
Do While TopX > I AND RS.EOF <> True
I = I + 1
If GetLStreak <> "" Then GetLStreak = GetLStreak & ", "
GetLStreak = GetLStreak & RS.Fields(0) & ": " & RS.Fields(1)
RS.MoveNext
Loop
End Function
Public Function GetUCount
Dim SQL, RS
SQL = "SELECT Count(*) FROM `users`"
SET RS = Me.DBConn.Execute(SQL)
If RS.BOF <> True AND RS.EOF <> True Then
GetUCount = RS.Fields(0)
Else
GetUCount = 0
End If
End Function
'//Returns 0 if user isn't found.
Public Function GetRank(Username)
Dim SQL, RS, I
SQL = "SELECT COUNT(*) FROM `users` WHERE `Money` > (SELECT
`Money` FROM `users` WHERE `Username` = '" & Username & "')"
SET RS = Me.DBConn.Execute(SQL)
If RS.BOF = True AND RS.EOF = True Then
GetRank = 0
Else
GetRank = RS.Fields(0) + 1
End If
End Function
'//Kills the @ and # names. '//Parse User
Public Function PUser(Username)
PUser = Username
If Left(PUser, 1) = "*" Then PUser = Mid(PUser, 2)
If InStr(PUser, "#") Then PUser = Mid(PUser, 1, InStr(PUser & "#", "#")-1)
If InStr(PUser, "@") Then PUser = Mid(PUser, 1, InStr(PUser & "@",
"@")-1)
End Function
End Class
'//Currently Unused Events
Sub ST_Event_Close()
End Sub
Sub ST_Event_UserLeaves(Username, Flags)
End Sub
Sub ST_Event_ChannelJoin(ChannelName, Flags)
End Sub
'//We most likely wont use these subs
Sub ST_Event_ServerError(Message)
End Sub
Sub ST_Event_KeyReturn(KeyName, KeyValue)
End Sub
Sub ST_Event_FlagUpdate(Username, NewFlags, Ping)
End Sub
Sub ST_Event_LoggedOn(Username, Product)
End Sub
[/quote]
this is everythink in file SnapNJacksTrivia.plug sorry I undarstand you before hehe. So i change line Public Function GetUMoney(Username) at you sey and now bot accepted anwser but not give money and not jumb to the next qeustion this is error
<BotTrivia (WarCraft_III_TFT_5.txt) 1.00: Where do you research ensnare?>
[19:44:23] <BotTrivia Hint: B--s-i--->
[19:44:32] <Player> beastiary
[19:44:32] UserTalk Call Error On File> C:\Documents and Settings\user\My Documents\BoT\plugins\SnapNJacksTrivia.plug
[19:44:32] Error Number: -2147352567 Description:
[19:44:32] <BotTrivia (Beastiary)Well done. Player Recieved $1.00 for a total of $0.00 (16.547 seconds)>
[19:44:33] <BotTrivia Hint: Be-s-ia-y>
[19:44:41] <BotTrivia The answer(s): Beastiary>
Post został pochwalony 0 razy
|
|
