Snippets Vault

Extracting specific piece of string between brackets:

Suppose this is the string:

"[Hello][Bye]CakeBuster[Dead]"

The following function will extract 'CakeBuster' from the above string.

[highlight=vbnet]Dim Source As String = "[Hello][Bye]CakeBuster[Dead]"
Dim _1 As Integer = Source.LastIndexOf("[")
Dim Ex1 As String = Mid(Source, 1, _1)
Dim _2 As Integer = Ex1.LastIndexOf("]") + 2
Dim FinalExtraction As String = Mid(Ex1, _2)[/highlight]

A little explanation:

Dim _1 As Integer = Source.LastIndexOf("[")

This line gets the index (number) for last "[".

Dim Ex1 As String = Mid(Source, 1, _1)

This will store the string up to last "[" but not after that.

Dim _2 As Integer = Ex1.LastIndexOf("]") + 2

Similarly this will get the last index of "]" in the new string which is Ex1 now !!

Dim FinalExtraction As String = Mid(Ex1, _2)

Finally, extract the word you need by starting the string from "]".

Here is a string manipulation library from CodeProject:

Just create a new module named 'StringFunctions' and paste the following code in it:

[highlight=vbnet]Imports System.Text

Module StringFunctions
'Retrieves the path part of a full filename
'C:\Folder\file.exe -> C:\Folder\
Public Function GetPath(ByVal Full As String) As String
For i As Integer = Full.Length - 1 To 0 Step -1
If Full.Substring(i, 1) = "\" OrElse Full.Substring(i, 1) = "/" Then 'Find the rightmost \ or /, which should be cut off the file part
Return Full.Substring(0, i) & "\"
End If
Next
Return ""
End Function

'Retrieves the name of the file from a filename
'C:\Folder\file.exe - > file
'OR
'file.exe -> file
Public Function GetName(ByVal Full As String) As String
Dim Start As Integer = GetPath(Full).Length 'If it's has path it gets how long it only the path is
Return RemoveExtension(Full.Substring(Start)) 'take of the path and the extension
End Function

'Retrieves the extension of the file from a filename
'C:\Folder\file.exe - > exe
'OR
'file.exe -> exe
Public Function GetExtension(ByVal Full As String) As String
Dim Index As Integer
For i As Integer = Full.Length - 1 To 0 Step -1
Index = Full.IndexOf(".", i) 'Find the right most . (a different technique than GetPath)
If Index > -1 Then
Return Full.Substring(Index)
End If
Next
Return ""
End Function

'Removes extension from a filename
'C:\Folder\file.exe - > C:\Folder\file
'OR
'file.exe -> file
Public Function RemoveExtension(ByVal Full As String) As String
Dim Last As Integer = Full.Length - GetExtension(Full).Length
Return Full.Substring(0, Last)
End Function

'Removes path from a filename
'C:\Folder\file.exe - > file.exe
Public Function GetFullName(ByVal Full As String) As String
Return Full.Substring(GetPath(Full).Length) 'Cut off everything up to the path
End Function

'Capitalizes a word or sentence
'word -> Word
'OR
'this is a sentence -> This is a sentence
Public Function Capitalize(ByVal [String] As String) As String
If [String].Length = 1 Then Return [String].ToUpper 'one letter just return it capitalized
Return [String].Substring(0, 1).ToUpper & [String].Substring(1) 'cut the first letter and capitalize it and then add the rest
End Function

'checks whether a word or sentence is capitalized
'Word -> True
'OR
'This is a sentence -> True
Public Function IsCapitalized(ByVal [String] As String) As Boolean
Return AscW([String].Substring(0, 1)) = AscW([String].Substring(0, 1).ToUpper) 'compare the ascii value of the first letter and a capitalized first letter
End Function

'checks whether a word or char is in lower case
'word -> True
'Word -> False
Public Function IsLower(ByVal [String] As String) As Boolean
For i As Integer = 0 To [String].Length - 1
If Not AscW([String].Substring(i, 1)) = AscW([String].Substring(i, 1).ToLower) Then Return False 'compare the asc values
Next
Return True
End Function

'checks whether a word or char is in upper case
'word -> False
'Word -> False
'WORD -> True
Public Function IsUpper(ByVal [String] As String) As Boolean
For i As Integer = 0 To [String].Length - 1
If Not AscW([String].Substring(i, 1)) = AscW([String].Substring(i, 1).ToUpper) Then Return False 'compare asc values
Next
Return True
End Function

'swaps the cases in a word
'word -> WORD
'Word -> wORD
'WoRd -> wOrD
Public Function SwapCases(ByVal [String] As String) As String
Dim ret As New StringBuilder 'StringBuilder used to be faster on bigger strings
For i As Integer = 0 To [String].Length - 1
If IsUpper([String].Substring(i, 1)) Then 'check whether it's a capital letter or not and make it the opposite
ret.Append([String].Substring(i, 1).ToLower)
Else
ret.Append([String].Substring(i, 1).ToUpper)
End If
Next
Return ret.ToString 'Take of ".ToString" if you prefer it in StringBuilder form (and change the function to StringBuilder also)
End Function

'Alternates cases between letters of a string, first letter's case stays the same
'Hi -> Hi
'longstring -> lOnGsTrInG
Public Function AlternateCases(ByVal [String] As String) As String
If [String].Length = 1 Then Return [String] 'Can't alternate if only one letter
Dim Upper As Boolean = Not IsUpper([String].Substring(0, 1)) 'start alternation depending on the first letter's case
Dim ret As New StringBuilder([String].Substring(0, 1))
For i As Integer = 1 To [String].Length - 1
If Upper Then
ret.Append([String].Substring(i, 1).ToUpper)
Else
ret.Append([String].Substring(i, 1).ToLower)
End If
Upper = Not Upper 'switch to capitalize or not
Next
Return ret.ToString
End Function

