VB Net – Convert String to Hex/Hex to String

This blog has moved
New location: http://sim0n.wordpress.com/

Posts matching query:
[VB.Net] Hex to String Conversion
[VB.Net] String to Hex Conversion

VB Net – Randomly Move Mouse

 Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
Dim generator As New Random
Dim randomValue As Integer
Dim randomValue2 As Integer
randomValue = generator.Next(0, My.Computer.Screen.Bounds.Size.Height)
randomValue2 = generator.Next(0, My.Computer.Screen.Bounds.Size.Width)
Dim mousepos As Point
mousepos.X = randomValue
mousepos.Y = randomValue2
Windows.Forms.Cursor.Position = mousepos
End Sub

Every time the timer ticks, it will move the mouse randomly around the screen.

VB Net – Startup Remover

Create:

1) Listbox – ListBox1

2) Context Menu – ContextMenuStrip1

Two items – View Info, ToolStripMenuItem1 and Delete, DeleteToolStripMenuItem

Code:

Public Class Form1

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
For Each file As String In My.Computer.FileSystem.GetFiles(My.Computer.FileSystem.SpecialDirectories.Programs & “\Startup”)
If My.Computer.FileSystem.GetFileInfo(file).Extension = “.lnk” Then
Dim name As String = My.Computer.FileSystem.GetName(file)
name = name.Remove(name.Length – 4, 4)
ListBox1.Items.Add(“User\” & name)
End If
Next
Dim path As String = “C:\Documents and Settings\All Users\Start Menu\Programs\Startup”
For Each file As String In My.Computer.FileSystem.GetFiles(path)
If My.Computer.FileSystem.GetFileInfo(file).Extension = “.lnk” Then
Dim name As String = My.Computer.FileSystem.GetName(file)
name = name.Remove(name.Length – 4, 4)
ListBox1.Items.Add(“All Users\” & name)
End If
Next
Dim Reg As Microsoft.Win32.RegistryKey
Reg = My.Computer.Registry.CurrentUser.OpenSubKey(“Software\Microsoft\Windows\CurrentVersion\Run”, True)
For Each nod As String In Reg.GetValueNames
ListBox1.Items.Add(“Current\” & nod)
Next
Dim Reg2 As Microsoft.Win32.RegistryKey
Reg2 = My.Computer.Registry.LocalMachine.OpenSubKey(“Software\Microsoft\Windows\CurrentVersion\Run”, True)
For Each nod As String In Reg2.GetValueNames
ListBox1.Items.Add(“Machine\” & nod)
Next
End Sub

