Useful little things., Compilation of Functions and Subs Options

[Jack]

Warcraft Icons

Author(s): rush4hire
Explanation: While decoding internet scource or statstrings for WarCraft The Frozen Throne, it will tell you which abrev. is which real icon.

CODE

Warcraftcode = array("H1", "O1", "N1", "U1", "R1", "D1", "H2", "H3", "H4", "H5", "H6", "O2", "O3", "O4", "O5", "O6", "N2", "N3", "N4", "N5", "N6", "U2", "U3", "U4", "U5", "U6", "R2", "R3", "R4", "R5", "R6", "D2", "D3", "D4", "D5", "D6")

Warcraftname = array("Peon", "Peon", "Peon", "Peon", "Peon", "Peon", "Rifleman", "Sorceress", "Spellbreaker", "Blood Mage", "Jaina", "Troll Headhunter", "Shaman", "Spirit Walker", "Shadow Hunter", "Rexxar", "Huntress", "Druid of the Talon", "Dryad", "Keeper of the Grove", "Maiev", "Crypt Fiend", "Banshee", "Destroyer", "Crypt Lord", "Sylvanas", "Myrmidon", "Siren", "Dragon Turtle", "Sea Witch", "Illidan", "Felguard", "Infernal", "Doomguard", "Pit Lord", "Archimonde")

This post has been edited by Jack: Mar 10 2006, 11:57 PM

[Jack]

Random

Author(s): Jack
Explanation: This little function randoms from x to y since there is no function like this in vbs.

CODE

Function RanNum(minimum, maximum)
 RanNum = Int(((maximum + 1) - (minimum)) * Rnd + (minimum))
End Function

This post has been edited by Jack: Mar 12 2006, 03:54 PM

[Jack]

IIf

Author(s): Unknown.
Explanation: Again, this function is not in vbs.
Usage: AddQ IIf(BeepOn = True, "Beep is currently on!", "Beep is currently off!")

CODE

Function IIf(expr, truepart, falsepart)
 IIf = falsepart
 If expr Then IIf = truepart
End Function

This post has been edited by raylu: Mar 20 2006, 06:30 PM

[rush4hire]

This may go in useful things.
Or maybe it will never be seen, ever.

But I don't know where else to post it.

These are functions and variables that would be used commonly by other scripts.

My scripts use them alot.

Two Subs would be plugged in to your event subs in script.txt

1. There's a command pre-parser that would be plugged in to UserTalk Event and Whisper Event sub, and command subs would be plugged in to that Sub. (in Whisper sub use: command_Event_UserTalk Username, Flags, Message, -5)

2. A common delay timer that would execute a line of code after x amount of time, and then turns itself off.

CODE

'1.12
'// the #include for this file should be the first one, and all the common variables, and functions should be listed here.

Public FSO, EXE, conn, dbon, qm, trg, MyUsername
Set FSO = CreateObject("Scripting.FileSystemObject")
Set EXE = CreateObject("Shell.Application")
dbon = false
qm = chr(34)' quotation mark "
trg = BotVars.Trigger
MyUsername = BotVars.Username

Public gen_delay_timer_on, gen_delay_timer, gen_delay_cmd
gen_delay_timer_on=false

'// this is your database file.
'// possibly edit this
dbpath = botpath & "db.mdb"' // if you already have an .mdb file in your bot folder you are using
'// for another database script, then you should be able to use that one.
'// end edit

'// this connects your database. If it's not there, it will create one. (thanks Swent)
If not FSO.FileExists(dbpath) Then
Set Catalog = CreateObject("ADOX.Catalog")
Catalog.Create "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine Type=5;Data Source=" & dbpath
End If
Set conn = CreateObject("ADODB.connection")
conn.ConnectionString = "Driver={Microsoft Access Driver (*.mdb)};Dbq=" & dbpath
conn.Open
dbon = true

'// typical command pre-parser sub.
'// The following 2 subs have to be plugged in to script.txt
Sub command_Event_UserTalk(Username, Flags, Message, Ping)
If left(message,1) <> trg then exit sub
GetDBentry Username, al, UserFlags
temp = split(trim(mid(Message,2))," ",2)
if ubound(temp) = 0 Then
args = ""
else
args = temp(1)
end if
pref = ""
if ping = -5 then pref = "/w "&Username&" "
lname = lcase(Username) : cmd = lcase(temp(0))
' // put calls to whatever command subs here
'poker_command Username, lname, cmd1, args, pref, al
'rpg_command lname, cmd, args, pref, al
'ttt_command Username, cmd, args, pref, al
End Sub

