StealthBot.net: Useful things - StealthBot.net

Jump to content

Page 1 of 1
  • You cannot start a new topic
  • You cannot reply to this topic

Useful things

#1 User is offline   The-Black-Ninja Icon

  • The Sex
  • Icon
  • Group: Scripting Moderators
  • Posts: 2,526
  • Joined: August-01 09

Posted October 18, 2009 - 02:34 AM

ClanOnline

Author: The-Black-Ninja
Description: Lists all online members in the bot's clan.

Private Function ClanOnline()
 
    For Each mem In Clan.Members
       If mem.IsOnline Then output = output & mem.Name & ", "
    Next
    
    If output <> vbNullString Then
       output = Left(output, Len(output)-2)
       ClanOnline = output
    Else
       ClanOnline = "None"
    End If
 End Function


#2 User is offline   The-Black-Ninja Icon

  • The Sex
  • Icon
  • Group: Scripting Moderators
  • Posts: 2,526
  • Joined: August-01 09

Posted November 02, 2009 - 01:17 AM

Icon & Tier (0x44)

Author: The-Black-Ninja
Description: Function to get a Warcraft III user's icon name and tier information when you use the 0x44 packet to gather a user's icon using DataBufferEx.GetRaw(4) method.

Private Function GetUserIcon(icon)
    
       icon = StrReverse(Lcase(icon))
       Select Case Left(icon, 1)
          Case "o": a = "Orc"
          Case "e": a = "Night Elf"
          Case "u": a = "Undead"
          Case "h": a = "Human"
          Case "n": a = "Random/Tournament"
       End Select
       
       Select Case Mid(icon, 2)
          Case "peo": b = "Peon"
       
         '// Tournament'
          '// W3XP     '
          Case "bal": b = "Doomguard"                
          Case "inf": b = "Infernal"            
          Case "fgu": b = "Felguard"
          Case "plh": b = "Pit Lord"
          Case "war": b = "Archimonde"
          '// WAR3     ' 
          Case "bwm": b = "Deathwing"
          Case "rdr": b = "Red Dragon"
          Case "adr": b = "Blue Dragon"
          Case "grd": b = "Green Dragon Whelp"
                
         '// Random    '
          Case "myr": b = "Myrmidon"
          Case "nsw": b = "Siren"      
          Case "hyc": b = "Dragon Turtle"      
          Case "vsh": b = "Sea Witch"      
          Case "evm": b = "Illidan"
          
         '// Human     '
          '// W3XP     '
          Case "rif": b = "Rifleman"
          Case "sor": b = "Sorceress"      
          Case "spt": b = "Spellbreaker"      
          Case "blm": b = "Blood Mage"
          Case "jai": b = "Jaina"
          '// WAR3     '
          Case "foo": b = "Footman"
          Case "amg": b = "Archmage"
          Case "med": b = "Medivh"
          Case "amg": b = "Archmage"
          
                
         '// Night Elf '
          '// W3XP     '
          Case "sen": b = "Huntress"  
          Case "dot": b = "Druid of the Talon"  
          Case "dry": b = "Dryad"  
          Case "kee": b = "Keeper of the Grove"              
          Case "wrd": b = "Maiev"  
          '// WAR3     '
          Case "arc": b = "Archer"  
          Case "doc": b = "Druid of the Claw"  
          Case "moo": b = "Priestess of the Moon"  
          Case "fur": b = "Furion Stormrage"  
          
                     
         '// Orc       '
          '// W3XP     '
          Case "hun": b = "Troll Headhunter"      
          Case "shm": b = "Shaman"        
          Case "spw": b = "Spirit Walker"    
          Case "shd": b = "Shadow Hunter"    
          Case "rex": b = "Rexxar"         
          '// WAR3     '
          Case "thr": b = "Thrall"         
          Case "tau": b = "Tauren"         
          Case "gru": b = "Grunt"         
          Case "amg": b = "Far Seer"         
          
         '// Undead    '
          '// W3XP     '
          Case "cry": b = "Crypt Fiend"          
          Case "ban": b = "Banshee"                
          Case "obs": b = "Destroyer"          
          Case "crl": b = "Crypt Lord"          
          Case "syl": b = "Sylvanas"          
          '// WAR3     '
          Case "gho": b = "Ghoul"          
          Case "abo": b = "Abomination"                
          Case "lic": b = "Lich"               
          Case "tic": b = "Tichondrius"                
       End Select
       
       GetUserIcon = "Tier: " & a & " - Icon: " & b
    End Function


#3 User is offline   The-Black-Ninja Icon

  • The Sex
  • Icon
  • Group: Scripting Moderators
  • Posts: 2,526
  • Joined: August-01 09

Posted November 02, 2009 - 01:17 AM

Random

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

Private Function RanNum(minimum, maximum)

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


#4 User is offline   The-Black-Ninja Icon

  • The Sex
  • Icon
  • Group: Scripting Moderators
  • Posts: 2,526
  • Joined: August-01 09

Posted November 02, 2009 - 01:33 AM

Icon Name & Tier Name

Author: The-Black-Ninja
Description: Displays a user's icon name and tier name if they are in the channel.

Private Function GetIconTier(user)
 
    iconname = Channel.Users(Channel.GetUserIndex(user)).Stats.IconName
    iconname = UCase(Left(iconname, 1)) & LCase(Right(iconname, Len(iconname)-1))
    tier = Channel.Users(Channel.GetUserIndex(user)).Stats.IconTier
 
    GetIconTier = "Icon: " & iconname & ", Tier: " & tier
 End Function


#5 User is offline   The-Black-Ninja Icon

  • The Sex
  • Icon
  • Group: Scripting Moderators
  • Posts: 2,526
  • Joined: August-01 09

Posted November 13, 2009 - 02:22 AM

