· 8 years ago · Jul 21, 2018, 07:52 PM
1Script("Name") = "SnapNJacks Trivia"
2Script("Abbreviation") = "st"
3Script("Author") = "Snap - SnapWilliam@Gmail.com"
4Script("Category") = "Entertainment"
5Script("Major") = 1
6Script("Minor") = 0
7Script("Revision") = 0
8Script("Description") = "Nondescript"
9'This script has been converted from the plugin version of 0.849 by Neco (fallingground@live.com)
10'All original coding credit goes to Snap.
11
12'At the moment, all the commands remain the same as the plugin counterpart.
13' • trivia on/off
14' • score
15' • score <user>
16' • skip
17' • qadd
18' • category <category string>
19' • qformat
20' • hformat
21' • hints <amount>
22' • useserver <on/off>
23' • stver
24' • high scores/hscores
25' • gemote on/off
26' • hintchar [char]
27' • reportbadq [id] [why]
28' • AFormat [newformat]
29' • difficulty [difficulty]-[difficulty]
30
31'||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
32'|| CREDITS ||
33'|| Assistant coders: Jack and Swent ||
34'|| Extra ideas from: ||
35'|| Nellaf, MoV-Leader, The.Warchief, Three_Stooges, TcHa2-PulK, Hr.Frosty ||
36'||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
37
38Public ST_VER : ST_VER = Script("Major") & "." & Script("Minor") & Script("Revision")
39
40Public Const ST_VER_DESCRIP = "Release"
41Public Const ST_COLOR = &HFFCC99
42
43Public ST_USER_LOC : ST_USER_LOC = BotPath() & "scripts\ST_users.ini"
44Public ST_USERDB_LOC : ST_USERDB_LOC = BotPath() & "scripts\ST_users.mdb"
45Public ST_CONFIG_LOC : ST_CONFIG_LOC = BotPath() & "scripts\ST_config.ini"
46
47Public stFSO : Set stFSO = CreateObject("Scripting.FileSystemObject")
48
49Public st_enabled '// Global on/off
50Public st_q_array(41) '// Question DB pull 2deminsional array.
51Public st_q_set '// Current Question Set
52Public st_q_total '// Question Number - how many questions downloaded.
53Public st_q_num '// Current Question Number
54Public st_q_answer '// Question's Answer
55Public st_q_skiped '// The answer to a skipped question
56Public st_unanswerd '// The consecutive amount of questions unanswered.
57Public st_hint_num '// Current Hint Number
58Public st_hint_string '// Current Hint
59Public st_q_asked '// Contains GetGTC of the time the question was asked.
60
61Public st_flooduser '// Used to prevent spam.
62Public st_floodtime '// ^
63
64Public st_DBConnStr : ST_DBConnStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ST_USERDB_LOC
65Public SNJ
66Public ST_Streak, ST_Streak_User, ST_Streak_Con
67Public ST_VQL
68Public ST_File_Config
69Public ST_File_Users
70
71Public Sub Event_Load()
72 Set SNJ = New SNJClass
73
74 If stFSO.FileExists(ST_USER_LOC) AND NOT stFSO.FileExists(ST_USERDB_LOC) Then
75 Addchat vbYellow, "ST: SnapNJacks will now create the database, and copy the users over."
76 call SNJ.OpenDB()
77 call SNJ.MoveOldScores()
78 Else
79 call SNJ.OpenDB()
80 End If
81
82 If SNJ.Setting("configver") <> ST_VER And stFSO.FileExists(ST_CONFIG_LOC) Then
83 Addchat VBwhite, "Welcome to SnapNJacks Trivia, this script was brought to you free of charge by Snap"
84 Addchat VBwhite, "Be sure to visit the Guide: http://www.stealthbot.net/board/index.php?showtopic=12827"
85 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
86 stFSO.DeleteFile ST_CONFIG_LOC
87 Addchat VByellow, "ST_Config File deleted"
88 Else
89 ST_WriteSetting "configver", ST_VER
90 End If
91 End If
92
93 If Not stFSO.FileExists(ST_CONFIG_LOC) Then
94 stFSO.CreateTextFile(ST_CONFIG_LOC)
95 ST_CreateConfig
96 End If
97 If Not stFSO.FolderExists("question files") Then
98 stFSO.CreateFolder("question files")
99 AddChat vbYellow, "ST: New folder ""question files"" created. Put your question files in here to use them."
100 End If
101
102 call CreateObj("LongTimer", "AskQuestion")
103 AskQuestion.Interval = 5
104 call CreateObj("LongTimer", "VirtualQ")
105 VirtualQ.Interval = 3
106 VirtualQ.Enabled = true
107 call CreateObj("LongTimer", "GiveHint")
108 GiveHint.Enabled = false
109
110 Randomize()
111
112 AddChat ST_COLOR, "SnapNJacks Trivia. Version " & ST_VER & " " & ST_VER_DESCRIP & " loaded with " & SNJ.GetUCount & " users in the DB"
113End Sub
114
115Public Sub Event_Close()
116 Set SNJ = Nothing
117End Sub
118
119Public Sub Event_UserTalk(Username, Flags, Message, Ping)
120 If Left(Message, 1) = BotVars.Trigger Then ST_Commands Username, Message, "Talk"
121
122 If st_enabled Then ST_CheckAnswer Username, Message
123End Sub
124
125Public Sub Event_PressedEnter(Text)
126 If Left(Text, 3) = "/a " AND st_enabled Then
127 ST_CheckAnswer BotVars.Username, Mid(Text, 4)
128 VetoThisMessage
129 Exit Sub
130 End If
131 If Left(Text, 2) = "//" Then
132 ST_Commands BotVars.Username, Mid(Text, 2), "UEnter"
133 Exit Sub
134 End If
135 If Left(Text, 1) = "/" Then ST_Commands BotVars.Username, Text, "Enter"
136End Sub
137
138Public Sub Event_WhisperFromUser(Username, Flags, Message, Ping)
139 If Left(Message, 1) = BotVars.Trigger Then ST_Commands Username, Message, "Whisper"
140End Sub
141
142Private Sub ST_CheckAnswer(Username, Message)
143 If SNJ.GetBlocked(Username) Then Exit Sub
144
145
146
147 Dim Answers, NewScore, AddScore
148 If Not st_enabled Then Exit Sub
149 If instr(st_q_answer, "/") = 0 Then
150 If lcase(Message) = lcase(st_q_answer) Then
151 SNJ.AcceptAnswer SNJ.PUser(Username), st_q_set(3), GetGTC - st_q_asked
152 st_q_answer = ""
153 st_unanswerd = 0
154 End If
155 Exit Sub
156 End If
157 Answers = Split(st_q_answer, "/")
158 For Each Item in Answers
159 If Lcase(Message) = Lcase(Item) Then
160 SNJ.AcceptAnswer SNJ.PUser(Username), st_q_set(3), GetGTC - st_q_asked
161 st_q_answer = ""
162 st_unanswerd = 0
163 End If
164 Next
165End Sub
166
167Sub ST_SQ(Text)
168 If Instr(Text, "%nl") > 0 Then
169 Dim TextAry
170 TextAry = Split(Text, "%nl")
171 For Each Item in TextAry
172 STAQ Item
173 Next
174 Exit Sub
175 Else
176 STAQ Text
177 End If
178End Sub
179
180Private Sub STAQ(Text)
181 If Not SSC.IsOnline() Then
182 Addchat ST_COLOR, "ST: Stealthbot isn't online. Trivia will now be disabled."
183 ST_Disable
184 Exit Sub
185 End If
186 '//GlobalEmote=False
187 If lcase(st_GetSetting("GlobalEmote")) = "true" Then
188 If lcase(left(Text, 4)) = "/me " Then Text = Mid(Text, 5)
189 Dsp 2, Text, 0, 0
190 Else
191 Dsp 1, Text, 0, 0
192 End If
193 ST_VQL = ST_VQL + 1
194End Sub
195
196'For the Commands Sub
197Private Sub ST_R(Username, Message, Method)
198 Select Case Method
199 Case "Enter"
200 AddChat ST_COLOR, Message
201 VetoThisMessage
202 Case "UEnter"
203 STAQ Message
204 VetoThisMessage
205 Case "Talk"
206 STAQ Message
207 Case "Whisper"
208 STAQ "/w " & Username & " " & Message
209 End Select
210End Sub
211
212Private Sub ST_Commands(Username, Message, Source)
213 Dim Lmsg, Tmp
214 '//Request Command and String
215 Dim RCmd, RStr
216 Lmsg = Trim(Mid(Message, 2))
217 '//No command?
218 If Lmsg = "" Then Exit Sub
219
220 '//Is there full-sentence alias for this command?
221 Tmp = ST_GetCommand(Lmsg)
222 If Tmp <> "" Then
223 RCmd = Lcase(Tmp)
224 Else
225 '//How about first-word alias?
226 RCmd = Lcase(Split(Lmsg)(0))
227 Tmp = ST_GetCommand(RCmd)
228 If Tmp <> "" Then RCmd = Lcase(Tmp)
229 If Instr(Lmsg, " ") > 0 Then RStr = Mid(Lmsg, Instr(Lmsg, " ") + 1)
230 End If
231
232 '//Command disabled?
233 If RCmd = "disabled" Then Exit Sub
234
235 Dim InBot
236 InBot = False
237
238 ST_Debug "Command used: " & RCmd
239 ST_Debug "String: " & RStr
240
241
242
243 '//-1 Because script returns -1 if not in DB.
244 If hisAccess < st_getaccess(RCmd) - 1 Then Exit Sub
245 Username = SNJ.PUser(Username) '//Rids us of the @lordaeron and #2 etc.
246
247 '//Check For flooding!
248 If int(st_GetSetting("floodprotect")) > 0 AND Not InBot Then
249 If ST_VQL >= 2 Then
250 If int(st_GetSetting("floodprotect")) > 1 Then Addchat ST_COLOR, "ST: Flood protection has ignored due to a high virtual-q."
251 Exit Sub
252 End If
253 If st_flooduser = Username AND GetGTC - st_floodtime < 2300 Then
254 If int(st_GetSetting("floodprotect")) > 1 Then Addchat ST_COLOR, "ST: Flood protection has ignored a spammed command."
255 Exit Sub
256 End If
257 st_flooduser = Username
258 st_floodtime = GetGTC
259 End If
260
261 '//All done! On to our commands!
262
263 '//Score
264 If RCmd = "score" Then
265 If RStr = "" Then RStr = Username
266 Tmp = SNJ.GetUMoney(RStr)
267 If Tmp = "" Then
268 ST_R Username, "User not found: " & Rstr, Source
269 Else
270 ST_R Username, SNJ.ProcessVars(st_GetSetting("resscore"), RStr), Source
271 '// SNJ.GetRank
272 End If
273 End If
274
275 If RCmd = "donate" Then
276 Tmp = Split(RStr)
277 If UBound(Tmp) <> 1 Then
278 ST_R Username, "Format: " & Botvars.trigger & "donate [username] [howmuch] ;Example: " & Botvars.trigger & "donate bob 20", Source
279 Else
280 '//Allow the bot console to donate username -5 to take money from users.
281 If InBot AND Left(Tmp(1), 1) = "-" Then
282 If SNJ.GiveMoney(Tmp(1), Username, Tmp(0), InBot) Then
283 ST_R Username, "Removed " & FormatCurrency(Tmp(1)) & " from " & Tmp(0), Source
284 Else
285 ST_R Username, "Failed to remove money"
286 End If
287 Else
288 Tmp(1) = Replace(Tmp(1), "-", "")
289 If SNJ.GiveMoney(Tmp(1), Username, Tmp(0), InBot) Then
290 ST_R Username, "Donated " & FormatCurrency(Tmp(1)) & " to " & Tmp(0), Source
291 Else
292 ST_R Username, "Unable to donate, make sure you have the funds, and that the other user is in the database.", Source
293 End If
294 End If
295 End If
296 End If
297
298 If RCmd = "rank" AND RStr = "" Then
299 Tmp = SNJ.GetRank(Username)
300 If Tmp = 0 Then
301 ST_R Username, "I don't have you on record yet " & Username, Source
302 Else
303 ST_R Username, Username & ", you are ranked: " & SNJ.AddSuffix(Tmp), Source
304 End If
305 ElseIf RCmd = "rank" Then
306 Tmp = SNJ.GetRank(Rstr)
307 If Tmp = 0 Then
308 ST_R Username, "User not found: " & Rstr, Source
309 Else
310 ST_R Username, Split(Lmsg)(1) & " found: ranked: " & SNJ.AddSuffix(Tmp), Source
311 End If
312 End If
313
314 '==Addslashes
315 If RCmd = "stblock" And RStr <> "" Then
316 If SNJ.GetBlocked(Rstr) Then
317 ST_R Username, "User: " & Rstr & " is already blocked", Source
318 Exit Sub
319 Else
320 SNJ.Block(RStr)
321 ST_R Username, "User has been blocked from playing trivia: " & Rstr, Source
322 Exit Sub
323 End If
324 End If
325
326 If RCmd = "stunblock" And RStr <> "" Then
327 If Not SNJ.GetBlocked(Rstr) Then
328 ST_R Username, "User: " & Rstr & " isn't blocked.", Source
329 Exit Sub
330 Else
331 SNJ.UnBlock(RStr)
332 ST_R Username, "User has been unblocked from playing trivia: " & Rstr, Source
333 Exit Sub
334 End If
335 End If
336 If RCMd = "stblocklist" Then
337 ST_R Username, SNJ.BlockList, Source
338 Exit Sub
339 End If
340
341 If RCmd = "skip" AND st_enabled Then
342 If Source <> "Talk" Then STAQ "Question Skipped"
343 If Source = "Enter" Then VetoThisMessage
344 st_q_skiped = st_q_answer
345 call AskQuestion_Timer()
346 End If
347
348 If RCmd = "category off" Then
349 SNJ.Setting("category") = ""
350 ST_R Username, "Category reset to """"", Source
351 Exit Sub
352 End If
353 '//To update a category selection
354 If RCmd = "category" Then
355 If RCmd & RStr <> "category" Then
356 ST_WriteSetting "category", Split(Lmsg)(1)
357 ST_R Username, "New category string: """ & st_GetSetting("category") & """ Saved", Source
358 '//download a new set based on it :).
359 ST_GetQuestions
360 Else
361 ST_R Username, "Usage: '" & BotVars.Trigger & "category " & ST_Def_Set("category") & _
362 "'. Current setting: " & st_GetSetting("category"), Source
363 End If
364 End If
365
366 If RCmd = "hints" AND RStr <> "" Then
367 ST_WriteSetting "Hints", RStr
368 ST_R Username, "ST: Change saved: Hints=" & RStr, Source
369 End If
370
371 If Left(Lmsg, 9) = "hintchar " Then
372 ST_WriteSetting "hintchar", Mid(Message, 11, 1)
373 ST_R Username, "ST: Change saved: hintchar=" & Mid(Message, 11, 1), Source
374 End If
375
376 If RCmd = "setfile" Then
377 If RStr = "" Then
378 ST_R Username, "ST: No input, - listing files:", Source
379 If Source = "Enter" Then ST_Scan False Else ST_Scan True
380 Exit Sub
381 End If
382 Tmp = RStr
383 If InStrRev(lcase(Tmp), ".txt") <> (Len(Tmp) - 3) OR Len(Tmp) < 4 Then
384 Tmp = Tmp & ".txt"
385 End If
386 If stFSO.FileExists(BotPath() & "question files\" & Tmp) Then
387 ST_WriteSetting "questionfile", Tmp
388 ST_R Username, "ST: Change saved: questionfile=" & Tmp, Source
389 ST_WriteSetting "UseServer", "False"
390 ST_GetQuestions
391 ST_Enable
392 ElseIf Source = "Enter" Then
393 ST_R Username, "ST: File not found:" & Tmp & " Scanning...", Source
394 ST_Scan False
395 Else
396 ST_R Username, "ST: File not found:" & Tmp & " Scanning...", Source
397 ST_Scan True
398 End If
399 End If
400
401 If RCMd = "blurtstats on" Then
402 SNJ.Setting("blurtstats") = "true"
403 ST_R Username, "ST: Now blurtstats is now on.", Source
404 End If
405 If RCMd = "blurtstats off" Then
406 SNJ.Setting("blurtstats") = "false"
407 ST_R Username, "ST: Now blurtstats is now off.", Source
408 End If
409
410 '//Console Only Commands
411 If InBot Then
412 If RCMd = "stconfig" Then
413 ST_R Username, "ST: Opening config...", Source
414 psWShell.Open ST_CONFIG_LOC
415 End If
416
417 If RCMd = "stdebug on" Then
418 SNJ.Setting("debug") = "true"
419 ST_R Username, "ST: Now showing debug data", Source
420 End If
421 If RCMd = "stdebug off" Then
422 SNJ.Setting("debug") = "false"
423 ST_R Username, "ST: Now hiding debug data", Source
424 End If
425
426 If RCMd = "stdelete" Then
427 If RStr <> "" Then
428 SNJ.DeleteUser(RStr)
429 ST_R Username, "User " & RStr & " has been deleted", Source
430 End If
431 End If
432
433 If RCMd = "stuserlist" Then
434 ST_R Username, "Snap's Trivia Userlist (Top 500):", Source
435 Tmp = SNJ.TopMoney(500)
436 Tmp = Replace(Tmp, ": ", VBTab)
437 Tmp = Replace(Tmp, ", ", VBNewLine)
438 Addchat ST_COLOR, VBNewLine & Tmp
439 End If
440 End If
441
442 '//UseServer On/Off
443 If Trim(RCmd & " " & Lcase(RStr)) = "useserver on" Then
444 ST_WriteSetting "UseServer", "True"
445 ST_R Username, "ST: Change saved", Source
446 ST_GetQuestions
447 ElseIf Trim(RCmd & " " & Lcase(RStr)) = "useserver off" Then
448 ST_WriteSetting "UseServer", "False"
449 ST_R Username, "ST: Change saved", Source
450 ST_GetQuestions
451 End If
452
453 '//GEmote On/Off
454 If Trim(RCmd & " " & Lcase(RStr)) = "gemote on" Then
455 ST_WriteSetting "globalemote", "True"
456 ST_R Username, "ST: Change saved: globalemote=True" , Source
457 ElseIf Trim(RCmd & " " & Lcase(RStr)) = "gemote off" Then
458 ST_WriteSetting "globalemote", "False"
459 ST_R Username, "ST: Change saved: globalemote=False" , Source
460 End If
461
462 '//Use Profile On/Off
463 If Trim(RCmd & " " & Lcase(RStr)) = "useprofile on" Then
464 ST_WriteSetting "useprofile", "True"
465 ST_R Username, "ST: Change saved: useprofile=True" , Source
466 ElseIf Trim(RCmd & " " & Lcase(RStr)) = "useprofile off" Then
467 ST_WriteSetting "useprofile", "False"
468 ST_R Username, "ST: Change saved: useprofile=False" , Source
469 End If
470
471 If RCmd = "qformat" Then
472 If InStr(RStr, "%q") <> 0 AND RStr <> "" Then
473 ST_WriteSetting "qformat", RStr
474 ST_R Username, "New Qformat string: """ & st_GetSetting("qformat") & """ Saved", Source
475 Else
476 ST_R Username, "Usage: '" & BotVars.Trigger & "qformat " & ST_Def_Set("qformat") & _
477 "'. %q Required! Current setting: " & st_GetSetting("QFormat"), Source
478 End If
479 End If
480 If RCmd = "hformat" Then
481 If InStr(RStr, "%h") <> 0 AND RStr <> "" Then
482 ST_WriteSetting "hformat", RStr
483 ST_R Username, "New Hformat string: """ & st_GetSetting("hformat") & """ Saved", Source
484 Else
485 ST_R Username, "Usage: '" & BotVars.Trigger & "hformat " & ST_Def_Set("hformat") & _
486 "'. %h Required! Current setting: " & st_GetSetting("HFormat"), Source
487 End If
488 End If
489 If RCmd = "aformat" Then
490 If RStr <> "" Then
491 ST_WriteSetting "aformat", RStr
492 ST_R Username, "New Aformat string: """ & st_GetSetting("Aformat") & """ Saved", Source
493 Else
494 ST_R Username, "Usage: '" & BotVars.Trigger & "aformat " & ST_Def_Set("aformat") & _
495 "'. Current setting: " & st_GetSetting("AFormat"), Source
496 End If
497 End If
498 If RCmd = "pformat" Then
499 If RStr <> "" Then
500 ST_WriteSetting "pformat", RStr
501 ST_R Username, "New Pformat string: """ & st_GetSetting("Pformat") & """ Saved", Source
502 Else
503 ST_R Username, "Usage: '" & BotVars.Trigger & "Pformat " & ST_Def_Set("pformat") & _
504 "'. Current setting: " & st_GetSetting("PFormat"), Source
505 End If
506 End If
507 If RCmd = "difficulty" Then
508 If RStr <> "" Then
509 ST_WriteSetting "difficulty", RStr
510 ST_R Username, "New difficulty setting: """ & st_GetSetting("difficulty") & """ Saved", Source
511 Else
512 ST_R Username, "Usage: '" & BotVars.Trigger & "difficulty " & ST_Def_Set("difficulty") & _
513 "'. Current setting: " & st_GetSetting("difficulty"), Source
514 End If
515 End If
516
517 If RCmd = "stver" Then
518 ST_R Username, "ST Version " & ST_VER & " " & ST_VER_DESCRIP & " loaded.", Source
519 End If
520
521 If Trim(RCmd & " " & Lcase(RStr)) = "trivia off" Then
522 If st_enabled = True Then
523 ST_Disable
524 ST_R Username, "ST: Disabled '" & BotVars.Trigger & "trivia on' to start", Source
525 If st_q_answer <> "" Then
526 STAQ "Answer(s) to previous question: " & st_q_answer
527 st_q_answer = ""
528 End If
529 Else
530 ST_R Username, "ST: Trivia is already off", Source
531 End If
532 Exit Sub
533 End If
534 If Trim(RCmd & " " & Lcase(RStr)) = "trivia on" Then
535 If st_enabled = False Then
536 ST_Enable
537 ST_R Username, "ST: Enabled '" & BotVars.Trigger & "trivia off' to stop", Source
538 call AskQuestion_Timer()
539 Else
540 ST_R Username, "ST: Trivia is already on", Source
541 End If
542 Exit Sub
543 End If
544 If RCmd = "trivia" Then
545 If ST_Enabled Then
546 ST_R Username, "ST: Version " & ST_VER & " " & ST_VER_DESCRIP & " - Trivia is On.", Source
547 Else
548 ST_R Username, "ST: Version " & ST_VER & " " & ST_VER_DESCRIP & " - Trivia is off.", Source
549 End If
550 Exit Sub
551 End If
552
553 '//Top 10 High Scores
554 If RCmd = "hscores" Then
555 ST_R Username, "ST: Top 10: " & SNJ.TopMoney(10), Source
556 End If
557
558 If RCmd = "fanswers" Then
559 ST_R Username, "ST: Top 10: " & SNJ.TopFAnswers(10), Source
560 End If
561
562 If RCmd = "manswered" Then
563 ST_R Username, "ST: Top 10: " & SNJ.TopMAnswers(10), Source
564 End If
565
566 If RCmd = "lstreak" Then
567 ST_R Username, "ST: Top 10: " & SNJ.TopLStreaks(10), Source
568 End If
569
570 '//We need this for the next 2
571 Dim PreURL
572
573 '//reportbadq
574 If RCmd = "reportbadq" Then
575 Dim Rstring, R_ID, Response
576 Rstring = "<" & Username & "> " & Message
577 R_ID = Split(Rstring & " ")(2)
578 If IsNumeric(R_ID) Then
579 '//Run replacements for HTTP transmission
580 Rstring = SNJ.CleanURL(RString)
581 PreURL = "http://snapnjacks.com/repq.php?pass=" & st_GetSetting("reportpass")
582 PreURL = PreURL & "&R_ID=" & R_ID & "&R=" & Rstring
583 PreURL = PreURL & "&bot=" & botvars.username
584 Response = scInet.OpenURL(CStr(PreURL))
585 If Response <> "" AND Len(Response) < 230 Then
586 ST_R Username, "ST: " & Response, Source
587 Else
588 ST_Debug "Server Response: " & Response
589 ST_R Username, "ST: Could not send report!", Source
590 End If
591 Else
592 ST_R Username, "Format: " & BotVars.Trigger & "reportbadq 60323 The answer is wrong, it should be Rob Thomas", source
593 End If
594 End If
595
596 '//Question Add System
597 '//Message = ".qadd What's 12*9?|108/one hunderd and eight|3|1.99|0|Math"
598 If RCmd = "qadd " Then
599 Dim Qstring, Qary
600 Qstring = RStr
601 '//Run replacements for HTTP transmission
602 Qstring = SNJ.CleanURL(Qstring)
603 If Match(Qstring, "*|*|*|*|*|*", True) Then
604 Qary = Split(Qstring, "|")
605 PreURL = "http://snapnjacks.com/qadd.php?Q=" & Qary(0) & "&A=" & Qary(1) & _
606 "&Difficulty=" & Qary(2) & "&Value=" & Qary(3) & "&Type=" & Qary(4) & "&Category=" & Qary(5)
607 If scInet.OpenURL(CStr(PreURL)) = "Question Submited" Then
608 AddQ "Your question has been added to the Review Database, Thank you."
609 Else
610 AddQ "Error in sending Question. Sorry."
611 End If
612 Else
613 AddQ "Format: " & BotVars.Trigger & "qadd What's 12*9?|108/one hundred and eight|20|5.99|0|Math"
614 AddQ "Question|Answers Seperated by ""/""|Difficulty 0-5|Value|Type 0 (Used for special Q's)|Categorys seperated by "","""
615 End If
616 End If
617End Sub
618'|| END COMMANDS SUB ||
619'||||||||||||||||||||||||||||||
620
621Public Sub Event_ServerInfo(Message)
622 If Message = "No one hears you." AND st_enabled Then
623 If st_GetSetting("StopOnEmpty") <> "False" Then ST_Disable
624 End If
625End Sub
626
627Public Sub Event_ServerError(Message)
628 If Message = "All connections closed." AND st_enabled Then ST_Disable
629End Sub
630
631Public Sub AskQuestion_Timer()
632 If Not st_enabled Then
633 Exit Sub
634 End If
635 ST_AskQuestion
636 If st_GetSetting("Askrate") + 0 < 5 Then st_WriteSetting "Askrate", 5
637 AskQuestion.Interval = Int(st_GetSetting("Askrate") * (st_GetSetting("hints") + 1) + 1)
638 AskQuestion.Enabled = True
639End Sub
640
641Public Sub VirtualQ_Timer()
642 If ST_VQL > 0 Then ST_VQL = ST_VQL - 1
643End Sub
644
645Public Sub GiveHint_Timer()
646 If st_q_answer = "" Or Not st_enabled Then Exit Sub
647 st_hint_num = st_hint_num + 1
648 If Instr(st_q_answer, "/") Then
649 hintAnswer = Split(st_q_answer & "/", "/")(0)
650 Else
651 hintAnswer = st_q_answer
652 End If
653
654 '// Last hint already given?
655 If st_hint_num > Int(st_GetSetting("hints")) Then
656 GiveHint.Enabled = false
657 STAQ "The answer(s): " & st_q_answer
658 '==ST_Streak
659 st_q_answer = ""
660 st_hint_num = 0
661 st_hint_string = ""
662 Exit Sub
663 End If
664
665 Dim HintOdds
666 HintOdds = Cint(st_GetSetting("HintOdds"))
667
668 Dim i, hintchar, curHint
669 '//Set the hint char
670 hintchar = left(st_GetSetting("hintchar"), 1)
671 For x = 0 to 10
672 curHint = ""
673 '// Loop char-by-char through string
674 For i = 1 to Len(hintAnswer)
675 '// Skip spaces
676 If Mid(hintAnswer, i, 1) = " " Then
677 curHint = curHint & " "
678 '// Keep letters we already have
679 ElseIf st_hint_string <> "" And Mid(st_hint_string, i, 1) <> hintchar Then
680 curHint = curHint & Mid(st_hint_string, i, 1)
681 '// If it passes probability test uncover current character
682 ElseIf HintOdds / 100 > Rnd Then
683 curHint = curHint & Mid(hintAnswer, i, 1)
684 Else
685 curHint = curHint & hintchar
686 End If
687 Next
688 If curHint <> st_hint_string Then Exit For
689 Next'//The outer loop decreases the chances of getting an empty hint, or an unchanged hint.
690 '// Make sure the hint doesn't give the complete answer
691 If curHint = hintAnswer Then curHint = st_hint_string
692 '// Output the hint in the custom format
693 Dim HFormat
694 HFormat = st_GetSetting("HFormat")
695 '//If no %h then go with the defaults
696 If InStr(HFormat, "%h") = 0 Then HFormat = ST_Def_Set("HFormat")
697 HFormat = Replace(HFormat, "%h", curHint)
698 STAQ HFormat
699 '//Save for next round
700 st_hint_string = curHint
701
702End Sub
703
704'//Ask Question
705Public Sub ST_AskQuestion()
706 '//Enable Disable based on the amount of users in the channel
707 If st_GetSetting("AutoDisableP") <> 0 AND st_GetSetting("AutoDisableP") < GetInternalUserCount() Then
708 STAQ "ST: Not enough users in channel."
709 ST_Disable
710 Exit Sub
711 End If
712 If st_GetSetting("AutoEnableP") <> 0 AND st_GetSetting("AutoEnableP") > GetInternalUserCount() Then
713 STAQ "ST: Trivia started because there are now " & GetInternalUserCount() & " users in the channel"
714 ST_Enable
715 Exit Sub
716 End If
717
718 If Not st_enabled Then Exit Sub
719 If st_q_num >= st_q_total Then st_q_num = -1
720 '//Clear olddata
721 st_hint_num = 0
722 st_hint_string = ""
723
724 '// move to the next question
725 st_q_num = st_q_num + 1
726
727 '//Make sure there's a question to be asked
728 If IsArray(st_q_array(st_q_num)) = False Then
729 Addchat VByellow, "ST: Loading questions..."
730 ST_GetQuestions
731 Exit Sub
732 End If
733
734 '// Current Question Set
735 st_q_set = st_q_array(st_q_num)
736 '//If Ubound(st_q_array(st_q_num))
737
738
739 QFormat = st_GetSetting("QFormat")
740 If InStr(QFormat, "%q") = 0 Then QFormat = ST_Def_Set("QFormat")
741 QFormat = Replace(QFormat, "%df", st_q_set(2))
742 QFormat = Replace(QFormat, "%vl", FormatCurrency(st_q_set(3)))
743 If st_q_set(5) = "" Then QFormat = Replace(QFormat, "%id", st_q_set(5))
744 QFormat = Replace(QFormat, "%id", "[" & st_q_set(5) & "] ")
745 QFormat = Replace(QFormat, "%ct", st_q_set(6))
746 QFormat = Replace(QFormat, "%q", st_q_set(0))
747 If len(st_q_skiped) <> 0 Then
748 QFormat = Replace(QFormat, "%sk", "(Previous Answer: " & st_q_skiped & ") ")
749 st_q_skiped = ""
750 Else
751 QFormat = Replace(QFormat, "%sk", "")
752 End If
753 '// Ask the question
754 STAQ QFormat
755 '//Set the time used for speed checking.
756 st_q_asked = GetGTC
757
758 '//variables:
759 ' %sk = Previous skipped answer - if existing.
760 ' %df = Difficulty
761 ' %vl = Value
762 ' %id = ID number on snapnjacks.com
763 ' %q = Question
764 ' %ct = Category
765 'Possible ST_QFormat = "%skQ# %id (%ct) Difficulty: %df, for $%pt!: %q"
766 'Possible outcome: "Q# 2341 (Family Guy/Cartoons) Difficulty: 20, for $2.50!: Who's the fattest guy in Family Guy?"
767
768 '//This would be a good time to update the profile.
769 If Lcase(st_GetSetting("useprofile")) = "true" Then SNJ.UpdateProfile
770
771 '//Set the question answer '// Additionaly, because we will be cutting this when question is answered
772 st_q_answer = Trim(st_q_set(1))
773
774 If st_GetSetting("hints") <> 0 Then
775 GiveHint.Interval = st_GetSetting("Askrate")
776 GiveHint.Enabled = True
777 End If
778
779 '//Check if we need to get more questions
780 If st_q_num >= st_q_total Then
781 ST_GetQuestions
782 Exit Sub
783 End If
784End Sub
785
786'//Scan Question Files folder for question files.
787Sub ST_Scan(Output)
788
789 Dim QFolder, QFile, I, FileList, DspType
790 If OutPut = True Then
791 DspType = 1
792 If lcase(st_GetSetting("GlobalEmote")) = "true" Then DspType = 2
793 Else
794 DspType = 4
795 End If
796 If Not stFSO.FolderExists("question files") Then
797 stFSO.CreateFolder("question files")
798 AddChat vbYellow, "ST: New folder ""question files"" created in your StealthBot Folder. Place your question files in there to use them."
799 Exit Sub
800 End If
801 Set QFolder = stFSO.GetFolder("question files")
802
803 '== This will eventualy just output a list of good question files.
804 st_WriteSetting "QuestionFile", ""
805 For Each QFile In QFolder.Files
806 If InStrRev(lcase(QFile.Name), ".txt") = Len(QFile.Name) - 3 Then
807 If ST_CheckFile(QFile.Name) Then
808 If OutPut = True Then
809 FileList = FileList & ", " & QFile.Name
810 Else
811 AddChat vbYellow, "Question file found: " & VBtab & "ÿc0ÿcb" & QFile.Name
812 End If
813 st_WriteSetting "QuestionFile", QFile.Name
814 End If
815 End If
816 Next
817
818 If st_GetSetting("QuestionFile") = "" Then
819 Dsp DspType, "ST: No question files found in Question Files", "noone", VByellow
820 Dsp DspType, "Simply place a question file in the ""question files"" folder located in your StealthBot Folder to use", "noone", VByellow
821 Else
822 If OutPut = True Then
823 Dsp DspType, "ST: Question file(s) found: " & FileList, "noone", VByellow
824 End If
825 Dsp DspType, "ST: File set to: " & st_GetSetting("QuestionFile") & ". To use another file type " & botvars.trigger & "setfile filename", "noone", VByellow
826 End If
827End Sub
828
829'//Check file for questions. - Checks for 3 proper-syntaxed questions in a row.
830Function ST_CheckFile(FileName)
831 ST_CheckFile = False
832 Dim File, I, Line
833 Set File = stFSO.OpenTextFile(BotPath() & "question files\" & FileName, 1, True)
834 Do Until File.AtEndOfStream
835 If I > 3 Then
836 ST_CheckFile = True
837 Exit Do
838 End If
839 Line = File.Readline
840 If Line <> "" OR Mid(Line, 1, 2) <> "//" Then
841 If Len(Line) > InStr(Line, "*") AND InStr(Line, "*") > 2 Then
842 ST_CheckFile = True
843 I = I + 1
844 Else
845 I = 0
846 End If
847 End If
848 Loop
849 File.Close
850End Function
851
852'//Get the questions
853Sub ST_GetQuestions()
854 If lcase(st_GetSetting("UseServer")) = "false" Then
855 If st_GetSetting("QuestionFile") = "" Then
856 AddChat vbYellow, "Questions file not set - scanning bot directory"
857 ST_Scan False
858 If st_GetSetting("QuestionFile") = "" Then
859 AddChat vbYellow, "No files found, reverting to server"
860 st_WriteSetting "UseServer", "True"
861 ST_GetQuestions
862 Exit Sub
863 End If
864 End If
865 ST_ReadQuestionFiles
866 Exit Sub
867 End If
868
869 '//Downloads Questions, Parses them.
870 If st_q_num = 0 Then
871 st_q_num = -1
872 End If
873
874 Dim Received, LineAry, PreURL
875 PreURL = "http://snapnjacks.com/getq.php"
876 PreURL = PreURL & "?dif=" & st_GetSetting("difficulty")
877 If st_GetSetting("category") <> "" Then PreURL = PreURL & "&ctg=" & st_GetSetting("category")
878 '//Run replacements for HTTP transmission
879 PreURL = SNJ.CleanURL(PreURL)
880 If scInet.StillExecuting Then
881 ST_Debug "scInet is still executing last request, unable to get questions"
882 Exit Sub
883 End If
884 Received = scInet.OpenURL(CStr(PreURL))
885 If InStr(Received, "|") < 1 Then
886 AddChat vbRed, "ÿcbST: Question download failed."
887 If Received = "" Then
888 Addchat vbRed, "ST: The connection to the server failed, if this continues it could mean the server is down"
889 ElseIf Lcase(Left(Received, 7)) = "message" Then
890 Addchat VByellow, "ST: Message on server"
891 Addchat VByellow, Received
892 End If
893 If st_enabled Then
894 STAQ "ST: No questions were found with selected category. - try changing the category. ST Disabled"
895 ST_Disable
896 End If
897 If st_GetSetting("ErrorHandle") = "True" Then Addchat VByellow, Received
898 Exit Sub
899 End If
900
901 LineAry = Split(Received, "**")
902 If Ubound(LineAry) > 40 Then
903 AddChat vbRed, "ÿcbST: Server overload?: T=" & Ubound(LineAry)
904 Exit Sub
905 End If
906 For I = 0 To Ubound(LineAry)
907 st_q_array(I) = Split(LineAry(I), "|")
908 Next
909
910
911 '//Last question = st_q_array(st_q_total)(0)
912 st_q_total = I - 2
913 AddChat vbYellow, "ST: New set of questions Received " & st_q_total + 1
914
915 '//Ask our question
916 If ST_Enabled Then ST_AskQuestion
917 '//AddChat vbPink, "ÿcb" & I - 2 & " Questions Downloaded!"
918 '//The last question will be st_q_array(st_q_total)(0)
919
920 '//st_q_array now contains an array of questions.
921 '+---------------------------------------+
922 '| st_q_array(Question Number)(Part) |
923 '| Parts: |
924 '| 0 = Question |
925 '| 1 = answer |
926 '| 2 = difficulty |
927 '| 3 = point/money value |
928 '| 4 = 1/0 Hotspot question? |
929 '| 5 = Question ID number |
930 '| 6 = Category. |
931 '+---------------------------------------+
932End Sub
933
934'//Read Question file -- this may evolve into a multi-file reader - Thus fileS
935Sub ST_ReadQuestionFiles()
936 If st_q_num = 0 Then
937 st_q_num = -1
938 End If
939
940 Dim File, I, X, Line, FileName, LineArray, FullFile, LineCount
941 FileName = st_GetSetting("QuestionFile")
942 If Not stFSO.FileExists(BotPath() & "question files\" & FileName) Then
943 st_WriteSetting "QuestionFile", ""
944 AddChat vbYellow, "File Not Found: " & FileName
945 Exit Sub
946 End If
947
948 Set File = stFSO.OpenTextFile(BotPath() & "question files\" & FileName, 1, True)
949 FullFile = File.Readall
950 File.Close
951 FullFile = Split(FullFile, vbNewLine)
952 I = 0
953 X = 0
954
955 '//Filter out comments and etc
956 For Each Line in FullFile
957 X = X + 1
958 If Line <> "" OR Mid(Line, 1, 2) <> "//" Then
959 If Len(Line) > InStr(Line, "*") AND InStr(Line, "*") > 2 Then
960 FullFile(I) = Line
961 I = I + 1
962 Else
963 ST_Debug "QFile Error:" & FileName & " Line: " & X
964 End If
965 End If
966 Next
967 Redim Preserve FullFile(I - 1)
968
969 '//Randomize 40 questions
970 Randomize
971 Dim Eran, Tmp
972 For I = 0 to Ubound(FullFile)
973 Eran = int(rnd * Ubound(FullFile) - I) + I
974 Tmp = FullFile(I)
975 FullFile(I) = FullFile(Eran)
976 FullFile(Eran) = Tmp
977 '//We only need 40 random questions
978 If I > 40 Then
979 Redim Preserve FullFile(40)
980 Exit For
981 End If
982 Next
983 I = 0
984 Dim QValue
985 For Each Line in FullFile
986 LineArray = Split(Line, "*")
987 QValue = st_GetSetting("qtxtvalue")
988 '//Use the custom value if it exists.
989 If UBound(LineArray) > 1 Then
990 If IsNumeric(LineArray(2)) Then
991 QValue = Round(LineArray(2), 2)
992 End If
993 End If
994 st_q_array(I) = Array(LineArray(0), LineArray(1), "3", QValue, "0", "", FileName)
995 I = I + 1
996 Next
997 st_q_total = I - 1
998 '//AddChat vbYellow, "ST: Pulled " & I & " questions from: " & FileName
999End Sub
1000
1001'//Disable trivia
1002Sub ST_Disable()
1003 st_enabled = False
1004 AddChat vbRed, "ÿcbST: Stopping..."
1005 AskQuestion.Enabled = false
1006End Sub
1007
1008'//Enable trivia
1009Public Sub ST_Enable()
1010 st_enabled = True
1011 AddChat vbYellow, "ÿcbST: Starting..."
1012 AskQuestion.Interval = 4
1013 AskQuestion.Enabled = true
1014End Sub
1015
1016'//Used to output debug-data.
1017Public Sub ST_Debug(Text)
1018 If st_GetSetting("Debug") = "true" Then
1019 AddChat ST_COLOR, "ST Debug: " & Text
1020 End If
1021End Sub
1022
1023
1024
1025'|||||||||||||||||||||||||||
1026'|| CONFIG FUNCTIONS/SUBS ||
1027'//Depreciated with Class Properties.
1028Function st_GetSetting(Setting)
1029 st_GetSetting=GetConfigEntry("main", Setting, ST_CONFIG_LOC)
1030 If st_GetSetting = "" AND ST_Def_Set(Setting) <> "NoDefault" Then
1031 st_GetSetting = ST_Def_Set(Setting)
1032 st_WriteSetting Setting, ST_Def_Set(Setting)
1033 End If
1034End Function
1035
1036Sub st_WriteSetting(Setting, NewSetting)
1037 WriteConfigEntry "main", Setting, NewSetting, ST_CONFIG_LOC
1038End Sub
1039'//Dep
1040
1041Function st_GetAccess(Command)
1042 st_getaccess = GetConfigEntry("access", Command, ST_CONFIG_LOC)
1043 If IsNumeric(st_GetAccess) = False Then st_getaccess = st_GetSetting("Access")
1044 st_getaccess = int(st_getaccess)
1045End Function
1046
1047Function ST_GetCommand(Command)
1048 ST_GetCommand = Lcase(GetConfigEntry("commands", Command, ST_CONFIG_LOC))
1049 '//Is it a two worded off/on command?
1050 If ST_GetCommand = "" Then
1051 If Right(Command, 4) = " off" OR Right(Command, 3) = " on" Then ST_GetCommand = Command
1052 End If
1053End Function
1054
1055'//Default Settings
1056Function ST_Def_Set(Setting)
1057 Setting = Lcase(Setting)
1058 Select Case Setting
1059 Case "access" ST_Def_Set = "40"
1060 Case "playaccess" ST_Def_Set = "0"
1061 Case "floodprotect" ST_Def_Set = "0"
1062 Case "useserver" ST_Def_Set = "True"
1063 Case "blurtstats" ST_Def_Set = "True"
1064 Case "hints" ST_Def_Set = "3"
1065 Case "hintodds" ST_Def_Set = "20"
1066 Case "streak" ST_Def_Set = "4"
1067 Case "streakbonus" ST_Def_Set = "1"
1068 Case "streakincrease" ST_Def_Set = "0"
1069
1070 Case "askrate" ST_Def_Set = "9"
1071 Case "answerdelay" ST_Def_Set = "9"
1072 Case "autodisableq" ST_Def_Set = "15"
1073 Case "autodisablep" ST_Def_Set = "0"
1074 Case "autoenablep" ST_Def_Set = "0"
1075 Case "category" ST_Def_Set = "NoDefault" '//Because this can be blank
1076 Case "difficuly" ST_Def_Set = "0-5"
1077 Case "qtxtvalue" ST_Def_Set = "1"
1078 '//Formats
1079 Case "qformat" ST_Def_Set = "%sk%id (%ct) %vl: %q"
1080 Case "hformat" ST_Def_Set = "Hint: %h"
1081 Case "aformat" ST_Def_Set = "(%a)Well done. %u Received %vl for a total of %nv (%spm ms Ranked %rank) [%st]"
1082 Case "pformat" ST_Def_Set = "Top 5 high scores: %hs(5)%nlFastest answer by %fa%nlLongest streak by %ls(1)"
1083 Case "useprofile" ST_Def_Set = "False"
1084 '//Anouncments
1085 Case "ancstreakbreak" ST_Def_Set = "Sweet! %u, you broke %su Streak of %st!"
1086 Case "ancstreakrecord" ST_Def_Set = "Congrats %u! You have beaten the record for longest streak![%st]%nlPreviously held by %su. With a streak of: [%sa]"
1087 Case "ancstreakpersonal" ST_Def_Set = "Nice %u! You beat your record for longest streak![%st]"
1088 Case "ancspeedrecord" ST_Def_Set = "Congrats %u! You have beaten the record for fastest answer![%sp ms]%nlPreviously held by %fu. With a speed of: [%fa ms]"
1089 Case "ancspeedpersonal" ST_Def_Set = "Great job %u! you beat your fastest time![%sp ms]"
1090 '//Responses
1091 Case "resscore" ST_Def_Set = "%u has %vl, he has answered %qa questions, his fastest answer was %fams, and his longest streak was %st - he last played on %la"
1092
1093 Case "hintchar" ST_Def_Set = "-"
1094 Case "globalemote" ST_Def_Set = "False"
1095 '==
1096 Case "questions" ST_Def_Set = ""
1097 Case "scores" ST_Def_Set = "ST_users.txt"
1098 Case "debug" ST_Def_Set = "false"
1099 Case "reportpass" ST_Def_Set = "WeHelpSnap"
1100 Case Else ST_Def_Set = "NoDefault"
1101 End Select
1102End Function
1103
1104
1105
1106'//Create the config file - with all the comments :)
1107Public Sub ST_CreateConfig()
1108 Dim File
1109 Set File = stFSO.OpenTextFile(ST_CONFIG_LOC, 2, True)
1110 '//This saves some space
1111 With File
1112 .Writeline "[main]"
1113 .Writeline "; Default access required for commands?"
1114 .Writeline "Access=40"
1115 .Writeline "; Access required to play trivia (0 for anyone to play)"
1116 .Writeline "PlayAccess=0"
1117 .Writeline "; Flood protection for SnapNJacks"
1118 .Writeline "; Levels go from 0 to 2, 1 is on with alerts, 2 for no alerts."
1119 .Writeline "floodprotect=0"
1120 .Writeline "; Download questions from SnapNJacks.com a constantly growing database of questions."
1121 .Writeline "; If false, A question file will be used"
1122 .Writeline "UseServer=True"
1123 .Writeline "; Update profile using PFormat?"
1124 .Writeline "UseProfile=False"
1125 .Writeline "; Randomly blurt a random stastic after a question is answered (odds are one in 5 if no other anouncment is made.)"
1126 .Writeline "BlurtStats=True"
1127 .Writeline "; Amount of hints the bot will give"
1128 .Writeline "Hints=3"
1129 .Writeline "; Chances per-char of it being revealed. 20 will give you an average of 20% revealed."
1130 .Writeline "hintodds=20"
1131 .Writeline "; What counts as a streak, from this point on they will get bonus."
1132 .Writeline "streak=4"
1133 .Writeline "; Bonus recieved for being in a streak."
1134 .Writeline "streakbonus=1"
1135 .Writeline "; Bonus is increased by this per round."
1136 .Writeline "streakincrease=0"
1137
1138 .Writeline "; Amount of seconds between hints (must be above 5)"
1139 .Writeline "Askrate=9"
1140 .Writeline "; Delay after a question has been answered, to ask again."
1141 .Writeline "AnswerDelay=10"
1142 .Writeline "; Consecutive unanswered questions before shutdown. 0 to disable."
1143 .Writeline "AutoDisableQ=15"
1144 .Writeline "; Less than amount of people in channel for shutdown. 0 to disable."
1145 .Writeline "AutoDisableP=0"
1146 .Writeline "; Greater than amount of people in channel for startup. 0 to disable."
1147 .Writeline "AutoEnableP=0"
1148 .Writeline "; Categorical Selection String:"
1149 .Writeline "; Leave blank to not confine results. Normaly set via .category command"
1150 .Writeline "Category="
1151 .Writeline "; Difficulty limit, 0-5 downloads all questions."
1152 .Writeline "; 3 downloads only questions with a difficulty level of 3"
1153 .Writeline "; 4-6 downloads only questions with a difficulty of 4, 5 or 6"
1154 .Writeline "Difficulty=0-5"
1155 .Writeline "; The default value for question.txt questions"
1156 .Writeline "qtxtvalue=1"
1157
1158 .Writeline "; <FORMATS>:"
1159 .Writeline "; Question Format:"
1160 .Writeline "; How a normal question is displayed. Note: You MUST have %q"
1161 .Writeline "QFormat=%sk%id (%ct) %vl: %q"
1162 .Writeline "; Hint Format:"
1163 .Writeline "; How a hint is displayed. Note: You MUST have %h"
1164 .Writeline "HFormat=Hint: %h"
1165 .Writeline "; Answer Format:"
1166 .Writeline "; How a correct answer is responded to"
1167 .Writeline "; %vl = Value gained, %u = username, %nv = New Value - What the user now has"
1168 .Writeline "; and %a = Answer (all answers seperated by /)"
1169 .Writeline "AFormat=(%a)Well done. %u Received %vl for a total of %nv (%spm ms Ranked %rank) [%st]"
1170 .Writeline "; Check the FAQ/Guide http://www.stealthbot.net/board/index.php?showtopic=12827"
1171 .Writeline "PFormat=Top 5 high scores: %hs(5)%nlFastest answer by %fa%nlLongest streak by %ls(1)"
1172
1173 .Writeline "; <MISC ANOUNCMENTS>:"
1174 .Writeline "; Streak Anouncments:"
1175 .Writeline "; Break anothers streak:"
1176 .Writeline "AncStreakBreak=Sweet! %u, you broke %su Streak of %st!"
1177 .Writeline "; Beat streak all-time record:"
1178 .Writeline "AncStreakRecord=Congrats %u! You have beaten the record for longest streak![%st]%nlPreviously held by %su. With a streak of: [%sa]"
1179 .Writeline "; Beat personal streak record:"
1180 .Writeline "AncStreakPersonal=Nice %u! You beat your record for longest streak![%st]"
1181 .Writeline "; Fastest-Answer Anouncments:"
1182 .Writeline "; Beat speed all-time record:"
1183 .Writeline "AncSpeedRecord=Congrats %u! You have beaten the record for fastest answer![%sp ms]%nlPreviously held by %fu. With a speed of: [%fa ms]"
1184 .Writeline "; Beat personal speed record:"
1185 .Writeline "AncSpeedPersonal=Great job %u! you beat your fastest time![%sp ms]"
1186 .Writeline "; End MISC ANOUNCMENTS:"
1187 .Writeline "; <COMMAND RESPONSES>:"
1188 .Writeline "resscore=%u has %vl, he has answered %qa questions, his fastest answer was %fams, and his longest streak was %st - he last played on %la"
1189 .Writeline "; End COMMAND RESPONSES"
1190 '==
1191 '.Writeline "; Use a rewards file? - UNSUPPORTED"
1192 '.Writeline "UseRewards=False"
1193
1194 .Writeline "; The char for hints"
1195 .Writeline "hintchar=-"
1196 .Writeline "; Emote everything"
1197 .Writeline "GlobalEmote=False"
1198 .Writeline "; Password for the ReportBadQ command (Server password)"
1199 .Writeline "reportpass=WeHelpSnap"
1200 .Writeline "; Config version:"
1201 .Writeline "; Stop when bnet says no one hears you -(channel empty)"
1202 .Writeline "StopOnEmpty=True"
1203 .Writeline "configver=" & ST_VER
1204 .Writeline "[access]"
1205 .Writeline "; Here you can set certain commands to specific access - instead of the default access"
1206 .Writeline "; Like Hscores=20 This will override the default set at the top of this file, access=40."
1207 .Writeline "; Commands set to 0 will allow anyone to use them."
1208 .Writeline "trivia=0"
1209 .Writeline "score=5"
1210 .Writeline "[commands]"
1211 .Writeline "; Here you can set an alias for any command"
1212 .Writeline "; You can disable a command too, by setting command=disabled"
1213 .Writeline "; Alias=Command"
1214 .Writeline "high scores=hscores"
1215 .Writeline "fastest answers=fanswers"
1216 .Writeline "most answered=manswered"
1217 .Writeline "longest streaks=lstreaks"
1218 .Writeline "start trivia=trivia on"
1219 .Writeline "stop trivia=trivia off"
1220 .Close
1221 End With
1222 AddChat vbYellow, "ST: Config Created! (" & ST_CONFIG_LOC & ")"
1223End Sub
1224
1225'//It's good to note that I learned the most VBs from SoCxFiftyToo.
1226'//So if it looks like I'm copying him. I probably am. Thanks 52.
1227'//This is a class. Their neat.
1228Class SNJClass
1229 '//The varriables Dim'd under the class are public to the entire class and will hold their data.
1230 Dim DBConn
1231 '//Holds the last profile update.
1232 Dim OldProfile
1233 Private StreakBonus
1234
1235
1236 Public Property Get Setting (Name)
1237 Setting=GetConfigEntry("main", Name, ST_CONFIG_LOC)
1238 If Setting = "" Then
1239 If ST_Def_Set(Name) <> "NoDefault" Then
1240 Setting = ST_Def_Set(Name)
1241 Me.Setting(Name) = ST_Def_Set(Name)
1242 End If
1243 End If
1244 End Property
1245
1246 Public Property Let Setting (Name, Input)
1247 If Lcase(Cstr(Input)) = "false" Then Input = "false"
1248 If Lcase(Cstr(Input)) = "true" Then Input = "true"
1249 WriteConfigEntry "main", Name, Input, ST_CONFIG_LOC
1250 End Property
1251
1252
1253 Public Sub OpenDB
1254 If NOT stFSO.FileExists(ST_USERDB_LOC) Then
1255 Addchat VByellow, "Database not found! - - Creating database..."
1256 '//Me means within this class, - like SNJ.CreateDB
1257 Me.CreateDB
1258 Exit Sub
1259 End If
1260 On Error Resume Next
1261 Set me.DBConn = CreateObject("ADODB.Connection")
1262 '== Fix this, I shouldn't be using addchat in here...
1263 If Err.Number <> 0 Then
1264 Addchat VBred, "ST Error: Unable to connect to database, you must not have the proper drivers."
1265 Exit Sub
1266 End If
1267 Me.DBConn.ConnectionString = ST_DBConnStr
1268 Me.DBConn.CursorLocation = 3 '//adUseClient
1269 Me.DBConn.Open
1270 End Sub
1271
1272
1273 Public Sub CreateDB
1274 If stFSO.FileExists(ST_USERDB_LOC) Then
1275 Addchat VByellow, "Database already exists!"
1276 Exit Sub
1277 End If
1278 '//Make the file/database.
1279 Dim ADOXdb
1280 Set ADOXdb = CreateObject("ADOX.Catalog")
1281 ADOXdb.Create "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine Type=5;Data Source=" & ST_USERDB_LOC
1282
1283 '//Ok we made the file/db - now open it.
1284 Me.OpenDB
1285
1286 Dim SQL
1287 '//Create the table! - And resist the urge to use $SQL.= !! lol.. (PHP habbit)
1288 SQL = "CREATE TABLE `users` ("
1289 SQL = SQL & "`ID` COUNTER ,"
1290 SQL = SQL & "`Username` VARCHAR(32) NOT NULL, "
1291 SQL = SQL & "`Money` DOUBLE NULL, "
1292 SQL = SQL & "`Answered` INT NOT NULL, "
1293 SQL = SQL & "`Streak` INT NULL, "
1294 SQL = SQL & "`Flags` VARCHAR(32) NULL, "
1295 SQL = SQL & "`FastestAnswer` INT NOT NULL, "
1296 SQL = SQL & "`LongestStreak` INT NOT NULL, "
1297 SQL = SQL & "`LastAnswer` TIMESTAMP NOT NULL DEFAULT NOW())"
1298 Me.DBConn.Execute SQL
1299 Addchat VByellow, "Database created"
1300 End Sub
1301
1302 '|||||||||||||||||||||||||||||||||||||||
1303 '|| ACCEPT ANSWER SUB ||
1304 '|| This sub is called whenever a ||
1305 '|| Question is answered. ||
1306 '|||||||||||||||||||||||||||||||||||||||
1307 Public Sub AcceptAnswer(Username, Money, Speed)
1308 Dim SQL, RS
1309 'Temp-Format
1310 Dim TFormat
1311 TFormat = st_GetSetting("AFormat")
1312
1313 If StreakBonus = 0 Then StreakBonus = Me.Setting("streakbonus")
1314 '//Check Streak
1315 If Int(st_getsetting("streak")) > 0 AND Int(st_getsetting("streakbonus")) > 0 Then
1316 If ST_Streak_User = Username AND ST_Streak + 1 >= Int(st_getsetting("streak")) Then
1317 If Instr(TFormat, "%streakbonus") = 0 Then
1318 TFormat = TFormat & "[Streak Bonus + " & StreakBonus & "!]"
1319 Else
1320 TFormat = Replace(TFormat, "%streakbonus", "[Streak Bonus + " & StreakBonus & "!]")
1321 End If
1322 Money = Money + 0 + StreakBonus
1323 StreakBonus = StreakBonus + 0 + Me.Setting("streakincrease")
1324 Else
1325 '//Reset StreakBonus
1326 StreakBonus = Me.Setting("streakbonus")
1327 End If
1328 End If
1329 TFormat = Replace(TFormat, "%streakbonus", "")
1330
1331
1332 '//Virtual Queue Load - Used to add to the time to ask next question
1333 '//Not in the database?
1334 If Me.GetUMoney(Username) = "" Then
1335 SQL = "INSERT INTO `users` (`Username`, `Money`, `FastestAnswer`, `Answered`, `LongestStreak`) VALUES ('"
1336 SQL = SQL & Username & "', " & Money & ", '" & Speed & "', 1, 1)"
1337 Me.DBConn.Execute(SQL)
1338 '//STAQ "Welcome to the database " & Username & "."
1339 Else
1340 SQL = "UPDATE `users` SET `LastAnswer` = NOW(), `Money` = `Money` + " & Money & ", `Answered` = `Answered` + 1 " & _
1341 "WHERE `Username` = '" & Username & "'"
1342 Me.DBConn.Execute(SQL)
1343 End If
1344 '//Build response:
1345 TFormat = Replace(TFormat, "%a", st_q_set(1))
1346 TFormat = Replace(TFormat, "%vl", FormatCurrency(Money + 0))
1347 TFormat = Replace(TFormat, "%nv", FormatCurrency(Me.GetUMoney(Username)))
1348
1349 If ST_Streak_User = Username Then
1350 TFormat = Replace(TFormat, "%st", ST_Streak + 1)
1351 Else
1352 TFormat = Replace(TFormat, "%st", "1")
1353 End If
1354
1355 TFormat = Me.ProcessSpeed(TFormat, Speed)
1356 TFormat = Me.ProcessVars(TFormat, Username)
1357 '//Respond:
1358 ST_SQ TFormat
1359
1360 If ST_Streak_User = Username Then
1361 ST_Streak = ST_Streak + 1
1362 SQL = "SELECT `LongestStreak` FROM `users` WHERE `Username` = '" & Username & "'"
1363 SET RS = Me.DBConn.Execute(SQL)
1364 '//Beat Personal Record?
1365 If Int(RS.Fields(0)) < Int(ST_Streak) Then
1366 If ST_Streak > 2 Then
1367 SQL = "SELECT `Username`, `LongestStreak` FROM `users` ORDER BY `LongestStreak` DESC, `LastAnswer` ASC"
1368 SET RS = Me.DBConn.Execute(SQL)
1369 '//Beat the all-time record?
1370 If Int(RS.Fields(1)) < Int(ST_Streak) AND Lcase(RS.Fields(0)) <> Lcase(Username) AND ST_Streak_Con <> 2 Then
1371 ST_Streak_Con = 2
1372 TFormat = st_GetSetting("AncStreakRecord")
1373 TFormat = Replace(TFormat, "%su", RS.Fields(0))
1374 TFormat = Replace(TFormat, "%sa", RS.Fields(1))
1375 TFormat = Replace(TFormat, "%st", ST_Streak)
1376 TFormat = Me.ProcessVars(TFormat, Username)
1377 ST_SQ TFormat
1378 ElseIf ST_Streak_Con < 1 Then '//Just beat your own score
1379 ST_Streak_Con = 1
1380 TFormat = st_GetSetting("AncStreakPersonal")
1381 TFormat = Replace(TFormat, "%st", ST_Streak)
1382 TFormat = Me.ProcessVars(TFormat, Username)
1383 ST_SQ TFormat
1384 End If
1385 End If
1386 SQL = "UPDATE `users` SET `LongestStreak` = '" & ST_Streak & "' WHERE `Username` = '" & Username & "'"
1387 Me.DBConn.Execute(SQL)
1388 Else
1389 '//Used to prevent record-breaking anouncments after EVERY record broken.
1390 ST_Streak_Con = 0
1391 End If
1392 Else
1393 If ST_Streak > 2 Then
1394 TFormat = st_GetSetting("AncStreakBreak")
1395 TFormat = Replace(TFormat, "%su", ST_Streak_User)
1396 TFormat = Replace(TFormat, "%st", ST_Streak)
1397 TFormat = Me.ProcessVars(TFormat, Username)
1398 ST_SQ TFormat
1399 End If
1400 ST_Streak_User = Username
1401 ST_Streak = 1
1402 End If
1403 SQL = "SELECT `FastestAnswer` FROM `users` WHERE `Username` = '" & Username & "'"
1404 SET RS = Me.DBConn.Execute(SQL)
1405 If Int(RS.Fields(0)) > Int(Speed) Then
1406 SQL = "SELECT `Username`, `FastestAnswer` FROM `users` ORDER BY `FastestAnswer` ASC"
1407 SET RS = Me.DBConn.Execute(SQL)
1408 If Int(RS.Fields(1)) > Int(Speed) AND Lcase(RS.Fields(0)) <> Lcase(Username) Then
1409 TFormat = st_GetSetting("AncSpeedRecord")
1410 TFormat = Replace(TFormat, "%fu", RS.Fields(0))
1411 TFormat = Replace(TFormat, "%fa", RS.Fields(1))
1412 TFormat = Me.ProcessSpeed(TFormat, Speed)
1413 TFormat = Me.ProcessVars(TFormat, Username)
1414 ST_SQ TFormat
1415 Else
1416 TFormat = st_GetSetting("AncSpeedPersonal")
1417 TFormat = Replace(TFormat, "%u", Username)
1418 TFormat = Me.ProcessSpeed(TFormat, Speed)
1419 TFormat = Me.ProcessVars(TFormat, Username)
1420 ST_SQ TFormat
1421 End If
1422 '//Update record
1423 SQL = "UPDATE `users` SET `FastestAnswer` = '" & Speed & "' WHERE `Username` = '" & Username & "'"
1424 Me.DBConn.Execute(SQL)
1425 End If
1426 If st_GetSetting("blurtstats") = "True" AND ST_VQL < 2 AND Speed > 4100 Then
1427 Select Case Int(Rnd * 20) '//one in 5
1428 Case 1
1429 STAQ "ST: Top 5 scores: " & Me.TopMoney(5)
1430 Case 2
1431 STAQ "ST: Top 5 fastest answers: " & Me.TopFAnswers(5)
1432 Case 3
1433 STAQ "ST: Top 5 longest streaks: " & Me.TopLStreaks(5)
1434 Case 4
1435 STAQ "ST: Top 5 most answered: " & Me.TopMAnswers(5)
1436 End Select
1437 End If
1438 AskQuestion.Interval = st_GetSetting("AnswerDelay") + Int(ST_VQL * 2.8)
1439 AskQuestion.Enabled = True
1440
1441 End Sub
1442
1443 Public Sub DeleteUser(Username)
1444 Dim SQL
1445 SQL = "DELETE FROM `users` WHERE `Username` = '" & Username & "'"
1446 Me.DBConn.Execute(SQL)
1447 End Sub
1448
1449 '//Non-Database related Subs:
1450
1451 Public Sub UpdateProfile
1452 Dim NewProfile
1453 NewProfile = st_GetSetting("pformat")
1454 For I = 1 to 15
1455 NewProfile = Replace(NewProfile, "%hs(" & I & ")", Me.TopMoney(I))
1456 NewProfile = Replace(NewProfile, "%fa(" & I & ")", Me.TopFAnswers(I))
1457 NewProfile = Replace(NewProfile, "%ls(" & I & ")", Me.TopLStreaks(I))
1458 NewProfile = Replace(NewProfile, "%ma(" & I & ")", Me.TopMAnswers(I))
1459 Next
1460 NewProfile = Replace(NewProfile, "%hs", Me.TopMoney(1))
1461 NewProfile = Replace(NewProfile, "%fa", Me.TopFAnswers(1))
1462 NewProfile = Replace(NewProfile, "%ls", Me.TopLStreaks(1))
1463 NewProfile = Replace(NewProfile, "%ma", Me.TopMAnswers(1))
1464 NewProfile = Replace(NewProfile, "%su", ST_Streak_User)
1465 NewProfile = Replace(NewProfile, "%sc", ST_Streak)
1466 NewProfile = Replace(NewProfile, "%ch", MyChannel)
1467 '//We don't want to update the profile - unless we have new information
1468 If Me.OldProfile = NewProfile Then Exit Sub
1469 Me.OldProfile = NewProfile
1470 '//Time and vbnewline.
1471 NewProfile = Replace(NewProfile, "%lu", Time)
1472 NewProfile = Replace(NewProfile, "%nl", VBNewLine)
1473 SetBotProfile "", "", NewProfile
1474 End Sub
1475
1476 '// FUNCTIONS
1477
1478 Public Function GiveMoney(HowMuch, FromUser, ToUser, InBot)
1479 GiveMoney = False
1480 HowMuch = Round(HowMuch, 2)
1481 If InBot Then
1482 SQL = "UPDATE `users` SET `Money` = `Money` + " & HowMuch & " WHERE `Username` = '" & ToUser & "'"
1483 Me.DBConn.Execute(SQL)
1484 GiveMoney = True
1485 ElseIf HowMuch <= Me.GetUMoney(FromUser) Then
1486 If Me.GetUMoney(ToUser) <> "" Then
1487 SQL = "UPDATE `users` SET `Money` = `Money` - " & HowMuch & " WHERE `Username` = '" & FromUser & "'"
1488 Me.DBConn.Execute(SQL)
1489 SQL = "UPDATE `users` SET `Money` = `Money` + " & HowMuch & " WHERE `Username` = '" & ToUser & "'"
1490 Me.DBConn.Execute(SQL)
1491 GiveMoney = True
1492 End If
1493 End If
1494 End Function
1495
1496 Public Function ProcessVars(Text, User)
1497 Dim S
1498 S = Text
1499 S = Replace(S, "%vl", FormatCurrency(Me.GetUMoney(User)))
1500 S = Replace(S, "%intmoney", Me.GetUMoney(User))
1501 S = Replace(S, "%st", Me.GetStreak(User))
1502 S = Replace(S, "%qa", Me.GetAnswered(User))
1503 S = Replace(S, "%fa", Me.GetFastest(User))
1504 S = Replace(S, "%la", Me.GetLastAnswer(User))
1505 S = Replace(S, "%intrank", Me.GetRank(User))
1506 S = Replace(S, "%rank", Me.AddSuffix(Me.GetRank(User)))
1507 S = Replace(S, "%u", User)
1508 ProcessVars = S
1509 End Function
1510
1511 Public Function ProcessSpeed(Text, Speed)
1512 Dim S
1513 S = Text
1514 S = Replace(S, "%sps(3)", Round(Speed / 1000, 3))
1515 S = Replace(S, "%sps(2)", Round(Speed / 1000, 2))
1516 S = Replace(S, "%sps(1)", Round(Speed / 1000, 1))
1517 S = Replace(S, "%sps(0)", Round(Speed / 1000, 0))
1518 S = Replace(S, "%sps", Speed / 1000)
1519 S = Replace(S, "%spm", Speed)
1520 S = Replace(S, "%sp", Speed) '==Depreciated
1521 ProcessSpeed = S
1522 End Function
1523
1524 '//Top Stats
1525 Public Function TopMoney(TopX)
1526 Dim SQL, RS, I
1527 SQL = "SELECT `Username`, `Money` FROM `users` ORDER BY `Money` DESC"
1528 SET RS = Me.DBConn.Execute(SQL)
1529 Do While TopX > I AND RS.EOF <> True
1530 I = I + 1
1531 If TopMoney <> "" Then TopMoney = TopMoney & ", "
1532 TopMoney = TopMoney & RS.Fields(0) & ": " & FormatCurrency(RS.Fields(1))
1533 RS.MoveNext
1534 Loop
1535 End Function
1536
1537 Public Function TopFAnswers(TopX)
1538 Dim SQL, RS, I
1539 SQL = "SELECT `Username`, `FastestAnswer` FROM `users` ORDER BY `FastestAnswer` ASC"
1540 SET RS = Me.DBConn.Execute(SQL)
1541 Do While TopX > I AND RS.EOF <> True
1542 I = I + 1
1543 If TopFAnswers <> "" Then TopFAnswers = TopFAnswers & ", "
1544 TopFAnswers = TopFAnswers & RS.Fields(0) & ": " & RS.Fields(1) & "ms"
1545 RS.MoveNext
1546 Loop
1547 End Function
1548
1549 Public Function TopMAnswers(TopX)
1550 Dim SQL, RS, I
1551 SQL = "SELECT `Username`, `Answered` FROM `users` ORDER BY `Answered` DESC"
1552 SET RS = Me.DBConn.Execute(SQL)
1553 Do While TopX > I AND RS.EOF <> True
1554 I = I + 1
1555 If TopMAnswers <> "" Then TopMAnswers = TopMAnswers & ", "
1556 TopMAnswers = TopMAnswers & RS.Fields(0) & ": " & RS.Fields(1)
1557 RS.MoveNext
1558 Loop
1559 End Function
1560
1561 Public Function TopLStreaks(TopX)
1562 Dim SQL, RS, I
1563 SQL = "SELECT `Username`, `LongestStreak` FROM `users` ORDER BY `LongestStreak` DESC, `LastAnswer` ASC"
1564 SET RS = Me.DBConn.Execute(SQL)
1565 Do While TopX > I AND RS.EOF <> True
1566 I = I + 1
1567 If TopLStreaks <> "" Then TopLStreaks = TopLStreaks & ", "
1568 TopLStreaks = TopLStreaks & RS.Fields(0) & ": " & RS.Fields(1)
1569 RS.MoveNext
1570 Loop
1571 End Function
1572
1573 '//END STATS
1574
1575 Public Function GetUCount
1576 Dim SQL, RS
1577 SQL = "SELECT Count(*) FROM `users`"
1578 SET RS = Me.DBConn.Execute(SQL)
1579 GetUCount = RS.Fields(0)
1580 End Function
1581
1582 '//Block list
1583 Public Function BlockList()
1584 Dim SQL, RS, I
1585 SQL = "SELECT `Username` FROM `users` WHERE `Flags` LIKE '%B%'"
1586 SET RS = Me.DBConn.Execute(SQL)
1587 Do While 100 > I AND RS.EOF <> True
1588 I = I + 1
1589 If BlockList <> "" Then BlockList = BlockList & ", "
1590 BlockList = BlockList & RS.Fields(0)
1591 RS.MoveNext
1592 Loop
1593 End Function
1594
1595 '//Blocks a user from playing Trivia
1596 Public Sub Block(Username)
1597 Username = Me.AddSlashes(Username)
1598 Dim SQL
1599 If Not Me.GetBlocked(Username) Then
1600 SQL = "UPDATE `users` SET `Flags` = `Flags` & 'B' WHERE `Username` = '" & Username & "'"
1601 Me.DBConn.Execute(SQL)
1602 End If
1603 End Sub
1604
1605 '//Unblocks a user from playing Trivia
1606 Public Sub UnBlock(Username)
1607 Username = Me.AddSlashes(Username)
1608 Dim SQL, RS, FlagList
1609 SQL = "SELECT `Flags` FROM `users` WHERE `Flags` LIKE '%B%' AND `Username` = '" & Username & "'"
1610 SET RS = Me.DBConn.Execute(SQL)
1611 If RS.BOF = True AND RS.EOF = True Then
1612 Exit Sub
1613 Else
1614 FlagList = RS.Fields(0)
1615 Addchat VBwhite, "F: " & FlagList
1616 FlagList = Replace(FlagList, "B", "")
1617 Addchat VBwhite, "F2: " & FlagList
1618 SQL = "UPDATE `users` SET `Flags` = '" & FlagList & "' WHERE `Username` = '" & Username & "'"
1619 Me.DBConn.Execute(SQL)
1620 End If
1621 End Sub
1622
1623 '//Mimics PHP's
1624 Public Function AddSlashes(Text)
1625 Text = Replace(Text, "\", "\\")
1626 AddSlashes = Replace(Text, "'", "\'")
1627 End Function
1628 '//USER SPECIFIC FUNCTIONS
1629
1630 '//True/False - is the user blocked?
1631 Public Function GetBlocked(Username)
1632 Username = Me.AddSlashes(Username)
1633 Dim SQL, RS
1634 SQL = "SELECT `Flags` FROM `users` WHERE `Flags` LIKE '%B%' AND `Username` = '" & Username & "'"
1635 SET RS = Me.DBConn.Execute(SQL)
1636 If RS.BOF = True AND RS.EOF = True Then
1637 GetBlocked = False
1638 Else
1639 GetBlocked = True
1640 End If
1641 End Function
1642
1643 '//Returns "" if user isn't found.
1644 Public Function GetUMoney(Username)
1645 Username = Me.AddSlashes(Username)
1646 Dim SQL, RS
1647 SQL = "SELECT `Money` FROM `users` WHERE `Username` = '" & Username & "'"
1648 SET RS = Me.DBConn.Execute(SQL)
1649 If RS.BOF = True AND RS.EOF = True Then
1650 GetUMoney = ""
1651 Else
1652 GetUMoney = RS.Fields(0)
1653 End If
1654 End Function
1655
1656 '//Returns 0 if user isn't found.
1657 Public Function GetRank(Username)
1658 Username = Me.AddSlashes(Username)
1659 Dim SQL, RS, I
1660 SQL = "SELECT COUNT(*) FROM `users` WHERE `Money` >= (SELECT `Money` FROM `users` WHERE `Username` = '" & Username & "')"
1661 SET RS = Me.DBConn.Execute(SQL)
1662 GetRank = 0
1663 If RS.Fields(0) <> 0 Then GetRank = RS.Fields(0)
1664 End Function
1665
1666
1667 Public Function GetFastest(Username)
1668 Username = Me.AddSlashes(Username)
1669 Dim SQL, RS, I
1670 SQL = "SELECT `FastestAnswer` FROM `users` WHERE `Username` = '" & Username & "'"
1671 SET RS = Me.DBConn.Execute(SQL)
1672 If RS.BOF = True AND RS.EOF = True Then
1673 GetFastest = 0
1674 Else
1675 GetFastest = RS.Fields(0)
1676 End If
1677 End Function
1678
1679 '//Returns 0 if user isn't found.
1680 Public Function GetStreak(Username)
1681 Username = Me.AddSlashes(Username)
1682 Dim SQL, RS, I
1683 SQL = "SELECT `LongestStreak` FROM `users` WHERE `Username` = '" & Username & "'"
1684 SET RS = Me.DBConn.Execute(SQL)
1685 If RS.BOF = True AND RS.EOF = True Then
1686 GetStreak = 0
1687 Else
1688 GetStreak = RS.Fields(0)
1689 End If
1690 End Function
1691
1692 '//Returns 0 if user isn't found.
1693 Public Function GetAnswered(Username)
1694 Username = Me.AddSlashes(Username)
1695 Dim SQL, RS, I
1696 SQL = "SELECT `Answered` FROM `users` WHERE `Username` = '" & Username & "'"
1697 SET RS = Me.DBConn.Execute(SQL)
1698 If RS.BOF = True AND RS.EOF = True Then
1699 GetAnswered = 0
1700 Else
1701 GetAnswered = RS.Fields(0)
1702 End If
1703 End Function
1704
1705 Public Function GetLastAnswer(Username)
1706 Username = Me.AddSlashes(Username)
1707 Dim SQL, RS, I
1708 SQL = "SELECT `LastAnswer` FROM `users` WHERE `Username` = '" & Username & "'"
1709 SET RS = Me.DBConn.Execute(SQL)
1710 If RS.BOF = True AND RS.EOF = True Then
1711 GetLastAnswer = 0
1712 Else
1713 GetLastAnswer = RS.Fields(0)
1714 End If
1715 End Function
1716
1717
1718 '//Kills the @ and # names. '//Parse User
1719 Public Function PUser(Username)
1720 PUser = Username
1721 If Left(PUser, 1) = "*" Then PUser = Mid(PUser, 2)
1722 If InStr(PUser, "#") Then PUser = Mid(PUser, 1, InStr(PUser & "#", "#")-1)
1723 If InStr(PUser, "@") Then PUser = Mid(PUser, 1, InStr(PUser & "@", "@")-1)
1724 End Function
1725
1726 '//Formats a String to a URL-Accepted string.
1727 Public Function CleanURL(URL)
1728 URL = Replace(URL, "%", "%25")
1729 URL = Replace(URL, "+", "%2B")
1730 URL = Replace(URL, "#", "%23")
1731 URL = Replace(URL, " &", "%26")
1732 URL = Replace(URL, " ", "%0C")
1733 CleanURL = URL
1734 End Function
1735
1736 Public Function AddSuffix(Number)
1737 Dim Suffix
1738 Select Case Right(Number, 1)
1739 Case 1
1740 Suffix = "st"
1741 Case 2
1742 Suffix = "nd"
1743 Case 3
1744 Suffix = "rd"
1745 Case Else
1746 Suffix = "th"
1747 End Select
1748 If Number > 10 AND Number < 14 Then Suffix = "th"
1749 AddSuffix = Number & Suffix
1750 End Function
1751
1752 '//Old Subs:
1753 Public Sub MoveOldScores
1754 Dim File, LinesArray
1755 Dim SQL
1756 If NOT stFSO.FileExists(ST_USER_LOC) Then
1757 Addchat VBred, "Score file not found!"
1758 Exit Sub
1759 End If
1760
1761 Addchat VByellow, "Copying Scores..."
1762 '//Open file
1763 Set File = stFSO.OpenTextFile(ST_USER_LOC, 1, True)
1764 LinesArray = Split(File.ReadAll & vbNewLine, vbNewLine)
1765 Dim I
1766 I = 0
1767 For Each Line in LinesArray
1768 If Instr(Line, "=") > 1 Then
1769 Line = Split(Line, "=")
1770 If Me.GetUMoney(Line(0)) = "" Then
1771 SQL = "INSERT INTO `users` (`Username`, `Money`, `FastestAnswer`, `Answered`, `LongestStreak`) VALUES ('"
1772 SQL = SQL & Line(0) & "', '" & Line(1) & "', '15000', 1, 1)"
1773 Me.DBConn.Execute(SQL)
1774 I = I + 1
1775 Else
1776 Addchat VByellow, "User: " & Line(0) & ". Already in Database!"
1777 End If
1778 End If
1779 Next
1780 Addchat VByellow, I & " users have been copyed"
1781 '//Close the file, or we wont be able to delete it!
1782 File.Close
1783 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
1784 stFSO.DeleteFile ST_USER_LOC
1785 Addchat VByellow, "File deleted"
1786 Else
1787 Addchat VByellow, "File not deleted"
1788 End If
1789 End Sub
1790End Class