'// This will execute some code x amount of time.
Sub general_delay_scTimer_Timer()
If not gen_delay_timer_on Then Exit Sub
If gen_delay_timer > 0 then gen_delay_timer=gen_delay_timer-1 : Exit Sub
gen_delay_timer_on=false
Execute(gen_delay_cmd)
End Sub

'// functions
'// enter seconds and this will convert according to what user has for scTimer.Interval
Function ConvertTimer(e)
temp = scTimer.Interval/1000
ConvertTimer = round(e/temp)
End Function

'usage: if in_array(array,element) then x=y
'returns true or false
Function in_array(arr,e)
for each a in arr
if e = a then
in_array = true
Exit Function
End if
Next
in_array=false
End Function

'// gets entire content out of any file. (Thanks Darkness for these text file functions/subs)
Function ReadText(filepath)
ReadText=""
Dim File
If FSO.FileExists(filepath) Then
Set File = FSO.GetFile(filepath)
If Clng(file.size)=0 Then
exit function
End If
Set File = FSO.OpenTextFile(filepath,1)
ReadText=File.ReadAll
End If
End Function

'// subs
Sub AppendLine(filepath,text)
Set File = FSO.OpenTextFile(filepath,8,true)
File.WriteLine text
File.Close
End Sub

Sub AppendText(filepath,text)
Dim File
Set File = FSO.OpenTextFile(filepath,8,true)
File.Write text
File.Close
End Sub

Sub WriteText(filepath,text)
Dim File
Set File = FSO.OpenTextFile(filepath,2,true)
File.Write text
File.Close
End Sub

'// this will break up text that's too big, and AddQ several times. delimiter is space.
'usage: AddQ_big true/false, prefix, text
Sub AddQ_big(topad,pref,text)
if len(text) < 215 then AddQ pref&text : exit sub
bigline = split(text)
For i = 0 To UBound(bigline)
If len(pref&shortline) > 200 Then
if topad then PadQueue
AddQ pref&shortline
shortline = bigline(i)&" "
Else
shortline = shortline & bigline(i)&" "
End If
Next
if topad then PadQueue
AddQ pref&shortline
End Sub

' // database stuff ?
' // this will display a set of tables from your database.
'usage:
' to display all tables --> show_db ""
' to display 1 table -----> show_db "table_name" or show_db array("table_name")
' to display many tables -> show_db array("table1","table2","table3","etc")
Sub show_db(tables)
if not isarray(tables) then
If table="" then
tstr=""
set rs = conn.OpenSchema(20)'// This is how to find all tables in your db
do until rs.EOF
if rs.Fields(3) = "TABLE" Then tstr=tstr& ","&rs.Fields(2)
rs.moveNext
loop
tables=split(mid(tstr,2),",")
addchat vbwhite, tstr
Else
tables=array(tables)
End If
End If
o="<html><body>"
for each table in tables
on error resume next
sql="SELECT * FROM `"&table&"`"
Addchat vbyellow, sql
set rs = conn.Execute(sql)
If err <> 0 Then
o=o&"<h4>"&table&"</h4>Does not Exist<br />"
Else
o=o&"<h4>"&table&"</h4><table border="&qm&"1"&qm&" width="&qm&"100%"&qm&"><tr>"&vbcrlf
for each x in rs.Fields
o=o&"<th>"&x.name&"</th>"
next
o=o&"</tr>"&vbcrlf
do until rs.EOF
o=o&"<tr>"
for each x in rs.Fields
o=o&"<td>" & x.value & " </td>"
next
rs.MoveNext
o=o&"</tr>"&vbcrlf
loop
o=o&"</table>"
End If
next
rs.close
writetext botpath & "link.htm", o & "</body></html>"
EXE.Open botpath & "link.htm"
End Sub

[raylu]

tVar

Author: raylu
Explanation: Toggles a variable.

CODE

Function tVar(ByRef varname, ByVal cmd)
Select Case cmd
Case "on","1"
   varname = True
   tvar = " is on."
Case "off","0"
   varname = False
   tvar = " is off."
Case Else
   If varname Then
     tvar = " is on."
   Else
     tvar = " is off."
   End If
End Select
End Function

Example: http://www.quikness.com/forums/index.php?showtopic=465
Sorry it's down ATM, but it should be included with FooLOps.

This post has been edited by raylu: Nov 19 2006, 01:01 AM

[Swent]

Plugin Builder

Author: Swent
Explanation: A .vbs that builds a common plugin stucture based on user input.

To use make a .vbs file, paste in the code, hit save, and double click the file. To make a .vbs file make a new text document, and rename it "whateveryouwant.vbs". If this didn't work for you then open any folder, go to Tools > Folder Options > View, uncheck "Hide extensions for known file types", and then try again.