'Checks to see if a string has alternate cases
'lOnGsTrInG -> True
Public Function IsAlternateCases(ByVal [String] As String) As Boolean
If [String].Length = 1 Then Return False 'One letter strings can't be alternate cases
Dim Upper As Boolean = Not IsUpper([String].Substring(0, 1)) 'Same structure as AlternateCases function, depends on the first letter
For i As Integer = 1 To [String].Length - 1
If Upper Then
If Not IsUpper([String].Substring(i, 1)) Then Return False
Else
If IsUpper([String].Substring(i, 1)) Then Return False
End If
Upper = Not Upper
Next
Return True
End Function

'Checks for mixed upper and lower cases
'string -> False
'String -> True
Public Function IsMixedCases(ByVal [String] As String) As Boolean
Dim upper As Boolean
For i As Integer = 0 To [String].Length - 1 'look for the first letter and see if it's capitalized or not
If IsLetters([String].Substring(i, 1)) Then
upper = IsUpper([String].Substring(i, 1))
End If
Next
If [String].Length = 1 Then Return False
For i As Integer = 1 To [String].Length - 1
If IsUpper([String].Substring(i, 1)) <> upper AndAlso _
IsLetters([String].Substring(i, 1)) Then Return True 'something has a different case, then it's now mixed, ignores numbers and others
Next
Return False
End Function

'Counts total number of a char or chars in a string
'hello, l -> 2
'hello, he -> 1
Public Function CountTotal(ByVal [String] As String, ByVal [Chars] As String) As Integer
Dim Count As Integer
For i As Integer = 0 To [String].Length - 1 Step [Chars].Length
'The way String.Compare works, "Not CBool" converts it to a traditional True/False
'Compare is used to compare ignoring capitalization
If Not i + [Chars].Length > [String].Length AndAlso Not CBool(String.Compare([String].Substring(i, [Chars].Length), [Chars], True)) Then
Count += 1
End If
Next
Return Count
End Function

'Removes vowels from a word
'remove -> rmv
Public Function RemoveVowels(ByVal [String] As String) As String
Dim ret As New StringBuilder
For i As Integer = 0 To [String].Length - 1
If Not (Not CBool(String.Compare([String].Substring(i, 1), "a", True)) OrElse Not CBool(String.Compare([String].Substring(i, 1), "e", True)) OrElse _
Not CBool(String.Compare([String].Substring(i, 1), "i", True)) OrElse Not CBool(String.Compare([String].Substring(i, 1), "o", True)) OrElse _
Not CBool((String.Compare([String].Substring(i, 1), "u", True)))) Then
'only add to the final string if it doesn't match the vowels
ret.Append([String].Substring(i, 1))
End If
Next
Return ret.ToString
End Function

'Checks to see if a word contains vowels
'hello -> True
'rmv -> False
Public Function HasVowels(ByVal [String] As String) As Boolean
For i As Integer = 0 To [String].Length - 1
If (Not CBool(String.Compare([String].Substring(i, 1), "a", True)) OrElse Not CBool(String.Compare([String].Substring(i, 1), "e", True)) OrElse _
Not CBool(String.Compare([String].Substring(i, 1), "i", True)) OrElse Not CBool(String.Compare([String].Substring(i, 1), "o", True)) OrElse _
Not CBool(String.Compare([String].Substring(i, 1), "u", True))) Then
'if something equals one of the vowels then it has vowels
Return True
End If
Next
Return False
End Function

'Checks if string is nothing but spaces
'" " -> True
Public Function IsSpaces(ByVal [String] As String) As Boolean
For i As Integer = 0 To [String].Length - 1
If Not AscW([String].Substring(i, 1)) = 32 Then '32 is the asc value of a space
Return False
End If
Next
Return True
End Function

'Checks if string has only numbers
'(Since parameter is String instead of Object, it should be faster)
'12453 -> True
'234d3 -> False
Public Function IsNumeric(ByVal [String] As String) As Boolean
For i As Integer = 0 To [String].Length - 1
If Not (AscW([String].Substring(i, 1)) >= 48 AndAlso AscW([String].Substring(i, 1)) <= 57) Then 'asc value range of numbers
Return False
End If
Next
Return True
End Function

'Checks if the string contains numbers
'hello -> False
'h3llo -> True
Public Function HasNumbers(ByVal [String] As String) As Boolean
Return System.Text.RegularExpressions.Regex.IsMatch([String], "\d+")
End Function

'Checks if string is numbers and letters
'Test1254 -> True
'$chool -> False
Public Function IsAlphaNumberic(ByVal [String] As String) As Boolean
For i As Integer = 0 To [String].Length - 1
If Not (IsNumeric([String].Substring(i, 1)) OrElse _
(AscW([String].Substring(i, 1)) >= 65 AndAlso AscW([String].Substring(i, 1)) <= 90) OrElse _
(AscW([String].Substring(i, 1)) >= 97 AndAlso AscW([String].Substring(i, 1)) <= 122)) Then
'checks asc value range of lower case and upper case letters and check if it's a number, if either fail, then it's not
'only numbers and letters
Return False
End If
Next
Return True
End Function

'Checks if a string contains only letters
'Hi -> True
'Hi123 -> False
Public Function IsLetters(ByVal [String] As String) As Boolean
If IsAlphaNumberic([String]) Then 'Only numbers and letters, good
If Not IsNumeric([String]) Then 'no numbers, good
Return True
End If
End If
Return False
End Function

'Returns the initials of a name or sentence
'Capitalize - whether to make intials capitals
'ReturnSeparator - to return intials separated (True - J. S. or False - J.S.)
'John Smith -> J. S. or J.S.
Public Function Initials(ByVal [String] As String, ByVal Capitalize As Boolean, ByVal ReturnSeparator As Boolean, Optional ByVal Separator As String = " ") As String
Dim strs As String() = [String].Split(Separator) 'split all the words
For i As Integer = 0 To strs.Length - 1
'Leave only the first letter of everyword and add a . after each
If Capitalize Then
strs(i) = strs(i).Substring(0, 1).ToUpper & "."
Else
strs(i) = strs(i).Substring(0, 1) & "."
End If
Next
If ReturnSeparator Then
Return String.Join(Separator, strs)
Else
Return String.Join("", strs) 'No separator
End If
End Function