SQLNOW()
Author: AbsoluteMSTR
Description: Just like NOW(), SQLNOW() but the current `datetime` in a format compliant with MySQL field type `datetime`.
Returns: String Variant
Note: You can convert the SQL `datetime` to Date simply with cDate function
Function SQLNOW()
  Dim D
  D = Now()
  SQLNOW = Year(D)&"-"&LeadingZero(Month(D),2)&"-"&LeadingZero(Day(D),2)&" "&LeadingZero(Hour(D),2)&":"&LeadingZero(Minute(D),2)&":"&LeadingZero(Second(D),2)
End Function



SQLDateTime(D)
Author: AbsoluteMSTR
Description: Converts a Date Variant in a format compliant with MySQL field type `datetime`.
Params: D = Date Variant to convert
Returns: String Variant
Note: You can convert the SQL `datetime` to Date simply with cDate function
Function SQLDateTime(D)
  SQLDateTime = Year(D)&"-"&LeadingZero(Month(D),2)&"-"&LeadingZero(Day(D),2)&" "&LeadingZero(Hour(D),2)&":"&LeadingZero(Minute(D),2)&":"&LeadingZero(Second(D),2)
End Function



LeadingZero(I,D)
Author: AbsoluteMSTR
Description: Add leading zeroes to a integer
Params: I = Integer Variant to add zeroes
Params: D = Integer Variant for number of digits
Returns: String Variant
Note: Required for SQLNOW and SQLDateTime
Function LeadingZero(I,D)
  If Len(cStr(I)) < D Then
    LeadingZero = cStr(String(D-Len(cStr(I)),"0")&cStr(I))
  Else
    LeadingZero = cStr(I)
  End If
End Function


#6 User is offline   The-Black-Ninja Icon

  • The Sex
  • Icon
  • Group: Scripting Moderators
  • Posts: 2,526
  • Joined: August-01 09

Posted November 28, 2009 - 01:00 AM

Sorting()
Author(s): DeadlyWorkz, Swent (Obviously not the originator of the ideas - but the code compilation)
Description: Various sorting algorithms to sort numbers in a paticular order.
Returns: Sorted list

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

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.

'// 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

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


#7 User is offline   The-Black-Ninja Icon

  • The Sex
  • Icon
  • Group: Scripting Moderators
  • Posts: 2,526
  • Joined: August-01 09

Posted September 04, 2010 - 05:32 PM

Infinite Array

Author: The-Black-Ninja
Description: If you script is using arrays, but you're unsure what the limit is, this function will give an unlimited 1-dimensional array size as the array grows. You must still declare your array variable at the top of the script, but do not set it as anything, for example:
Private myArray
Private Function Add2Array(value)

   If IsEmpty(myArray) Then
      Dim myArray(0)
      myArray(0) = value
   Else
      a = Ubound(myArray)
      ReDim Preserve myArray(a+1)
      myArray(a+1) = value
   End If
End Function


#8 User is offline   The-Black-Ninja Icon

  • The Sex
  • Icon
  • Group: Scripting Moderators
  • Posts: 2,526
  • Joined: August-01 09

Posted September 10, 2010 - 10:08 PM

Connecting to Databases (local & remote)

Author: Fallen-God
Description: Connection sub to create and open a connection to a MySQL Database (Remote or Local).
Note 1: You must have a MySQL server installed and configured before connecting.
Note 2: You must make a global variable to store the Object for use. I.e

Private dbConn
Sub MySQL_Connect()
     Set dbConn = CreateObject("ADODB.Connection")
     dbConn.Open "DRIVER={MySQL ODBC 5.1 Driver};" & _
      "SERVER=VALUE;" & _
      "PORT=3306;" & _
      "DATABASE=VALUE;" & _
      "USER=VALUE;" & _
      "PASSWORD=VALUE;" & _
      "Option=3"
  End Sub




Author: The-Black-Ninja
Description: Connection sub to create and open a connection to a Microsoft Access 2003- (.mdb) Database (Local Only).
Note 1: Requirements shipped with Windows.
Note 2: You must make a global variable to store the Object for use. I.e
Private dbConn


Note: If you do not have your mdb database created, this sub will create it for you.
Sub dbCreate()

   Set Catalog = CreateObject("ADOX.Catalog")
   Catalog.Create "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine Type=5;Data Source=C:\my_database.mdb"

   Call mdbConnect()

   dbConn.Execute("CREATE TABLE `myTable` (`user` VarChar(30), `Level`, INT, `Remarks` TEXT)")
End Sub


Sub mdbConnect()
    
    Set dbConn = CreateObject("ADODB.connection")
    dsn = "Driver={Microsoft Access Driver (*.mdb)};Dbq=C:\my_database.mdb"
    dbConn.ConnectionString = dsn
    
    dbConn.Open  
 End Sub


#9 User is offline   Ribose Icon

  • Fire wants to be free.
  • Icon
  • Group: Global Moderators
  • Posts: 282
  • Joined: July-31 09

Posted December 25, 2010 - 04:50 AM

Get/Set Clipboard
Description: Return or set the contents of your clipboard.

Getting:

Dim Data
Data = CreateObject("HtmlFile").Parentwindow.ClipboardData.GetData("Text")


Setting:

Dim Data
Data = (assign string to put into clipboard)
CreateObject("HtmlFile").Parentwindow.ClipboardData.SetData "Text", Data

~Ribose
[ Download ] [ Wiki ] [ Support ] [ Scripting ]
[ Chrome ] [ Notepad++ ] [ fedora ]
[ Homepage ] [ BNLS ♯ ]

Page 1 of 1
  • You cannot start a new topic
  • You cannot reply to this topic

1 User(s) are reading this topic
0 members, 1 guests, 0 anonymous users