Useful Functions and Subs

[Hero]

When posting here please use the correct format:

[size=]Name[/size]

Author:
Use:
Additional Notes: Optional
Example: Optional

Copy version:

Code: [Select]

[size=4][b]Name[/b][/size]

[b]Author:[/b]
[b]Use:[/b]
[b]Additional Notes:[/b] [i]Optional[/i]
[b]Example:[/b] [i]Optional[/i]

-----

[size=]File Handling[/size]

[size=]LaunchFile[/size]

Author: Hero
Use: Launches a file using WScript.Shell

Code: [Select]

Sub LaunchFile(Path)
  Set WshShell = WScript.CreateObject("WScript.Shell")
  If Right(Path, 3) = "exe" Then
    Call WshShell.Exec(Path)
  Else
    Call WshShell.Run(Path)
  End If
End Sub
[size=]Array Operators[/size]

[size=]AddToArray[/size]

Author: Hero
Use: Adds an item to an array
Additional Notes: I know you can do this with ReDim preserve but I found this easier. This will also handle things that aren't an array.
Example:

Code: [Select]

arrTest = AddToArray(arrTest, "First Item")
arrTest = AddToArray(arrTest, "Second Item")

Code: [Select]

Function AddToArray(Arr, Item)
  If Not IsArray(Arr) Then
    AddToArray = Array(Item)
  Else
    For i = LBound(Arr) To UBOund(Arr)
      Str = Str & Arr(i) & "|"
    Next
    Str = Str & Item
    AddToArray = Split(Str, "|")
  End IF
End Function
[size=]RemoveFromArray[/size]

Author: Vector
Use: Removes an element from an array, based on an index

Code: [Select]

Function RemoveFromArray(index, array)
  If Not isArray(array) Then Exit Function
  If index > Ubound(array) Then Exit Function
  array(index) = ""

  For i=0 to Ubound(array)
    If array(i) <> "" Then str = str & array(i) & "|"
  Next
  str = Left(str, Len(str) - 1))

  RemoveFromArray = Split(str, "|")
End Function
[size=]InArray[/size]

Author: Hero
Use: Checks if an item is in an array
Additional Notes: Not case sensitive

Code: [Select]

Function InArray(Arr, Item)
  If Not IsArray(Arr) Then
    InArray = False
  Else
    Found = False
    For i = LBound(Arr) To UBOund(Arr)
      If LCase(Arr(i)) = LCase(Item) Then
        Found = True
      End If
    Next
    InArray = Found
  End If
End Function
[size=]JoinB[/size]

Author: Vector
Use: Returns a joined array (string) separating each element with a specified string
Additional Notes: Like the VBScript Join() function, but does not return null elements. Excellent for array testing.
Example:

Code: [Select]

arrTest = JoinB(Array("test", "", "", "this is a test"), ", ")

Code: [Select]

Function JoinB(arr, joinWith)
  For i=0 to Ubound(arr)
    If arr(i) <> "" Then
      str = str & arr(i) & joinWith
    End If
  Next
  str = Left(str, Len(str) - Len(joinWith))

  JoinB = str
End Function
[size=]Product Parsing[/size]

[size=]GetProduct[/size]

Author: Hero
Use: Checks if a string is a battle.net product
Additional Notes: Will return the long version of the product if it is one, vbNullString otherwise

Code: [Select]

war3 = GetProduct("WAR3")
If Not war3 = vbNullString Then
  AddQ "WAR3 = " & war3
End If

Code: [Select]

Function GetProduct(Item)
  Item = LCase(Item)
  Value = vbNullString
  Products = Array("war3", "d2dv", "sexp", "star", "w3xp", "d2xp", "w2bn")
  lngProducts = Array("Warcraft 3", "Diablo 2", "Starcraft Brood War", "Starcraft", "Warcraft 3 The Frozen Throne", "Diablo 2 Lord of Destruction", "Warcraft 2 Battle.net Edition"
  For i = 0 To UBound(Products)
    If Products(i) = Item Then
      Value = lngProducts(i)
    End If
  Next
  IsProduct = Value
End Function
[size=]String Operators[/size]

[size=]IsChar[/size]

Author: Vector
Use: Returns True if the character is an alphanumeric character, otherwise returns False

Code: [Select]

Function IsChar(charact)
  charact = lcase(charact)
  if Asc(charact) >= 97 and Asc(charact) <= 122 then
    IsChar = true
  else
    IsChar = false
  end if
End Function
[size=]ASCTotal[/size]

Author: Vector
Use: Returns the ascii value of the given string

Code: [Select]

Function ASCTotal(str)
  for i=0 to len(str)-1
    tempChar = mid(str, i+1, 1)
    total = total + Asc(tempChar)
  next
  ASCTotal = total
End Function
[size=]Integer Operators[/size]

[size=]Random[/size]

Author: Jack
Use: Randomizes a number from x to y

Code: [Select]

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

[Hero]

[size=]Loop Through Folders/Files[/size]

Author: Unknown - Edited by Hero
Use: Loops through all sub folders and files starting from a root directory

Code: [Select]

Dim arrFolder()
Dim arrFile()
ReDim arrFolder(-1)
ReDim arrFile(-1)

sRootPath = "C:\Program Files"
ShowFolderList(sRootPath)

Sub ShowFolderList(sPath)
    Dim objFSO, file

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set folder = objFSO.GetFolder(sPath)

    For Each file In folder.Files
        Call AddItem(arrFile, sPath & "\" & file.Name)
    Next

    For Each subfolder In folder.SubFolders
        Call ShowSubFolderList(subfolder, sPath)
    Next

    For Each sFolder In arrFolder
      '// This is your folder output
      MsgBox sFolder
    Next


    For Each sFile In arrFile
      '// This is your file output
      MsgBox sFile
    Next

    Set file = Nothing
    Set objFSO = Nothing

End Sub

Sub ShowSubFolderList(fld, sParent)

    i = 0
    For Each subfld In fld.SubFolders
        Call ShowSubFolderList(subfld, sParent & "\" & fld.Name)
        i = i + 1
    Next

    If i = 0 Then
        Call AddItem(arrFolder, sParent & "\" & fld.name)
    End If

    For Each fil In fld.Files
        Call AddItem(arrFile, sParent & "\" & fld.name & "\" & fil.Name)
    Next

End Sub

Sub AddItem(ByRef arrTemp, addValue)
    ReDim Preserve arrTemp(UBound(arrTemp)+1)
    arrTemp(UBound(arrTemp)) = addValue
End Sub