http://stealthbot.net/p/Users/Swent/PluginBuilder.vbs

This post has been edited by Swent: Mar 27 2007, 07:36 PM

[Hdx]

DebugOutput

Author: Grok Converted to VBS by Hdx
Explanation: Nifty Debugging Function, Originaly writtin by Grok, Converted to VBS by me.

CODE

0000:  41 42 43 44 45 46 47 48 49 4A 4B 4C 4D 4E 4F 50   ABCDEFGHIJKLMNOP
0010:  51 52 53 54 55 56 57 58 59 5A 61 62 63 64 65 66   QRSTUVWXYZabcdef
0020:  67 68 69 6A 6B 6C 6D 6E 6F 70 71 72 73 74 75 76   ghijklmnopqrstuv
0030:  77 78 79 7A 31 32 33 34 35 36 37 38 39 30         wxyz1234567890..

Code:

CODE

Function DebugOutput(sIn)
Dim x1, y1, iLen, iPos, sB, sT, sOut, Offset, sOffset
iLen = Len(sIn)
If iLen = 0 Then Exit Function
sOut = ""
Offset = 0
For x1 = 0 To ((iLen - 1) \ 16)
sOffset = Right("0000" & Hex(Offset), 4)
sB = "" 'String(48, " ")
sT = "" '"................"
For y1 = 1 To 16
iPos = 16 * x1 + y1
If iPos > iLen Then 'Exit For
sB = sB & " "
Else
sB = sB & Right("00" & Hex(Asc(Mid(sIn, iPos, 1))), 2) & " "
End If
Dim Bah
If(iPos > iLen) then
sT = sT & "."
Else
Select Case Asc(Mid(sIn, iPos, 1))
Case 0, 9, 10, 13: sT = sT & "."
Case Else: sT = sT & Mid(sIn, iPos, 1)
End Select
End If
Next
If Len(sOut) > 0 Then sOut = sOut & vbCrLf
sOut = sOut & sOffset & ": "
sOut = sOut & sB & " " & sT
Offset = Offset + 16
Next
DebugOutput = sOut
End Function

~-~(HDX)~-~

[Swent]

Copy text to clipboard

Author: DeadlyWorkz

CODE

Set objHTML = CreateObject("htmlfile")
ct = objHTML.parentWindow.clipboardData.getData("text") '// Get clipboard text
objHTML.parentWindow.clipboardData.setData "text", "This text gets copied" '// Set clipboard text

http://www.stealthbot.net/board/index.php?...st&p=173918

[DeadlyWorkz]

Sorting

Author(s): DeadlyWorkz, Swent (Obviously not the originator of the ideas - but the code compilation)
Explanation: Here are two commonly used sorting algorithms. They sort both strings and numbers.

Quick Sort
Example: DoQuickSort ArrScores, 0, UBound(ArrScores), True

CODE
Public Sub DoQuickSort(ByRef ArrayToSort, Bottom, Top, SortAsc)
    Dim strPivot, strTemp, lngBottomTemp, lngTopTemp
    Const QS_SORTASC = -1
    Const QS_SORTDESC = 1
    If SortAsc Then intOrder = QS_SORTASC Else intOrder = QS_SORTDESC
    lngBottomTemp = Bottom
    lngTopTemp = Top
    strPivot = ArrayToSort((Bottom + Top) \ 2)
    While (lngBottomTemp <= lngTopTemp)
        While (StrComp(ArrayToSort(lngBottomTemp), strPivot) = intOrder And lngBottomTemp < Top)
            lngBottomTemp = lngBottomTemp + 1
        Wend
        While (StrComp(strPivot, ArrayToSort(lngTopTemp)) = intOrder And lngTopTemp > Bottom)
            lngTopTemp = lngTopTemp - 1
        Wend
        If lngBottomTemp < lngTopTemp Then
            strTemp = ArrayToSort(lngBottomTemp)
            ArrayToSort(lngBottomTemp) = ArrayToSort(lngTopTemp)
            ArrayToSort(lngTopTemp) = strTemp
        End If
        If lngBottomTemp <= lngTopTemp Then
            lngBottomTemp = lngBottomTemp + 1
            lngTopTemp = lngTopTemp - 1
        End If
    Wend
    If (Bottom < lngTopTemp) Then DoQuickSort ArrayToSort, Bottom, lngTopTemp, SortAsc
    If (lngBottomTemp < Top) Then DoQuickSort ArrayToSort, lngBottomTemp, Top, SortAsc
End Sub

Here's an easy way to use QuickSort on a text file you need sorted. Just put it in a .vbs file, change the file path to whatever you want to sort, and double click.