'Capitalizes the first letter of every word
'the big story -> The Big Story
Public Function Title(ByVal [String] As String, Optional ByVal Separator As String = " ") As String
Dim ret As String
If [String].IndexOf(Separator) > -1 Then
Dim strs As String() = [String].Split(Separator) 'split all the words so to capitalize the first letter of each
For i As Integer = 0 To strs.Length - 1
If strs(i).Length = 1 Then
strs(i) = strs(i).ToUpper
Else
strs(i) = strs(i).Substring(0, 1).ToUpper & strs(i).Substring(1)
End If
Next
ret = String.Join(Separator, strs) 'join them back together
End If
Return ret
End Function

'Checks whether the first letter of each word is capitalized
'The Big Story -> True
'The big story -> False
Public Function IsTitle(ByVal [String] As String, Optional ByVal Separator As String = " ") As Boolean
If [String].IndexOf(Separator) > -1 Then
Dim strs As String() = [String].Split(Separator) 'split the words to check the first letter of each word is capitalized
For i As Integer = 0 To strs.Length - 1
If Not AscW(strs(i).Substring(0, 1)) = AscW(strs(i).Substring(0, 1).ToUpper) Then Return False
Next
End If
Return True
End Function

'Checks if string is a valid emailaddress-format
'name@place.com -> True
'hahaimfaking -> False
'(Function works assuming the last part is no bigger than 3 letters (com, net, org))
Public Function IsEmailAddress(ByVal [String] As String) As Boolean
If [String].IndexOf("@") > -1 Then
For i As Integer = [String].Length - 1 To 0 Step -1
If [String].Substring(i, 1) = "." Then
If [String].Length - i <= 4 Then
Return True
End If
End If
Next
End If
Return False
End Function

'Returns all the locations of a char in a string
'Hello, l -> 2, 3
'Hello, o -> 4
Public Function IndexesOf(ByVal [String] As String, ByVal [Char] As String) As Integer()
Dim inx As New ArrayList
For i As Integer = 0 To [String].Length - 1
If [String].Substring(i, 1) = [Char] Then inx.Add(i) 'for every location found add it
Next
Dim final(in*****unt - 1) As Integer
in*****pyTo(final) 'convert the ArrayList to an Integer array
inx.Clear()
Return final
End Function

'Return a rating for how strong the string is as a password
'Max rating is 100
'Credits for original function to D. Rijmenants, this is just a vb.net version
'If there are problems with copyright or whatever, contact me and i'll delete this
Public Function PasswordStrength(ByVal [String] As String) As Integer
Dim Total As Integer
Dim Uc As Boolean
Dim Lc As Boolean

Total = [String].Length * 3
For i As Integer = 1 To [String].Length - 1
If AscW([String].Substring(i, 1)) >= 65 AndAlso AscW([String].Substring(i, 1)) <= 92 Then Uc = True 'contains uppercases
Next
For i As Integer = 1 To [String].Length - 1
If AscW([String].Substring(i, 1)) >= 97 And AscW([String].Substring(i, 1)) <= 122 Then Lc = True 'contains lowercases
Next
If Uc = True And Lc = True Then Total *= 1.2
For i As Integer = 1 To [String].Length - 1
If AscW([String].Substring(i, 1)) >= 48 And AscW([String].Substring(i, 1)) <= 57 Then 'contains numbers
If Uc = True Or Lc = True Then Total *= 1.4
Exit For
End If
Next
For i As Integer = 1 To [String].Length - 1
If AscW([String].Substring(i, 1)) <= 47 Or AscW([String].Substring(i, 1)) >= 123 Or (AscW([String].Substring(i, 1)) >= 58 And AscW([String].Substring(i, 1)) <= 64) Then
'contains some extra symbols
Total *= 1.5
Exit For
End If
Next
If Total > 100 Then Total = 100 'make sure not over 100
Return Total
End Function

'Gets the char in a string at a given position, but from right to left
'string, 0 -> g
Public Function CharRight(ByVal [String] As String, ByVal Position As Integer) As Char
Return [String].Substring([String].Length - Position - 1, 1)
End Function

'Gets the char in a string at a given position from the given starting point, reads left to right
'string, 0, 2 -> r
Public Function CharMid(ByVal [String] As String, ByVal Position As Integer, ByVal Start As Integer) As Char
If Not Start + Position > [String].Length Then
Return [String].Substring(Start + Position, 1)
Else
Return ""
End If
End Function

'Inserts a separator after every letter
'hello, - -> h-e-l-l-o
Public Function InsertSeparator(ByVal [String] As String, ByVal Separator As String) As String
Dim final As New StringBuilder
For i As Integer = 0 To [String].Length - 1
final.Append([String].Substring(i, 1) & Separator) 'after every letter add the separator
Next
Return final.ToString.Substring(0, final.Length - 1) 'Cut out last separator (h-e-l-l-o- -> h-e-l-l-o)
End Function

'Inserts a separator after every Count letters
'hello, -, 2 -> he-ll-o
Public Function InsertSeparatorEvery(ByVal [String] As String, ByVal Separator As String, ByVal Count As Integer) As String
Dim final As New StringBuilder
For i As Integer = 0 To [String].Length - 1 Step Count 'every so steps add the separator
If Not i + Count > [String].Length Then
final.Append([String].Substring(i, Count) & Separator)
Else
final.Append([String].Substring(i) & Separator)
End If
Next
Return final.ToString.Substring(0, final.Length - 1) 'Cut out last separator
End Function

'Inserts a separator at given position
'hello, -, 3 -> hel-lo
Public Function InsertSeparatorAt(ByVal [String] As String, ByVal Separator As String, ByVal Position As Integer) As String
Return [String].Substring(0, Position) & Separator & [String].Substring(Position) 'split the string at that position and add the separator
End Function