Private Sub DeleteToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DeleteToolStripMenuItem.Click
If Mid(ListBox1.SelectedItem, 1, 2) = “Cu” Then
Dim Reg
Reg = My.Computer.Registry.CurrentUser.OpenSubKey(“Software\Microsoft\Windows\CurrentVersion\Run”, True).GetValue(ListBox1.SelectedItem.ToString.Remove(0, 8))
If MessageBox.Show(“Are you sure you want to delete: ” & vbNewLine & ” ” & “HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\” & ListBox1.SelectedItem.ToString.Remove(0, & vbNewLine & ” ” & Reg, “Confirm Delete”, MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
Try
My.Computer.Registry.CurrentUser.OpenSubKey(“Software\Microsoft\Windows\CurrentVersion\Run”, True).DeleteValue(ListBox1.SelectedItem.ToString.Remove(0, 8))
MessageBox.Show(“Deleted ” & My.Computer.Registry.CurrentUser.OpenSubKey(“Software\Microsoft\Windows\CurrentVersion\Run”, True).GetValue(ListBox1.SelectedItem.ToString.Remove(0, 8)) & ” successfully”, “Done!”, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Catch ex As Exception
MessageBox.Show(“Error deleting!”, “Error”, MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End If
ElseIf Mid(ListBox1.SelectedItem, 1, 2) = “Ma” Then
Dim Reg
Reg = My.Computer.Registry.LocalMachine.OpenSubKey(“Software\Microsoft\Windows\CurrentVersion\Run”, True).GetValue(ListBox1.SelectedItem.ToString.Remove(0, 8))
If MessageBox.Show(“Are you sure you want to delete: ” & vbNewLine & ” ” & “HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\” & ListBox1.SelectedItem.ToString.Remove(0, & vbNewLine & ” ” & Reg, “Confirm Delete”, MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
Try
My.Computer.Registry.LocalMachine.OpenSubKey(“Software\Microsoft\Windows\CurrentVersion\Run”, True).DeleteValue(ListBox1.SelectedItem.ToString.Remove(0, 8))
MessageBox.Show(“Deleted ” & My.Computer.Registry.LocalMachine.OpenSubKey(“Software\Microsoft\Windows\CurrentVersion\Run”, True).GetValue(ListBox1.SelectedItem.ToString.Remove(0, 8)) & ” successfully”, “Done!”, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Catch ex As Exception
MessageBox.Show(“Error deleting!”, “Error”, MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End If
ElseIf Mid(ListBox1.SelectedItem, 1, 2) = “Us” Then
Dim name As String = ListBox1.SelectedItem.ToString.Remove(0, 4) & “.lnk”
name = My.Computer.FileSystem.SpecialDirectories.Programs & “\Startup” & name
If MessageBox.Show(“Are you sure you want to delete: ” & vbNewLine & ” ” & name, “Confirm Delete”, MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
Try
My.Computer.FileSystem.DeleteFile(name)
MessageBox.Show(“Deleted ” & name & ” successfully”, “Done!”, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Catch ex As Exception
MessageBox.Show(“Error deleting!”, “Error”, MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End If
ElseIf Mid(ListBox1.SelectedItem, 1, 2) = “Al” Then
Dim name As String = ListBox1.SelectedItem.ToString.Remove(0, 9) & “.lnk”
name = “C:\Documents and Settings\All Users\Start Menu\Programs\Startup” & name
If MessageBox.Show(“Are you sure you want to delete: ” & vbNewLine & ” ” & name, “Confirm Delete”, MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
Try
My.Computer.FileSystem.DeleteFile(name)
MessageBox.Show(“Deleted ” & name & ” successfully”, “Done!”, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Catch ex As Exception
MessageBox.Show(“Error deleting!”, “Error”, MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End If
End If
ListBox1.Items.Clear()
For Each file As String In My.Computer.FileSystem.GetFiles(My.Computer.FileSystem.SpecialDirectories.Programs & “\Startup”)
If My.Computer.FileSystem.GetFileInfo(file).Extension = “.lnk” Then
Dim name As String = My.Computer.FileSystem.GetName(file)
name = name.Remove(name.Length – 4, 4)
ListBox1.Items.Add(“User\” & name)
End If
Next
Dim path As String = “C:\Documents and Settings\All Users\Start Menu\Programs\Startup”
For Each file As String In My.Computer.FileSystem.GetFiles(path)
If My.Computer.FileSystem.GetFileInfo(file).Extension = “.lnk” Then
Dim name As String = My.Computer.FileSystem.GetName(file)
name = name.Remove(name.Length – 4, 4)
ListBox1.Items.Add(“All Users\” & name)
End If
Next
Dim Reg1 As Microsoft.Win32.RegistryKey
Reg1 = My.Computer.Registry.CurrentUser.OpenSubKey(“Software\Microsoft\Windows\CurrentVersion\Run”, True)
For Each nod As String In Reg1.GetValueNames
ListBox1.Items.Add(“Current\” & nod)
Next
Dim Reg2 As Microsoft.Win32.RegistryKey
Reg2 = My.Computer.Registry.LocalMachine.OpenSubKey(“Software\Microsoft\Windows\CurrentVersion\Run”, True)
For Each nod As String In Reg2.GetValueNames
ListBox1.Items.Add(“Machine\” & nod)
Next
End Sub

Private Sub ContextMenuStrip1_Opening(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles ContextMenuStrip1.Opening
If ListBox1.SelectedIndex > -1 Then
DeleteToolStripMenuItem.Enabled = True
ToolStripMenuItem1.Enabled = True
Else
DeleteToolStripMenuItem.Enabled = False
ToolStripMenuItem1.Enabled = False
End If
End Sub

Private Sub ToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItem1.Click
If Mid(ListBox1.SelectedItem, 1, 2) = “Cu” Then
Dim Reg
Reg = My.Computer.Registry.CurrentUser.OpenSubKey(“Software\Microsoft\Windows\CurrentVersion\Run”, True).GetValue(ListBox1.SelectedItem.ToString.Remove(0, 8))
MessageBox.Show(“Registry Key Information: ” & vbNewLine & ” ” & “HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\” & ListBox1.SelectedItem.ToString.Remove(0, & vbNewLine & ” ” & Reg, “Startup Key”, MessageBoxButtons.OK, MessageBoxIcon.Information)
ElseIf Mid(ListBox1.SelectedItem, 1, 2) = “Ma” Then
Dim Reg
Reg = My.Computer.Registry.LocalMachine.OpenSubKey(“Software\Microsoft\Windows\CurrentVersion\Run”, True).GetValue(ListBox1.SelectedItem.ToString.Remove(0, 8))
MessageBox.Show(“Registry Key Information: ” & vbNewLine & ” ” & “HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\” & ListBox1.SelectedItem.ToString.Remove(0, & vbNewLine & ” ” & Reg, “Startup Key”, MessageBoxButtons.OK, MessageBoxIcon.Information)
ElseIf Mid(ListBox1.SelectedItem, 1, 2) = “Us” Then
Dim name As String = ListBox1.SelectedItem.ToString.Remove(0, 4) & “.lnk”
name = My.Computer.FileSystem.SpecialDirectories.Programs & “\Startup” & name
MessageBox.Show(“Startup Link File Information: ” & vbNewLine & ” ” & name, “Startup Link”, MessageBoxButtons.OK, MessageBoxIcon.Information)
ElseIf Mid(ListBox1.SelectedItem, 1, 2) = “Al” Then
Dim name As String = ListBox1.SelectedItem.ToString.Remove(0, & “.lnk”
name = “C:\Documents and Settings\All Users\Start Menu\Programs\Startup” & name
MessageBox.Show(“Startup Link File Information: ” & vbNewLine & ” ” & name, “Startup Link”, MessageBoxButtons.OK, MessageBoxIcon.Information)
End If

ListBox1.Items.Clear()
For Each file As String In My.Computer.FileSystem.GetFiles(My.Computer.FileSystem.SpecialDirectories.Programs & “\Startup”)
If My.Computer.FileSystem.GetFileInfo(file).Extension = “.lnk” Then
Dim name As String = My.Computer.FileSystem.GetName(file)
name = name.Remove(name.Length – 4, 4)
ListBox1.Items.Add(“User\” & name)
End If
Next
Dim path As String = “C:\Documents and Settings\All Users\Start Menu\Programs\Startup”
For Each file As String In My.Computer.FileSystem.GetFiles(path)
If My.Computer.FileSystem.GetFileInfo(file).Extension = “.lnk” Then
Dim name As String = My.Computer.FileSystem.GetName(file)
name = name.Remove(name.Length – 4, 4)
ListBox1.Items.Add(“All Users\” & name)
End If
Next
Dim Reg1 As Microsoft.Win32.RegistryKey
Reg1 = My.Computer.Registry.CurrentUser.OpenSubKey(“Software\Microsoft\Windows\CurrentVersion\Run”, True)
For Each nod As String In Reg1.GetValueNames
ListBox1.Items.Add(“Current\” & nod)
Next
Dim Reg2 As Microsoft.Win32.RegistryKey
Reg2 = My.Computer.Registry.LocalMachine.OpenSubKey(“Software\Microsoft\Windows\CurrentVersion\Run”, True)
For Each nod As String In Reg2.GetValueNames
ListBox1.Items.Add(“Machine\” & nod)
Next
End Sub

End Class

VB Net – Flip characters (Well, replace)

Public Function Flip(ByVal str As String) As String
Dim strs As String = “”
For Each cha As Char In str.ToLower
If cha = “a” Then : cha = “ɐ”
ElseIf cha = “b” Then : cha = “q”
ElseIf cha = “c” Then : cha = “ɔ”
ElseIf cha = “d” Then : cha = “p”
ElseIf cha = “e” Then : cha = “ə”
ElseIf cha = “f” Then : cha = “ɟ”
ElseIf cha = “g” Then : cha = “ɓ”
ElseIf cha = “h” Then : cha = “ɥ”
ElseIf cha = “i” Then : cha = “!”
ElseIf cha = “j” Then : cha = “ſ”
ElseIf cha = “k” Then : cha = “ʞ”
ElseIf cha = “l” Then : cha = “l”
ElseIf cha = “m” Then : cha = “ɯ”
ElseIf cha = “n” Then : cha = “u”
ElseIf cha = “o” Then : cha = “o”
ElseIf cha = “p” Then : cha = “d”
ElseIf cha = “q” Then : cha = “Ъ”
ElseIf cha = “r” Then : cha = “ɹ”
ElseIf cha = “s” Then : cha = “s”
ElseIf cha = “t” Then : cha = “ʇ”
ElseIf cha = “u” Then : cha = “n”
ElseIf cha = “v” Then : cha = “ʌ”
ElseIf cha = “w” Then : cha = “ʍ”
ElseIf cha = “x” Then : cha = “x”
ElseIf cha = “y” Then : cha = “ʎ”
ElseIf cha = “z” Then : cha = “z”
ElseIf cha = “.” Then : cha = “˙”
ElseIf cha = “_” Then : cha = “‾”
ElseIf cha = “;” Then : cha = “؛”
ElseIf cha = “!” Then : cha = “¡”
ElseIf cha = “?” Then : cha = “¿”
ElseIf cha = “‘” Then : cha = “.”
ElseIf cha = “,” Then : cha = “‘”
ElseIf cha = “_” Then : cha = “‾”
ElseIf cha = “[" Then : cha = "]“
ElseIf cha = “]” Then : cha = “["
ElseIf cha = "{" Then : cha = "}"
ElseIf cha = "}" Then : cha = "{"
ElseIf cha = "(" Then : cha = ")"
ElseIf cha = ")" Then : cha = "("
ElseIf cha = "\" Then : cha = "/"
ElseIf cha = "/" Then : cha = "\"
ElseIf cha = ControlChars.Quote Then
strs = strs & ","
cha = ","
End If
strs = strs & cha
Next
Flip = Reverse(strs)
End Function

Usage: Flip(".[i__h4x].”)  would give, ˙[x4ɥ‾‾!]˙

Note: It uses the Reverse string function that i posted in order to reverse the flipped string

VB Net – Reverse string order

    Private Function Reverse(ByVal str As String) As String
If str.Length > 1 Then
Dim val As New System.Text.StringBuilder
For pos As Int32 = str.Length – 1 To 0 Step -1
val.Append(str.Chars(pos))
Next
Return val.ToString
Else
Return str
End If
End Function

Usage: Reverse(“i__h4x”), would give x4h__i

VB Net – Basic Mouse Info

Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Public Class Form1

<DllImport(“gdi32.dll”)> Private Shared Function GetPixel(ByVal hdc As IntPtr, ByVal nXPos As Integer, ByVal nYPos As Integer) As Integer
End Function
<DllImport(“gdi32.dll”)> Private Shared Function CreateDC(ByVal lpszDriver As String, ByVal lpszDevice As String, ByVal lpszOutput As String, ByVal lpInitData As IntPtr) As IntPtr
End Function
<DllImport(“gdi32.dll”)> Private Shared Function DeleteDC(ByVal hdc As IntPtr) As Boolean
End Function
Private Function GetPixelColor(ByVal x As Integer, ByVal y As Integer) As Color
Dim hdcScreen As IntPtr = _
CreateDC(“Display”, Nothing, Nothing, IntPtr.Zero)
Dim colorRef As Integer = GetPixel(hdcScreen, x, y)
DeleteDC(hdcScreen)
Return Color.FromArgb(colorRef And &HFF, (colorRef And &HFF00) >> 8, (colorRef And &HFF0000) >> 16)
End Function
<DllImport(“user32.dll”, SetLastError:=True)> Private Shared Function BringWindowToTop(ByVal hwnd As IntPtr) As Boolean
End Function
<DllImport(“user32.dll”, SetLastError:=True)> Private Shared Function GetActiveWindow() As IntPtr
End Function

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
PictureBox1.BackColor = Color.FromArgb(GetPixelColor(Windows.Forms.Cursor.Position.X, Windows.Forms.Cursor.Position.Y).ToArgb)
Dim screenmax As Size
screenmax.Height = My.Computer.Screen.WorkingArea.Bottom – Me.Height
screenmax.Width = My.Computer.Screen.WorkingArea.Right – Me.Width
X.Text = “X: ” & Windows.Forms.Cursor.Position.X
Y.Text = “Y: ” & Windows.Forms.Cursor.Position.Y
Z.Text = “ARGB: ” & GetPixelColor(Windows.Forms.Cursor.Position.X, Windows.Forms.Cursor.Position.Y).A & ” ” & GetPixelColor(Windows.Forms.Cursor.Position.X, Windows.Forms.Cursor.Position.Y).R & ” ” & GetPixelColor(Windows.Forms.Cursor.Position.X, Windows.Forms.Cursor.Position.Y).G & ” ” & GetPixelColor(Windows.Forms.Cursor.Position.X, Windows.Forms.Cursor.Position.Y).B
BringWindowToTop(Me.Handle.ToInt32)
Dim scs As Size
scs.Height = My.Computer.Screen.WorkingArea.Height
scs.Width = My.Computer.Screen.WorkingArea.Width
Dim locat As Point
locat = Windows.Forms.Cursor.Position
locat.X += 3
locat.Y += 3
If Windows.Forms.Cursor.Position.Y > scs.Height – Me.Height Then
If Windows.Forms.Cursor.Position.X > scs.Width – Me.Width Then
Dim sizh As Integer = Me.Height
Dim sizw As Integer = Me.Width
Dim loct2 As Point
loct2 = Windows.Forms.Cursor.Position
locat.X = Windows.Forms.Cursor.Position.X – sizw
locat.Y = Windows.Forms.Cursor.Position.Y – sizh
Me.Location = locat
Else
Dim sizh As Integer = Me.Height
Dim sizw As Integer = Me.Width
Dim loct2 As Point
loct2 = Windows.Forms.Cursor.Position
locat.X = locat.X
locat.Y = Windows.Forms.Cursor.Position.Y – sizh
Me.Location = locat
End If
ElseIf Windows.Forms.Cursor.Position.X > scs.Width – Me.Width Then
If Windows.Forms.Cursor.Position.Y > scs.Height – Me.Height Then
Dim sizh As Integer = Me.Height
Dim sizw As Integer = Me.Width
Dim loct2 As Point
loct2 = Windows.Forms.Cursor.Position
locat.X = Windows.Forms.Cursor.Position.X – sizw
locat.Y = Windows.Forms.Cursor.Position.Y – sizh
Me.Location = locat
Else

Dim sizh As Integer = Me.Height
Dim sizw As Integer = Me.Width
Dim loct2 As Point
loct2 = Windows.Forms.Cursor.Position
locat.Y = locat.Y
locat.X = Windows.Forms.Cursor.Position.X – sizw
Me.Location = locat
End If
Else
Me.Location = locat
End If
End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Timer1.Enabled = True
End Sub
End Class

Displays a box next to your cursor with the mouse location, and the colour of the pixel it is over in ARGB and as an image

VB Net – Basic MSN Logging Program

Option Strict Off
Option Explicit On
Friend Class Form1
Inherits System.Windows.Forms.Form

Public myHandle As Integer
Dim playing As Boolean
Dim timeplaying As Integer
Dim timeinit As Integer

Function WinMinePID() As Integer
Dim Processes() As System.Diagnostics.Process
”Sets the function to -1 for use in the Gamestate function
WinMinePID = -1
”Gets the process using system diagnostics
Processes = System.Diagnostics.Process.GetProcessesByName(“winmine”)
”If the process exists then it sets the function to the process ID, else the function
‘’still = -1
If Processes.Length > 0 Then WinMinePID = Processes(0).Id
End Function
Sub StatExist()
Dim fileExists As Boolean
Dim stats As String = Application.StartupPath & “/stats.txt”
fileExists = My.Computer.FileSystem.FileExists(stats)
If fileExists = True Then
Else
My.Computer.FileSystem.WriteAllText(stats, (0) & ControlChars.NewLine & 0, False)
End If
Dim times As String = Application.StartupPath & “/times.txt”
fileExists = My.Computer.FileSystem.FileExists(times)
If fileExists = True Then
Else
My.Computer.FileSystem.WriteAllText(times, 0, False)
End If
End Sub
Function GameState() As Integer
”Gamestate Function
”<—0 = Normal—>
”<—1 = Mouse Down—>
”<—2 = Lost—>
”<—3 = Won—>
”<—4 = Face Down—>

”Declerations
Dim buffer As String : Dim addr, readlen, pid As Integer
On Error Resume Next
”Set pid to the process ID of minesweeper using the WinMinePID function
pid = WinMinePID()
stat.Text = “Process Not Found”
”Checks that the process exists
If pid = -1 Then Exit Function
‘Open the proccess with permissions (1F0FFF)
myHandle = OpenProcess(&H1F0FFF, False, pid)
buffer = Space(1)
addr = &H1005160
”Reads the memory at the address above
Call ReadProcessMemory(myHandle, addr, buffer, 1, readlen)
stat.Text = “Logging…”
”Sets the function to equal the value stored at the memory location
GameState = Asc(buffer)
End Function
Sub InitialTime()
Dim times As String = Application.StartupPath & “/times.txt”
timeinit = My.Computer.FileSystem.ReadAllText(times)
End Sub
Sub WriteLog()
StatExist()
Dim gs As Integer = (GameState())
If gs = 2 Then
TimeSave()
If playing = True Then playing = False : LostSave()
ElseIf gs = 3 Then
TimeSave()
If playing = True Then playing = False : WonSave()
Dim readlen As Integer
Dim buffer As String = Space(1)
Dim addr As Integer = &H100579C
”Reads the memory at the address above
Call ReadProcessMemory(myHandle, addr, buffer, 1, readlen)
MsgBox(Asc(buffer))
Else
playing = True
End If
End Sub
Function LostLoad() As Double
StatExist()
Dim stats As String = My.Computer.FileSystem.CurrentDirectory & “/stats.txt”
Dim line As String
Dim lineno As Integer = 0
Dim reader As New IO.StringReader(My.Computer.FileSystem.ReadAllText(stats))
While True
lineno += 1
line = reader.ReadLine()
If lineno = 2 Then LostLoad = line : Exit While
End While
End Function
Sub LostSave()
StatExist()
Dim stats As String = My.Computer.FileSystem.CurrentDirectory & “/stats.txt”
Dim Won As Integer = winsl.Text
Dim Lost As Integer = lossesl.Text
Lost += 1
My.Computer.FileSystem.WriteAllText(stats, (Won) & ControlChars.NewLine & Lost, False)
lossesl.Text = Lost

Dim times As String = My.Computer.FileSystem.CurrentDirectory & “/times.txt”

LostLoad()
End Sub
Function WonLoad() As Double
StatExist()
Dim stats As String = My.Computer.FileSystem.CurrentDirectory & “/stats.txt”
Dim line As String
Dim lineno As Integer = 0
Dim reader As New IO.StringReader(My.Computer.FileSystem.ReadAllText(stats))
While True
lineno += 1
line = reader.ReadLine()
If lineno = 1 Then WonLoad = line : Exit While
End While
End Function
Sub WonSave()
StatExist()
Dim stats As String = My.Computer.FileSystem.CurrentDirectory & “/stats.txt”
Dim Won As Integer = winsl.Text
Dim Lost As Integer = lossesl.Text
Won += 1
My.Computer.FileSystem.WriteAllText(stats, (Won) & ControlChars.NewLine & Lost, False)
winsl.Text = Won
WonLoad()
End Sub

Sub TimeSave()
Dim readlen As Integer
Dim buffer As String = Space(1)
Dim addr As Integer = &H100579C
Call ReadProcessMemory(myHandle, addr, buffer, 1, readlen)
Dim times As String = Application.StartupPath & “/times.txt”
timeplaying = buffer + timeinit
MsgBox(timeplaying)
End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
WriteLog()
End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
StatExist()
winsl.Text = WonLoad()
lossesl.Text = LostLoad()
InitialTime()
End Sub

Private Sub TextChangde(ByVal sender As Object, ByVal e As System.EventArgs) Handles winsl.TextChanged, lossesl.TextChanged
If WonLoad() = 0 And LostLoad() = 0 Then
wrl.Text = 0 & “%”
Else
Dim oneperc As Double
oneperc = (WonLoad() + LostLoad()) / 100
Dim percent As Double
percent = WonLoad() / oneperc
wrl.Text = percent & “%”
End If

End Sub
End Class

Needs a lot of redoing, it works but its very inefficiently coded

VB Net – Add Menus To Minesweeper

  Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
‘*********************************************************************************’
‘***********************************Add Menus*************************************’
‘*********************************************************************************’
MenuHook.SetHook(“Minesweeper”)
Dim menus As New Collection
menus.Add(“Stats”)
menus.Add(“Cheats”)
menus.Add(“About”)
MenuHook.AddMenus(“Other”, menus)
End Sub

Then, for the menuhook class, these are the functions:

Public Class MenuHook

Private Const MF_BYCOMMAND As Integer = &H0
Private Const MF_BYPOSITION As Integer = &H400
Private Const MF_POPUP As Integer = &H10
Private Const MF_STRING As Integer = &H0
Shared Offset As Integer = 2000
Private Const WM_COMMAND As Integer = &H111S
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Declare Function AppendMenu Lib “user32″ Alias “AppendMenuA” (ByVal hMenu As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpNewItem As String) As Integer
Private Declare Function CreatePopupMenu Lib “user32″ () As Integer
Private Declare Function DrawMenuBar Lib “user32″ (ByVal hwnd As Integer) As Integer
Public Declare Function FindWindow Lib “user32″ Alias “FindWindowA” (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
Private Declare Function GetMenu Lib “user32″ (ByVal hwnd As Integer) As Integer
Private Declare Function GetSubMenu Lib “user32″ (ByVal hMenu As Integer, ByVal nPos As Integer) As Integer
Private Declare Function GetMenuState Lib “user32″ (ByVal hMenu As Integer, ByVal wID As Integer, ByVal wFlags As Integer) As Integer
Private Declare Function GetMenuItemCount Lib “user32″ (ByVal hMenu As Integer) As Integer
Private Declare Function InsertMenu Lib “user32″ Alias “InsertMenuA” (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpNewItem As String) As Integer
Private Declare Function IsWindow Lib “user32″ (ByVal hwnd As Integer) As Integer
Private Delegate Function SubClassProcDelegate(ByVal hwnd As Integer, ByVal msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Private Declare Function SetCWPMSGHook Lib “dscwpmsg” (ByVal hwnd As Integer, ByVal AdrCWP As Integer, ByVal AdrMSG As SubClassProcDelegate) As Integer
Declare Function OpenProcess Lib “kernel32″ (ByVal dwDesiredAccess As Integer, ByVal bInheritHandle As Integer, ByVal dwProcessId As Integer) As Integer
Declare Function CloseHandle Lib “kernel32″ Alias “CloseHandle” (ByVal hObject As Integer) As Integer
Declare Function ReadProcessMemory Lib “kernel32″ (ByVal hProcess As Integer, ByVal lpBaseAddress As Integer, ByVal lpBuffer As String, ByVal nSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As Integer
Private Shared hmen, hNote, hsub As Integer

Private Enum WindowStyles
WS_OVERLAPPED = &H0
WS_POPUP = &H80000000
WS_CHILD = &H40000000
WS_MINIMIZE = &H20000000
WS_VISIBLE = &H10000000
WS_DISABLED = &H8000000
WS_CLIPSIBLINGS = &H4000000
WS_CLIPCHILDREN = &H2000000
WS_MAXIMIZE = &H1000000
WS_BORDER = &H800000
WS_DLGFRAME = &H400000
WS_VSCROLL = &H200000
WS_HSCROLL = &H100000
WS_SYSMENU = &H80000
WS_THICKFRAME = &H40000
WS_GROUP = &H20000
WS_TABSTOP = &H10000
WS_MINIMIZEBOX = &H20000
WS_MAXIMIZEBOX = &H10000
WS_CAPTION = WS_BORDER Or WS_DLGFRAME
WS_TILED = WS_OVERLAPPED
WS_ICONIC = WS_MINIMIZE
WS_SIZEBOX = WS_THICKFRAME
WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW
WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
WS_POPUPWINDOW = WS_POPUP Or WS_BORDER Or WS_SYSMENU
WS_CHILDWINDOW = WS_CHILD
End Enum

Public Enum Gameover
WON = 1
LOST = 2
End Enum

Public Shared Sub AddMenus(ByVal MenuTitle As String, ByVal MenuItems As Collection)
hmen = GetMenu(hNote)
hsub = CreatePopupMenu
For Each menuitem As String In MenuItems
Offset += 1
AppendMenu(hsub, MF_STRING, Offset, menuitem)
Next
InsertMenu(hmen, 10, MF_BYPOSITION Or MF_POPUP, hsub, MenuTitle)
DrawMenuBar(hNote)
Offset = 2000
End Sub

Public Shared Sub SetHook(ByVal WindowTitle As String)
hNote = FindWindow(vbNullString, WindowTitle)
If IsWindow(hNote) = 0 Then
Do Until IsWindow(hNote)
hNote = FindWindow(WindowTitle, vbNullString)
System.Windows.Forms.Application.DoEvents()
Loop
End If
Call SetCWPMSGHook(hNote, 0, AddressOf Callback)
End Sub

Private Shared Function Callback(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Select Case wMsg
Case WM_COMMAND
Debug.Print(wParam)
If wParam = 2001 Then
MsgBox(“a”)
ElseIf wParam = 2002 Then
MsgBox(“b”)
ElseIf wParam = 2003 Then
MsgBox(“c”)
ElseIf wParam = 2004 Then
MsgBox(“d”)
End If
End Select
End Function

End Class

VB Net – Change MSN Status (Status Spam)

Public Shared Sub ChangeStatus(ByVal count As Integer)
Dim oMessenger As MessengerAPI.Messenger
oMessenger = New MessengerAPI.Messenger
Dim times As Integer = 0
Do
times += 1
oMessenger.MyStatus = MISTATUS.MISTATUS_ONLINE
System.Threading.Thread.Sleep(100)
oMessenger.MyStatus = MISTATUS.MISTATUS_INVISIBLE
System.Threading.Thread.Sleep(100)
Loop Until times = count
End Sub

Usage:  ChangeStatus(20)

VB Net – MSN Block Spam

Public Shared Sub BlockSpam(ByVal count As Integer, ByVal contact As String)
Dim done As Boolean = False
Dim oMessenger As MessengerAPI.Messenger
oMessenger = New MessengerAPI.Messenger
Dim msncontact As IMessengerContact
Dim msncontacts As IMessengerContacts
msncontacts = oMessenger.MyContacts
For Each msncontact In msncontacts
If msncontact.SigninName = contact Then
Dim times As Integer = 0
done = True
Do
times += 1
msncontact.Blocked = True
System.Threading.Thread.Sleep(400)
msncontact.Blocked = False
System.Threading.Thread.Sleep(400)
Loop Until times = count
MessageBox.Show(“Done”, “MSN Block Spam”, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End If
Next
MessageBox.Show(“Error, contact matching that email was not found”, “Error:”, MessageBoxButtons.OK, MessageBoxIcon.Error)
End Sub

Usage: BlockSpam(10, “spiderman@hotmail.com”)