CODE
'// QSort test code and conversion to VBS by Swent
'//   QSort Function by Mike Shaffer

Public qFSO

Public Const qForReading = 1
Public Const qForWriting = 2

'// << PATH TO THE FILE YOU WANT TO SORT >> 
Const q_path = "C:\Program Files\StealthBot\test.txt"

Set qFSO = CreateObject("Scripting.FileSystemObject")

'// Read unsorted text file into an array
Set File = qFSO.OpenTextFile(q_path, qForReading)  
  strList = Split(File.ReadAll, vbCrLf)  
File.Close

QSort strList, 0, UBound(strList)

'// Delete unsorted text file
If qFSO.FileExists(q_path) Then qFSO.DeleteFile(q_path)

'// Write sorted array to text file
Set File = qFSO.OpenTextFile(q_Path, qForWriting, True)  
 For i = 0 to UBound(strList)
   If strList(i) <> "" Then
     File.WriteLine strList(i)
   End If
 Next
File.close


Public Function QSort(strList, lLbound, lUbound)

 '// QSort
 '//   by Mike Shaffer 5/21/98
 '//   Copyright: Copyright *c* 1998, Mike Shaffer
 '//     Modifications for Conversion from VB to VBS by Swent 6/7/05
 '//       *modified variable declarations (removed As Long, As String, etc.)
 '//       *Replaced all "strList()" with "strList"

  Dim strTemp
  Dim strBuffer
  Dim lngCurLow
  Dim lngCurHigh
  Dim lngCurMidpoint


  lngCurLow = lLbound' Start current low and high at actual low/high
  lngCurHigh = lUbound
  

  If lUbound <= lLbound Then Exit Function ' Error!
  lngCurMidpoint = (lLbound + lUbound) \ 2 ' Find the approx midpoint of the array


  strTemp = strList(lngCurMidpoint) ' Pick as a starting point (we are making
  ' an assumption that the data *might* be
  '     
  ' in semi-sorted order already!


  Do While (lngCurLow <= lngCurHigh)


      Do While strList(lngCurLow) < strTemp
          lngCurLow = lngCurLow + 1
          If lngCurLow = lUbound Then Exit Do
      Loop


      Do While strTemp < strList(lngCurHigh)
          lngCurHigh = lngCurHigh - 1
          If lngCurHigh = lLbound Then Exit Do
      Loop


      If (lngCurLow <= lngCurHigh) Then ' if low is <= high then swap
          strBuffer = strList(lngCurLow)
          strList(lngCurLow) = strList(lngCurHigh)
          strList(lngCurHigh) = strBuffer
          '
          lngCurLow = lngCurLow + 1 ' CurLow++
          lngCurHigh = lngCurHigh - 1' CurLow--
      End If

  Loop
  

  If lLbound < lngCurHigh Then ' Recurse if necessary
      QSort strList, lLbound, lngCurHigh
  End If
  

  If lngCurLow < lUbound Then' Recurse if necessary
      QSort strList, lngCurLow, lUbound
  End If
  
End Function

Bubble Sort
Example: DoBubbleSort ArrUserList, True

CODE

Public Sub DoBubbleSort(ByRef ArrayToSort, SortAsc)
    Dim intOrder, strTemp
    Const BS_SORTASC = -1
    Const BS_SORTDESC = 1
    If SortAsc Then intOrder = BS_SORTASC Else intOrder = BS_SORTDESC

    
    For i = UBound(ArrayToSort) - 1 To 0 Step -1
        IsSorted = true
        For j = 0 to i
            If StrComp(ArrayToSort(j), ArrayToSort(j + 1)) = intOrder then
                strTemp = ArrayToSort(j + 1)
                ArrayToSort(j + 1) = ArrayToSort(j)
                ArrayToSort(j) = strTemp
                IsSorted = false
            End If
        Next
        If IsSorted = true Then Exit For
    Next
End Sub

This post has been edited by Snap: Sep 29 2007, 12:13 AM

[FiftyToo]

StringFormat

It mimics the String.Format() method in .Net, which is handy for concat'n a lot of variables.

CODE
Function StringFormat(source, params)
    Dim retval, i
    retval = source
    For i = LBound(params) To UBound(params)
        retval = Replace(retval, "{" & i & "}", params(i))
    Next
    StringFormat = retval
End Function

Here is an example of its use. Notice how clean the code is for the AddChat.

CODE
AddChat vbCyan, StringFormat("I use to live in {3} but we were attacked by {1} and {0} because we invaded {2}.", Split("Mexico|England|Japan|China", "|"))

[1:56:18 AM] I use to live in China but we were attacked by England and Mexico because we invaded Japan.

Enjoy