'Function that works the same way as the default Substring, but
'it takes Start and End parameters instead of Start and Length
Public Function Substring(ByVal [String] As String, ByVal Start As Integer, ByVal [End] As Integer) As String
If Start > [End] Then 'If start is after the end then just flip the values
Start = Start Xor [End]
[End] = Start Xor [End]
Start = Start Xor [End]
End If
If [End] > [String].Length Then [End] = [String].Length 'if the end is outside of the string, just make it the end of the string
Return [String].Substring(Start, [End] - Start)
End Function

'Reverses a string
'Hello -> olleH
Public Function Reverse(ByVal [String] As String) As String
Dim final As New StringBuilder
For i As Integer = [String].Length - 1 To 0 Step -1 'read the string backwards
final.Append([String].Substring(i, 1))
Next
Return final.ToString
End Function

'Splits strings, but leaves anything within quotes
'This is a "very long" string ->
'This
'is
'a
'very long
'string
Public Function Split(ByVal [String] As String, Optional ByVal DontAccountQuotes As Boolean = False, Optional ByVal Separator As String = " ") As String()
If DontAccountQuotes Then
Return [String].Split(Separator)
Else
Dim words As String() = [String].Split(Separator)
Dim newwords As New ArrayList
For i As Integer = 0 To words.Length - 1
If words(i).StartsWith("""") Then
Dim linked As New ArrayList
For y As Integer = i To words.Length - 1
If words(y).EndsWith("""") Then
linked.Add(words(y).Substring(0, words(y).Length - 1))
i = y
Exit For
Else
If words(y).StartsWith("""") Then words(y) = words(y).Substring(1)
linked.Add(words(y))
End If
Next
Dim tmp(linked.Count - 1) As String
linked.CopyTo(tmp)
If Not linked.Count = 0 Then newwords.Add(String.Join(Separator, tmp))
linked.Clear()
Erase tmp
Else
newwords.Add(words(i))
End If
Next
Dim tmp2(newwords.Count - 1) As String
newwords.CopyTo(tmp2)
newwords.Clear()
Return tmp2
End If
End Function
End Module
[/highlight]

Functions are:

GetPath(<Full Path>)
The function retrieves the path part from the full filename like, C:\Folder\file.exe -> C:\Folder\.

GetName(<Full Path>)
It retrieves the name of the file from the full filename like, C:\Folder\file.exe - > file, file.exe -> file.

GetExtension(<Full Path>)
It retrieves the extension of the file from a filename C:\Folder\file.exe - > exe, file.exe -> exe.

RemoveExtension(<Full Path>)
It removes the extension from a filename like, C:\Folder\file.exe - > C:\Folder\file, file.exe -> file.

GetFullName(<Full Path>)
It removes the path from a filename like, C:\Folder\file.exe - > file.exe.

IsCapitalized(<String>)
It checks whether a word or sentence is capitalized like, Word -> True, This is a sentence -> True.

IsLower(<String>)
It checks whether a word or character is in lower case like, word -> True, Word -> False.

IsUpper(<String>)
It checks whether a word or character is in upper case like, word -> False, Word -> False, WORD -> True.

SwapCases(<String>)
It swaps the cases in a string like, word -> WORD, Word -> wORD, WoRd -> wOrD.

AlternateCases(<String>)
It alternates the cases between letters of a string, the first letter's case stays the same like, Hi -> Hi, longstring -> lOnGsTrInG.

IsAlternateCases(<String>)
It checks to see if a string has alternate cases like, lOnGsTrInG -> True.

IsMixedCases(<String>)
It checks for mixed upper and lower cases like, string -> False, String -> True.

CountTotal(<String>, <Chars>)
It counts total number of a string or character in a string like, hello, l -> 2, hello, he -> 1.

RemoveVowels(<String>)
It removes vowels from a string like, remove -> rmv.

HasVowels(<String>)
It checks to see if a string contains vowels like, hello -> True, rmv -> False.

IsSpaces(<String>)
It checks if a string is nothing but spaces like, " " -> True.

IsNumeric(<String>)
It checks if a string has only numbers like, 12453 -> True, 234d3 -> False.
I know that there is already an existing IsNumeric function, but the existing one takes the input parameter as an Object, so in theory, this function should be faster for larger strings because it takes the input as a String.

HasNumbers(<String>)
It checks if the string contains numbers like, hello -> False, h3llo -> True.

IsAlphaNumberic(<String>)
It checks if the string has numbers and letters like, Test1254 -> True, $chool -> False.

IsLetters(<String>)
It checks if the string contains only letters like, Hi -> True, Hi123 -> False.

Initials(<String>, <Capitalize>, <ReturnSeparator>, <Optional Separator = " ">)
It returns the initials of a name or sentence.

* Capitalize- To return the initials as lower or upper case.
* ReturnSeparator - To return the initials with the original separator (John Smith, a space is the separator, so return J. S. or J.S.).
* Separator - The character that marks the separation of words (John Smith, space is the separator (default)) John Smith -> J. S.

Title(<String>, <Optional Separator = " ">)
It capitalizes the first letter of every word in the string like, the big story -> The Big Story.

IsEmailAddress(<String>)
It checks if a string is in a valid email address-format like, name@place.com -> True, hahaimfaking -> False. (The function works by assuming the last part is no bigger than 3 letters (com, net, org).)

IndexesOf(<String>, ByVal [Char] As String) As Integer()
It returns all the locations of a given char in a string like, Hello, l -> 2, 3, Hello, o -> 4.
This function works with an ArrayList and then converts it to an Integer array, if you prefer the ArrayList it can be easily modified.

CharRight(<String>, <Position>) As Char
It gets the char in a string at a given position, but from right to left like, string, 0 -> g.

CharMid(<String>, <Position>, <Start>) As Char
It gets the char in a string at a given position from a given starting point, and reads from left to right like, string, 0, 2 -> r.

InsertSeparator(<String>, <Separator As String>)
It inserts a separator after every letter like, hello, "-" -> h-e-l-l-o.

InsertSeparatorEvery(<String>, <Separator>, <Count>)
It inserts a separator after every Count letters like, hello, "-", 2 -> he-ll-o.

Substring(<String>, <Start>, <End>)
This is a function that works the same way as the default Substring, but it takes Start and End parameters instead of Start and Length.

Reverse(<String>)
It reverses a string like, Hello -> olleH.

PasswordStrength(<String>) As Integer
It is a borrowed function. It returns a rating for how strong the string is as a password. (Max rating is 100).
The credits for the original function goes to D. Rijmenants, this is just a VB.NET version. If there is any problem with copyright or whatever, contact me and I'll delete this. This is just an interesting function that took me a long time to find, so I thought it'd be useful to include it here.

Split(<String>, <Optional Don't Account for Quotes>, <Optional Separator>)
This function is newly added (on 9/27/05). Thanks to j1webb for the idea. This is just like the default Split function, but it keeps everything inside the quotes, intact. For example: 'This is a "very long" string' would return 'This', 'is', 'a', 'very long', 'string'. A limitation of this function is that if there's a quote inside quotes it will mess up. The quote symbol is " by default, but it can be changed to look for ' instead.

Hope this helps !!!

I created this class for my programming language, thought it would be useful for you guys too. Create a class named 'APIFunctions' and paste the following in it:

[highlight=vbnet]Imports System****ntime.InteropServices
Imports System.Drawing.Imaging

Public Class APIFunctions
#Region "Keyboard"
Class Keyboard
Private Const VK_NUMLOCK As Integer = &H90
Private Const VK_SCROLL As Integer = &H91
Private Declare Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Integer, _
ByVal dwExtraInfo As Integer _
)

Private Const VK_CAPITAL As Integer = &H14
Private Const KEYEVENTF_EXTENDEDKEY As Integer = &H1
Private Const KEYEVENTF_KEYUP As Integer = &H2

Public Sub num()
keybd_event(VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0)

' Simulate the Key Release
keybd_event(VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)

End Sub
Public Sub caps()
keybd_event(VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0)

' Simulate the Key Release
keybd_event(VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)


End Sub
Public Sub scr()
keybd_event(VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0)

' Simulate the Key Release
keybd_event(VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)


End Sub
End Class
Class Monitor
Public WM_SYSCOMMAND As Integer = &H112
Public SC_MONITORPOWER As Integer = &HF170
<DllImport("user32.dll")> _
Private Shared Function SendMessage(ByVal hWnd As Integer, ByVal hMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
End Function

Public Sub TurnOn()

Dim x As Int32
x = Main.Handle
SendMessage(x, WM_SYSCOMMAND, SC_MONITORPOWER, -1)

' System.Threading.Thread.Sleep(2000)
' SendMessage(Me.Handle.ToInt32(), WM_SYSCOMMAND, SC_MONITORPOWER, -1)
End Sub

Public Sub TurnOff()

Dim x As Int32
x = Main.Handle
SendMessage(x, WM_SYSCOMMAND, SC_MONITORPOWER, 2)

' System.Threading.Thread.Sleep(2000)
' SendMessage(Me.Handle.ToInt32(), WM_SYSCOMMAND, SC_MONITORPOWER, -1)
End Sub

Public Sub Lowstate()

Dim x As Int32
x = Main.Handle

SendMessage(x, WM_SYSCOMMAND, SC_MONITORPOWER, 1)

' System.Threading.Thread.Sleep(2000)
' SendMessage(Me.Handle.ToInt32(), WM_SYSCOMMAND, SC_MONITORPOWER, -1)
End Sub
End Class
Class CDROM
Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
(ByVal lpCommandString As String, ByVal lpReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Public Sub OpenCDDoor()

Dim retval As Long

retval = mciSendString("set CDAudio door open", "", 0, 0)

End Sub


Public Sub CloseCDDoor()

Dim retval As Long

retval = mciSendString("set CDAudio door closed", "", 0, 0)

End Sub
End Class
Class Wallpaper

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Integer, ByVal uParam As Integer, ByVal lpvParam As String, ByVal fuWinIni As Integer) As Integer

'constants to be used with the above api
Private Const SPI_SETDESKWALLPAPER = 20
Private Const SPIF_UPDATEINIFILE = &H1
Dim pic As New PictureBox
Public Sub main(ByVal dialog As Boolean, ByVal qu As String)

SetWall(dialog, qu)

End Sub
Dim z As String = ""

Private Sub SetWall(Optional ByVal Dialog As Boolean = True, Optional ByVal qu As String = "")
If Dialog Then
open()
End If
If c Then
Exit Sub

End If

'just some generic path and name for the image in the picturebox to save to
If Not qu = "" Then
Dim a As New PictureBox
Dim imagePath1 As String = Application.StartupPath & "\myNewWallpaper.bmp"


a.Image = Image.FromFile(qu)


a.Image.Save(imagePath1, ImageFormat.Bmp)

'set the parameters to change the wallpaper to the image you selected
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, imagePath1, SPIF_UPDATEINIFILE)
My.Computer.FileSystem.DeleteFile(imagePath1)

Exit Sub
End If

Dim imagePath As String = Application.StartupPath & "\myNewWallpaper.bmp"



pic.Image.Save(imagePath, ImageFormat.Bmp)

'set the parameters to change the wallpaper to the image you selected
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, imagePath, SPIF_UPDATEINIFILE)

End Sub
Dim c As Boolean = False

Public Sub open()
c = False

'select a image and get the path
Dim dlg As OpenFileDialog = New OpenFileDialog

dlg.Filter = "Image Files (*.bmp, *.gif, *.jpg)|*.bmp;*.gif;*.jpg"
dlg.Title = "Select the image to load."

If Not dlg.ShowDialog() = DialogResult.Cancel Then
pic.Image = Image.FromFile(dlg.FileName)
Else
c = True
End If
dlg.Dispose()
'put the selected image in the picturebox to see it


End Sub

End Class
#End Region

End Class
[/highlight]

This class has the following functions:

NumLock Toggling
CapsLock Toggling
ScrollLock Toggling

Open CD Rom
Close CD Rom

Put Monitor To Low State
Turn Off Monitor
Turn On Monitor

Change Desktop Wallpaper Via Explorer / Path

************************************************** ******

Following are some more useful functions from the same project that can be useful:

This function Breaks the code into tokens (Words), which you can analyze anyway you want.

[highlight=vbnet]Public Shared Function TokenizeLine(ByVal line As String)
Dim g As String = ""
Dim q As Boolean = False
For i As Integer = 1 To line.Length
Dim c As String = Mid(line, i, 1)
If c = """" Then
If q Then
q = False
Else
q = True
End If
End If
If q Then
g += c
Continue For
End If
If Char.IsLetter(c) Then
g += c
ElseIf Char.IsDigit(c) Then
g += c
ElseIf Char.IsWhiteSpace(c) Then
g += vbCrLf
ElseIf c = "(" Or c = ")" Or c = "+" Or c = "-" Or c = "*" Or c = "/" Or c = "." Or c = "=" Or c = "," Or c = "&" Then
g += vbCrLf & c & vbCrLf
ElseIf c = """" Then
If Not q Then
g += """"
End If
End If
Next
Dim f() As String = g.Split(ChrW(10))
Dim ic As String = ""
For Each j As String In f
If Char.IsWhiteSpace(j) Then
j = j.Replace(j, "")
End If
ic += j
Next
Return ic.Trim()


End Function[/highlight]

This function will evaluate expressions like we do in visual basic. It is capable of solving very complex mathematical expressions and supports default visual basic and C# math keywords. Just input the string which you want to solve as the only parameter. It's from MSDN.

[highlight=vbnet]Private Shared Function ProcessCommand(ByVal command As String) As Double
'Create a C# Code Provider
Dim myCodeProvider As New CSharpCodeProvider()
' Build the parameters for source compilation.
Dim cp As New CompilerParameters()
cp.GenerateExecutable = False
'No need to make an EXE file here.
cp.GenerateInMemory = True
'But we do need one in memory.
cp.OutputAssembly = "TempModule"
'This is not necessary, however, if used repeatedly, causes the CLR to not need to
'load a new assembly each time the function is run.
'The below string is basically the shell of a C# program, that does nothing, but contains an
'Evaluate() method for our purposes. I realize this leaves the app open to injection attacks,
'But this is a simple demonstration.
Dim TempModuleSource As String = ("namespace ns{" & "using System;" & "class class1{" & "public static double Evaluate(){return ") + command & ";}}} "
'Our actual Expression evaluator
Dim cr As CompilerResults = myCodeProvider.CompileAssemblyFromSource(cp, TempModuleSource)
If cr.Errors.Count > 0 Then
'If a compiler error is generated, we will throw an exception because
'the syntax was wrong - again, this is left up to the implementer to verify syntax before
'calling the function. The calling code could trap this in a try loop, and notify a user
'the command was not understood, for example.
Throw New ArgumentException("Expression cannot be evaluated, please use a valid C# expression")
Else
Dim Methinfo As MethodInfo = cr.CompiledAssembly.[GetType]("ns.class1").GetMethod("Evaluate")
Return CDbl(Methinfo.Invoke(Nothing, Nothing))
End If
End Function[/highlight]


The following function flips all windows in vista / 7 in 3D.

[highlight=vbnet]Try
Shell("C:\Windows\System32\rundll32.exe DwmApi #105")
Catch ex As Exception
MsgBox("Flip3D is only supported in Microsoft Windows Vista and Microsoft Windows 7.")
Exit Function
End Try[/highlight]

The following function sets the mouse position without any API:


[highlight=vbnet]
Cursor.Position = New System.Drawing.Point(40,345)[/highlight]

More coming soon

Here's a simple but useful one. These are 2 easy ways to convert a color from a string.

[highlight=vbnet]Color.FromName("Blue") 'Whatever color name you want in those brackets

Color.FromArgb(red value, green value, blue value) 'You could you strings or integers here[/highlight]

I wrote up this little configureable function to read between strings.

[highlight=vbnet]Imports System.IO
Imports System.Text[/highlight]

[highlight=vbnet] Public Function rb(ByVal readfrom As String, ByVal startstring As String, ByVal str1 As String, ByVal str2 As String)
Dim writeto As String
Dim s As New MemoryStream(Encoding.ASCII.GetBytes(readfrom))

Dim reader As New IO.StreamReader(s)

While Not reader.EndOfStream

writeto = reader.ReadLine()

If writeto.StartsWith(startstring) Then

Dim x1 As Integer = writeto.IndexOf(str1) + (str1.Length + 1)
Dim x2 As Integer = writeto.IndexOf(str2, x1) + 1

Dim result As String = Mid(writeto, x1, x2 - x1)

Return result

End If


End While

End Function[/highlight]

I.E. a youtube video...

Textbox1.Text = the document text of the youtube video

[highlight=vbnet]Dim views as string = rb(Textbox1.Text, "<strong class="watch-view-count">", "<strong class="watch-view-count">", "</strong>")[/highlight]

The 'startstring' thingy is optional but may come in handy in more complex strings :P.

This is my memory editing snippet. Just place this code inside a module and use it in your programs if you wish Unfortunatly, i had coded this module in vb6, so not every command will work with vb.net. You may translate if you wish, i just ask that you re-post for others to use.


~~~~~Declarations~~~~~
[highlight=vbnet] Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Dim f1holder As Integer
Dim timer_pos As Long
Dim hProcess As Long

Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal SomeValueIsStoredHere As Long, ByVal lpdwProcessId As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Object, ByVal lpBuffer As Object, ByVal nSize As Long, ByVal lpNumberOfBytesWritten As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal Classname As String, ByVal WindowName As String) As Long
Public Declare Function GetKeyPress Lib "user32" Alias "GetAsyncKeyState" (ByVal key As Long) As Integer
Public Declare Function ReadProcessMem Lib "kernel32" Alias "ReadProcessMemory" (ByVal hProcess As Long, ByVal lpBaseAddress As Object, ByRef lpBuffer As Object, ByVal nSize As Long, ByVal lpNumberOfBytesWritten As Long) As Long[/highlight]


~~~~~Module~~~~~
[highlight=vbnet] Public Function WriteALong(ByVal TheGame As String, ByVal TheAddress As Long, ByVal ThisIsTheValue As Long)
Dim SomeValueIsStoredHere As Long
Dim SomeValueIsStoredHereToo As Long
Dim SomeValue As Long
SomeValueIsStoredHere = FindWindow(vbNullString, TheGame)
GetWindowThreadProcessId(SomeValueIsStoredHere, SomeValueIsStoredHereToo)
SomeValue = OpenProcess(PROCESS_ALL_ACCESS, False, SomeValueIsStoredHereToo)
If (SomeValue = 0) Then
Exit Function
End If
WriteProcessMemory(SomeValue, TheAddress, ThisIsTheValue, 4, 0&)
CloseHandle(hProcess)
End Function[/highlight]
[highlight=vbnet] Public Function ReadALong(ByVal TheGame As String, ByVal TheAddress As Long, ByVal TheValue As Long)
Dim SomeValueIsStoredHere As Long
Dim SomeValueIsStoredHereToo As Long
Dim SomeValue As Long
SomeValueIsStoredHere = FindWindow(vbNullString, TheGame)
GetWindowThreadProcessId(SomeValueIsStoredHere, SomeValueIsStoredHereToo)
SomeValue = OpenProcess(PROCESS_ALL_ACCESS, False, SomeValueIsStoredHereToo)
If (SomeValue = 0) Then
Exit Function
End If
ReadProcessMem(SomeValue, TheAddress, TheValue, 4, 0&)
CloseHandle(hProcess)
End Function[/highlight]
[highlight=vbnet] Public Function ReadAFloat(ByVal TheGame As String, ByVal TheAddress As Long, ByVal TheValue As Single)
Dim SomeValueIsStoredHere As Long
Dim SomeValueIsStoredHereToo As Long
Dim SomeValue As Long
SomeValueIsStoredHere = FindWindow(vbNullString, TheGame)
GetWindowThreadProcessId(SomeValueIsStoredHere, SomeValueIsStoredHereToo)
SomeValue = OpenProcess(PROCESS_ALL_ACCESS, False, SomeValueIsStoredHereToo)
If (SomeValue = 0) Then
Exit Function
End If
ReadProcessMem(SomeValue, TheAddress, TheValue, 4, 0&)
CloseHandle(hProcess)
End Function[/highlight]
[highlight=vbnet] Public Function WriteAFloat(ByVal TheGame As String, ByVal TheAddress As Long, ByVal ThisIsTheValue As Single)
Dim SomeValueIsStoredHere As Long
Dim SomeValueIsStoredHereToo As Long
Dim SomeValue As Long
SomeValueIsStoredHere = FindWindow(vbNullString, TheGame)
GetWindowThreadProcessId(SomeValueIsStoredHere, SomeValueIsStoredHereToo)
SomeValue = OpenProcess(PROCESS_ALL_ACCESS, False, SomeValueIsStoredHereToo)
If (SomeValue = 0) Then
Exit Function
End If
WriteProcessMemory(SomeValue, TheAddress, ThisIsTheValue, 4, 0&)
CloseHandle(hProcess)
End Function[/highlight]


~~~~~Instructions~~~~~
Alright. In order for this to work, im gonna show you a quick example using that cheezy little Pinball game that comes with Windows XP.

lets say we turned the game on and made a button that we set the button command to this: [highlight=vbnet]
Private Sub Command1_Click()
Call WriteALong("3D Pinball for Windows, Space Cadet", &HA12EF4, 999999)
Call WriteALong("3D Pinball for Windows, Space Cadet", &HB8AEBA, 999999)
End Sub
[/highlight]

Basically what the code means, is that i Called the function "WriteALong" from the module that is just above. "3D Pinball for Windows, Space Cadet" is the window title, &HB8AEBA is the address. "999999" is the value you set that specific address to.

*Note: Add &H instead of the 2 00 (two zero's), Here's an example: Your address is 00L1FD4. You need to replace the 00 (two zero's) with an &H , then you would get this: &HL1FD4. If there is only 1 0 at the beginning then just replace it with an &. If there are no zero's at the beginning then this rule does not apply.


And thats it!

oh and p.s. This is basically how people use VB and make trainers for games and such.

Reading the header of a .mp3 file to get the Artist/Year/Album/Title.

Create the following class:

[highlight=vbnet]Imports System.IO

Public Class MP3TagData

Private _Artist As String
Private _SongTitle As String
Private _Album As String
Private _Year As String

Public ReadOnly Property Artist() As String
Get
Return _Artist
End Get
End Property

Public ReadOnly Property SongTitle() As String
Get
Return _SongTitle
End Get
End Property

Public ReadOnly Property Album() As String
Get
Return _Album
End Get
End Property

Public ReadOnly Property Year() As String
Get
Return _Year
End Get
End Property

Public Sub ReadFromFile(ByVal filename As String)
' Bereits vorhandene Werte l?schen.
Me._SongTitle = ""
Me._Artist = ""
Me._Album = ""
Me._Year = ""
Dim fs As New FileStream(filename, FileMode.Open)
' MP3-Tag lesen.
fs.Seek(0 - 128, SeekOrigin.End)
Dim Tag(2) As Byte
fs.Read(Tag, 0, 3)
' ?berpr?fen, ob ein Tag vorhanden ist.
If System.Text.Encoding.ASCII.GetString(Tag).Trim() = "TAG" Then
' Titel.
Me._SongTitle = GetTagData(fs, 30)
' K?nstler.
Me._Artist = GetTagData(fs, 30)
' Album.
Me._Album = GetTagData(fs, 30)
' Jahr.
Me._Year = GetTagData(fs, 4)
End If
fs.Close()
End Sub

Private Function GetTagData(ByVal stream As Stream, _
ByVal length As Integer) As String
' Daten lesen.
Dim Bytes(length - 1) As Byte
stream.Read(Bytes, 0, length)
Dim TagData As String = System.Text.Encoding.ASCII.GetString(Bytes)
' Nullen abschneiden.
Dim TrimChars() As Char = {Char.Parse(" "), Char.Parse(vbNullChar)}
TagData = TagData.Trim(TrimChars)
Return TagData
End Function

End Class[/highlight]

On button click_event or wherever:

[highlight=vbnet] Dim MP3Tag As New MP3TagData
Dim Dateiname As String = "C:\test.mp3"

Try
MP3Tag.ReadFromFile(Dateiname)
Catch ex As Exception
MsgBox(ex.Message.ToString)
End Try


Dim album As String = MP3Tag.Album
Dim artist As String = MP3Tag.Artist
Dim title As String = MP3Tag.SongTitle
Dim year As String = MP3Tag.Year[/highlight]

@Above, I'd suggest using Phenix module since it is working with the process and not with the window name.

Here is a module with code for encrypting and decrypting strings.

Here is another module. This time its for setting debug privileges in the case that you dont have them.
And here is a module for DLL injection on 32-Bit OS's

Extracting Youtube Download Link:

First add this function:

Then this sub-procedure:
'Remember to give credits to FlameXaber
Then call it from whereever you want like:

Snap Form To Screen Borders:

This feature allows you to drag your window near the screen border and have the window automatically get pulled towards that border like a magnet. It's Perry Marchant's implementation of VB.NET.

■ Import this namespace to the form:

[highlight=vb.net]Imports system****ntime.InteropServices[/highlight]

■ Declare the following:

[highlight=vb.net] Private Const mSnapOffset As Integer = 35
Private Const WM_WINDOWPOSCHANGING As Integer = &H46

<StructLayout(LayoutKind.Sequential)> _
Public Structure WINDOWPOS
Public hwnd As IntPtr
Public hwndInsertAfter As IntPtr
Public x As Integer
Public y As Integer
Public cx As Integer
Public cy As Integer
Public flags As Integer
End Structure
[/highlight]

■ After that add these sub-procedures to the program:
[highlight=vb.net]Protected Overrides Sub WndProc(ByRef m As Message)
' Listen for operating system messages
Select Case m.Msg
Case WM_WINDOWPOSCHANGING
SnapToDesktopBorder(Me, m.LParam, 0)
End Select

MyBase.WndProc(m)
End Sub

Public Shared Sub SnapToDesktopBorder(ByVal clientForm As Form, ByVal LParam As IntPtr, ByVal widthAdjustment As Integer)
If clientForm Is Nothing Then
' Satisfies rule: Validate parameters
Throw New ArgumentNullException("clientForm")
End If

' Snap client to the top, left, bottom or right desktop border
' as the form is moved near that border.

Try
' Marshal the LPARAM value which is a WINDOWPOS struct
Dim NewPosition As New WINDOWPOS
NewPosition = CType(Runtime.InteropServices.Marshal.PtrToStructu re( _
LParam, GetType(WINDOWPOS)), WINDOWPOS)

If NewPosition.y = 0 OrElse NewPosition.x = 0 Then
Return ' Nothing to do!
End If

' Adjust the client size for borders and caption bar
Dim ClientRect As Rectangle = clientForm.RectangleToScreen(clientForm.ClientRect angle)
ClientRect.Width += SystemInformation.FrameBorderSize.Width - widthAdjustment
ClientRect.Height += (SystemInformation.FrameBorderSize.Height + SystemInformation.CaptionHeight)

' Now get the screen working area (without taskbar)
Dim WorkingRect As Rectangle = Screen.GetWorkingArea(clientForm.ClientRectangle)

' Left border
If NewPosition.x >= WorkingRect.X - mSnapOffset AndAlso _
NewPosition.x <= WorkingRect.X + mSnapOffset Then
NewPosition.x = WorkingRect.X
End If

' Get screen bounds and taskbar height (when taskbar is horizontal)
Dim ScreenRect As Rectangle = Screen.GetBounds(Screen.PrimaryScreen.Bounds)
Dim TaskbarHeight As Integer = ScreenRect.Height - WorkingRect.Height

' Top border (check if taskbar is on top or bottom via WorkingRect.Y)
If NewPosition.y >= -mSnapOffset AndAlso _
(WorkingRect.Y > 0 AndAlso NewPosition.y <= (TaskbarHeight + mSnapOffset)) OrElse _
(WorkingRect.Y <= 0 AndAlso NewPosition.y <= (mSnapOffset)) Then
If TaskbarHeight > 0 Then
NewPosition.y = WorkingRect.Y ' Horizontal Taskbar
Else
NewPosition.y = 0 ' Vertical Taskbar
End If
End If

' Right border
If NewPosition.x + ClientRect.Width <= WorkingRect.Right + mSnapOffset AndAlso _
NewPosition.x + ClientRect.Width >= WorkingRect.Right - mSnapOffset Then
NewPosition.x = WorkingRect.Right - (ClientRect.Width + SystemInformation.FrameBorderSize.Width)
End If

' Bottom border
If NewPosition.y + ClientRect.Height <= WorkingRect.Bottom + mSnapOffset AndAlso _
NewPosition.y + ClientRect.Height >= WorkingRect.Bottom - mSnapOffset Then
NewPosition.y = WorkingRect.Bottom - (ClientRect.Height + SystemInformation.FrameBorderSize.Height)
End If

' Marshal it back
Runtime.InteropServices.Marshal.StructureToPtr(New Position, LParam, True)
Catch ex As ArgumentException
End Try
End Sub[/highlight]

You're done

It's a piece of snippet ppl2pass requested me. I was unable to deliver him on MSN coz of internet issues:


Use this function to convert each value to hex:

Calculating the md5 checksum of a file(used it for my md5 updater):