VB Net – Mouse Macro Basics

Got bored so I’ve decided that I’m going to make a little macro program, and ill post the updates here.

Currently, I’ve got the basic structure and events working and I’ve tested it on a reactions tester to see how efficient it was.

Currently, it’s started using a HotKey, and detects the message and starts a background worker.

Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)

MyBase.WndProc(m)

If m.Msg = WM_HOTKEY Then

If BackgroundWorker1.IsBusy = False Then

BackgroundWorker1.RunWorkerAsync()

stops = False

Else

stops = True

End If

ElseIf m.Msg = WM_QUERYENDSESSION Then

stops = True

Application.Exit()

End If

End Sub

The stops is a global Boolean and is in there as a separate way to end the macro’s loop, in case something has gone wrong. The first press of the HotKey starts the macro, the second ends it.

ElseIf m.Msg = WM_QUERYENDSESSION Then

Is just in there if the message detected is the Windows Shutdown message, the application closes and ends the loop

Now, we have to look at how exactly we are going to create our mouse functions. Firstly, let’s look at the basic mouse click:

I’m carrying out this function using the mouse_event library:

Private Declare Sub mouse_event Lib “user32″ (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

This is used with the below mouse event constants:

Const MOUSEEVENTF_MOVE As Int32 = &H1

Const MOUSEEVENTF_LEFTDOWN As Int32 = &H2

Const MOUSEEVENTF_LEFTUP As Int32 = &H4

Const MOUSEEVENTF_RIGHTDOWN As Int32 = &H8

Const MOUSEEVENTF_RIGHTUP As Int32 = &H10

Const MOUSEEVENTF_MIDDLEDOWN As Int32 = &H20

Const MOUSEEVENTF_MIDDLEUP As Int32 = &H40

Const MOUSEEVENTF_ABSOLUTE As Int32 = &H8000

Const MOUSEEVENTF_WHEEL As Int32 = &H800

For the sake of ease, we will only be using the dwFlags option of the mouse_events library, in order to peform a mouse click.

For a left mouse click:

mouse_event(MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)

This will click the mouse at the cursors current location.

Next, we will look at moving the mouse to specified coordinates.

This isn’t hard, you can either move the mouse using the mouse_event library or you can set the cursor location like this:

Windows.Forms.Cursor.Position = New Point(700, 600)

This will move the mouse location to the specified point on the screen.

Next what we will look at is Pixel colour detection. This is done using the GetPixel and CreateDC API:

<Runtime.InteropServices.DllImport(“gdi32.dll”)> Private Shared Function GetPixel(ByVal hdc As IntPtr, ByVal nXPos As Integer, ByVal nYPos As Integer) As Integer

End Function

<Runtime.InteropServices.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

<Runtime.InteropServices.DllImport(“gdi32.dll”)> Private Shared Function DeleteDC(ByVal hdc As IntPtr) As Boolean

End Function

We create a function in order to easily provide us with information on the pixel colour:

Private Function GetPixelColor(ByVal x As Integer, ByVal y As Integer) As Color

”This gets the pixel colour from the specified x/y coordinates

Dim Scrn_hdc As IntPtr = CreateDC(“Display”, Nothing, Nothing, IntPtr.Zero)

”Display being the name of the driver (Aka the screen display)

Dim Colour As Integer = GetPixel(Scrn_hdc, x, y)

”Gets pixel information from this hdc

DeleteDC(Scrn_hdc)

Return Color.FromArgb(Colour And &HFF, (Colour And &HFF00) >> 8, (Colour And &HFF0000) >> 16)

”Returns the colour value

End Function

We now have everything we need to create a basic pixel checker.

Now, back to the Background Worker. This is where we will do the pixel checking, on a loop

Private Sub BackgroundWorker1_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork

Dim count As Integer = 0

Do

If GetPixelColor(530, 540) <> Color.FromArgb(255, 255, 0, 0) Then

”Waits for the colour at that point to change from Red

Windows.Forms.Cursor.Position = New Point(530, 540)

”Moves the mouse cursor

mouse_event(MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)

‘ mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)

”Clicks the mouse

count += 1

”Adds one to count

Windows.Forms.Cursor.Position = New Point(700, 600)

”Moves the mouse cursor out of the way

System.Threading.Thread.Sleep(50)

”Sleeps the thread

If count = 5 Then

”If its done 5 clicks, it sets stops to true

stops = True

End If

End If

System.Threading.Thread.Sleep(1)

”Pause the loop

Loop Until stops = True ‘

‘Loop until stops is true, either set when count = 5 or externally

End Sub

This is just a basic example. It checks the pixel colour at 530,540 and if it is not Red it moves the mouse to that location and clicks. It then moves the mouse off of that location and adds one to the loop.

If the loop has been carried out 5 times, it then sets stops to true and the macro is stopped.

VB Net – MSN Xfire Personal Message

Imports System.Runtime.InteropServices

Public Class Form1

#Region “APIS+CONST”

”Here are the API Functions needed

<DllImport(“User32.dll”)> Private Shared Function EnumChildWindows(ByVal WindowHandle As IntPtr, ByVal Callback As EnumWindowProcess, ByVal lParam As IntPtr) As Boolean

End Function

<DllImport(“user32.dll”, CharSet:=CharSet.Auto)> Private Shared Sub GetClassName(ByVal hWnd As System.IntPtr, ByVal lpClassName As System.Text.StringBuilder, ByVal nMaxCount As Integer)

End Sub

Private Declare Auto Function FindWindow Lib “user32″ (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr

Private Declare Auto Function SendMessage Lib “user32″ (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wparam As Integer, ByVal lparam As System.Text.StringBuilder) As IntPtr

Private Declare Auto Function SendMessage Lib “user32″ (ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As String) As IntPtr

Private Declare Function SendMessage2 Lib “user32.dll” Alias “SendMessageA” (ByVal hwnd As Int32, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As IntPtr) As Int32

Private Declare Function FindWindowEx Lib “user32.dll” Alias “FindWindowExA” (ByVal hWnd1 As Int32, ByVal hWnd2 As Int32, ByVal lpsz1 As String, ByVal lpsz2 As String) As Int32

Private Const WM_GETTEXT = &HD

Private Const WM_GETTEXTLENGTH As Integer = &HE

Private Const WM_SETTEXT = &HC

Private Structure COPYDATASTRUCT

Public dwData As Int32

Public cbData As Int32

Public lpData As IntPtr

End Structure

Private Const WM_COPYDATA As Int32 = &H4A

#End Region

#Region “Functions/Enums not to edit”

Private Delegate Function EnumWindowProcess(ByVal Handle As IntPtr, ByVal Parameter As IntPtr) As Boolean

Private Enum IconType

Music

Games

Office

End Enum ”This contains the values for the different MSN now playing icons

Private Shared Function GetChildWindows(ByVal ParentHandle As IntPtr) As IntPtr() ”Gets the list of child windows from the parent window

Dim ChildrenList As New List(Of IntPtr)

Dim ListHandle As GCHandle = GCHandle.Alloc(ChildrenList)

Try

EnumChildWindows(ParentHandle, AddressOf EnumWindow, GCHandle.ToIntPtr(ListHandle)) ”Enumerates the windows

Finally

If ListHandle.IsAllocated Then ListHandle.Free()

End Try

Return ChildrenList.ToArray ”Returns the list of windows as a collection on IntPrt, which is then searched in

End Function

Private Shared Function EnumWindow(ByVal Handle As IntPtr, ByVal Parameter As IntPtr) As Boolean

Dim ChildrenList As List(Of IntPtr) = GCHandle.FromIntPtr(Parameter).Target

If ChildrenList Is Nothing Then Throw New Exception(“GCHandle Target could not be cast as List(Of IntPtr)”)

ChildrenList.Add(Handle) ”Adds a list of window handles

Return True

End Function

Private Shared Function FindXfire() As IntPtr

FindXfire = FindWindow(“SkinWnd”, vbNullString) ”Finds handle of the Xfire class window

End Function

Private Shared Function SendText(ByVal Text As String) As Boolean

Shell(“xfire:status?text=” & Text) ”Sets the Xfire status

End Function

Private Shared Function ReadText() As String

ReadText = “”

Dim handle As IntPtr = FindXfire()

If handle = 0 Then ”If the window isnt found

MessageBox.Show(“Xfire window not found.”, “Error:”, MessageBoxButtons.OK, MessageBoxIcon.Error)

Return “Error;”

Exit Function

End If

For Each child As IntPtr In GetChildWindows(handle) ”Loop through list of windows

Dim sClassName As New System.Text.StringBuilder(“”, 256)

Call GetClassName(child, sClassName, 256)

If sClassName.ToString = “Edit” Then ”Reads the class name of the handle

Dim conLength As IntPtr

conLength = SendMessage(child, WM_GETTEXTLENGTH, IntPtr.Zero, IntPtr.Zero) ”Gets the length of the text

Dim sbText As New System.Text.StringBuilder(conLength.ToInt32 + 1)

Dim ptrRet As IntPtr

ptrRet = SendMessage(child, WM_GETTEXT, conLength.ToInt32 + 1, sbText) ”Reads the text from the handle

If Not sbText.ToString = “” Then

Return sbText.ToString ”returns the text

End If

End If

Next

End Function

Private Shared Sub SetPlayingInfo(ByVal Artist As String, ByVal Album As String, ByVal Title As String, Optional ByVal Icon As IconType = IconType.Music, Optional ByVal WMContentID As String = vbNullString, Optional ByVal Format As String = “{0} – {1}”, Optional ByVal Show As Boolean = True)

”Not my function

Dim mess As String = String.Format(“{0}{1}{2}{3}{4}{5}{6}” & vbNullChar, Icon.ToString, Math.Abs(CInt(Show)), Format, Artist, Title, Album, WMContentID)

Dim lpMess As GCHandle = GCHandle.Alloc(mess, GCHandleType.Pinned)

Dim CD As COPYDATASTRUCT

With CD

.dwData = &H547

.cbData = mess.Length * 2

.lpData = lpMess.AddrOfPinnedObject

End With

Dim lpCD As GCHandle = GCHandle.Alloc(CD, GCHandleType.Pinned)

Dim hMSGRUI As Integer

Do

hMSGRUI = FindWindowEx(0, hMSGRUI, “MsnMsgrUIManager”, vbNullString)

If (hMSGRUI > 0) Then

SendMessage2(hMSGRUI, WM_COPYDATA, 0, lpCD.AddrOfPinnedObject)

End If

Loop Until (hMSGRUI = 0)

lpMess.Free()

lpCD.Free()

End Sub

#End Region

Private Xfolder As IO.FileSystemWatcher = New System.IO.FileSystemWatcher()

Private work As Boolean = True

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

Dim path As String = My.Computer.FileSystem.GetParentPath(My.Computer.FileSystem.GetParentPath(My.Computer.FileSystem.GetParentPath(My.Computer.FileSystem.SpecialDirectories.CurrentUserApplicationData)))

Xfolder.Path = path & “\Xfire”

Xfolder.NotifyFilter = IO.NotifyFilters.Attributes

AddHandler Xfolder.Changed, AddressOf Changed ”Creates the fsw, to the sub Changed

Xfolder.EnableRaisingEvents = True ”Starts watching

End Sub

Private Sub Changed(ByVal source As Object, ByVal e As System.IO.FileSystemEventArgs)

If e.Name = “status.ini” Then ”If the modified file is status.ini

Dim Str As String = ReadText() ”reads the window text

If Not Str = “Online” Or Str = “(AFK) Away From Keyboard” Then ”if its not a default one

SetPlayingInfo(“Now Playing”, “i__h4x Logger”, ReadText(), IconType.Games) ”Sets the msn pm to the game

If BackgroundWorker1.IsBusy = False Then ”Starts the bgw which sets the personal message (Incase other programs change it)

BackgroundWorker1.RunWorkerAsync()

work = True

End If

End If

End If

End Sub

Private Sub BackgroundWorker1_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork

Do

Dim Str As String = ReadText()

If Not Str = “Online” Or Str = “(AFK) Away From Keyboard” Then

SetPlayingInfo(“Now Playing”, “i__h4x Logger”, ReadText(), IconType.Games)

Else ”Does same as in Changed

SetPlayingInfo(“Now Playing”, “i__h4x Logger”, “Nothing”, IconType.Games)

work = False ”If the game has been closed, then it ends the bgw

End If

System.Threading.Thread.Sleep(200) ”pauses the loop

Loop Until work = False

BackgroundWorker1.WorkerSupportsCancellation = True

BackgroundWorker1.CancelAsync() ”ends the bgw

End Sub

End Class

This will change your MSN personal message to whatever you have in Xfire, you can see it change as you type, expect to see a full project released soon.

Release – Vb Net Windows Live Messenger Skin-Polygamy

 WLM Skin-Polygamy

i__h4x Multi-skin/Polygamy program

This program is intended for skins that utilise a modified msgsres.dll and for people that use multiple WLM clients.

It allows you to run one exe with one skin, and another exe with a different skin, so for example:

The client on the left is running a unmodified msgsres.dll, and the client on the right is using my ‘Cleaned’ skin (With DP/Text showing)

The program has basic instructions if you click the ? next to the button, it tells you what each step is for.
It also has an enable polygamy feature at the bottom, which patches the .exe so you can run more than one copy of it at a time.

Download:

WLM SkinPolygamy.rar
WLM SkinPolygamy.zip
WLM SkinPolygamy.exe

Release – Vb Net Windows Live Messenger Nudger

Windows Live Messenger Nudger

i__h4x Nudger

Features:

• Disable nudge timer in memory – Tested working with WLM versions 8.1.0178.00 and 8.5.1302.1018
• Option to try and disable timer on other versions
• Retrieves list of contacts to autocomplete contact Email
• Specify number of nudges to send
• Specify interval between nudges
• Cancel sending the nudges during the sending process
• Option to pause the sending process and resume it again
• Progress bar to visually display the progress, and a percentage counter

Download:

Windows Live Messenger Nudger.rar
Windows Live Messenger Nudger.zip

Windows Live Messenger Nudger.exe
Interop.MessengerAPI.dll

*Note: In order to run the exe, the dll must be in the same folder*

VB Net – MSN Nudger Full Project

Imports System.Runtime.InteropServicesImports MessengerAPIPublic Class Form1 <DllImport(“kernel32.dll”)> Public Shared Function WriteProcessMemory(ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByVal lpBuffer As Byte(), ByVal nSize As UIntPtr, <Out()> ByRef lpNumberOfBytesWritten As IntPtr) As Boolean End Function ‘@The fucnction to allow us to disable the timer Public Declare Function SendMessage Lib “user32.dll” Alias “SendMessageA” (ByVal hwnd As Int32, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As IntPtr) As Int32 <DllImport(“user32.dll”, EntryPoint:=“FindWindow”)> Private Shared Function FindWindowByCaption(ByVal zero As IntPtr, ByVal lpWindowName As String) As IntPtr End Function Public Const CMD_NUDGE = &H2B1 Public Const WM_COMMAND As Long = &H111 Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim Processes() As System.Diagnostics.Process ”get processes Processes = System.Diagnostics.Process.GetProcessesByName(“msnmsgr”) ”find messenger If Processes.Length = 0 Then ”check that the process was found MessageBox.Show(“Windows Live Messenger process was not found”, “Error:”, MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Sub End If Dim msnpath As String = Processes(0).MainModule.FileName Dim msnversion As String = System.Diagnostics.FileVersionInfo.GetVersionInfo(msnpath).FileVersion ”get the version of user If Not msnversion = “8.1.0178.00″ Then ”my version is 8.1…. If MessageBox.Show(“The version of Windows Live Messenger you are running is not the same that this program was intended, you are running:” & vbNewLine & msnversion & vbNewLine & “The intended version is 8.1.0178.00, you can try and enable nudging if you wish but it may crash WLM” & vbNewLine & “Do you want to enable?”, “Error: Wrong version, continue?”, MessageBoxButtons.YesNo, MessageBoxIcon.Warning) = Windows.Forms.DialogResult.No Then Exit Sub End If End If Dim nops As Byte() = New Byte(6 – 1) {&H90, &H90, &H90, &H90, &H90, &H90} ”create our data to write ”&H90 = NOP in ASM, which stands for No OPeration WriteProcessMemory(Processes(0).Handle, New IntPtr(&H61F239), nops, New UIntPtr(CType(nops.Length, UInt32)), New IntPtr(0)) ”Write the data to the proocess,—————–the address——————-size————————-length MessageBox.Show(“Windows Live Messenger was sucessfully modified” & vbNewLine & “6 Bytes written at address 0061F239″, “Done:”, MessageBoxButtons.OK, MessageBoxIcon.Exclamation) End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click ”checks that the fields are filled in correctly If TextBox1.Text = “” Then MessageBox.Show(“Please enter a valid contact email address”, “Error:”, MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Sub ElseIf InStr(TextBox1.Text, “@”) = 0 Then MessageBox.Show(“Please enter a valid contact email address”, “Error:”, MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Sub ElseIf NumericUpDown1.Value = 0 Then MessageBox.Show(“Please enter a number of times to send the nudge”, “Error:”, MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Sub End If Dim oMessenger As Messenger oMessenger = New Messenger Dim msncontact As IMessengerContact Dim msncontacts As IMessengerContacts ”gets the msn contacts msncontacts = oMessenger.MyContacts For Each msncontact In msncontacts ”loop through them If msncontact.SigninName = TextBox1.Text Then ”till it finds a matching contact oMessenger.InstantMessage(msncontact) ”open window Dim times As Integer = 0 Dim wnd As Integer = 0 wnd = FindWindowByCaption(0, msncontact.FriendlyName & ” – Conversation”) ”finds the window If wnd = 0 Then Dim Processes() As System.Diagnostics.Process ”if it dosnt find the window (contact may have weird symbols) Processes = System.Diagnostics.Process.GetProcessesByName(“msnmsgr”) If Processes.Length = 0 Then ”check that the process was found MessageBox.Show(“Windows Live Messenger process was not found”, “Error:”, MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Sub End If wnd = Processes(0).MainWindowHandle ’sets the handle to the window End If Do times += 1 SendMessage(wnd, WM_COMMAND, CMD_NUDGE, 0) ‘’sends a nudge Loop Until times = NumericUpDown1.Value ”x amount of times MessageBox.Show(“Done”, “MSN Nudge 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 SubEnd Class

Example form:

Download @

http://cid-50c4db1f234d8c02.skydrive.live.com/self.aspx/Public/Windows%20Live%20Messenger%208.1%20Nudger.exe
http://cid-50c4db1f234d8c02.skydrive.live.com/self.aspx/Public/Interop.MessengerAPI.dll

VB Net – Removing MSN Nudge Limit

    <DllImport(“kernel32.dll”)> Public Shared Function WriteProcessMemory(ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByVal lpBuffer As Byte(), ByVal nSize As UIntPtr, <Out()> ByRef lpNumberOfBytesWritten As IntPtr) As Boolean
End Function

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim Processes() As System.Diagnostics.Process ”get processes
Processes = System.Diagnostics.Process.GetProcessesByName(“-msnmsgr”) ”find messenger
Dim nops As Byte() = New Byte(6 – 1) {&H90, &H90, &H90, &H90, &H90, &H90} ”create our data to write
WriteProcessMemory(Processes(0).Handle, New IntPtr(&H61F239), nops, New UIntPtr(CType(nops.Length, UInt32)), New IntPtr(0))
”Write the data to the proocess,—————–the address——————-size————————-length
End Sub
Thats some example code for Windows Live Messenger V8.1.0178.00, there is a newer version out so you will need to update the address for that.

What this does is overwrites the timer at the address 0061F239
The original bytes = 8986DC020000
The written bytes = 909090909090

If you wanted to do it by patching the exe, it is the address 0021E630 (for v8.1…)

VB Net – MegaUpload URL Checker

Public Function MUURLCheck(ByVal URL As String) As Boolean
If My.Computer.Network.IsAvailable = False Then
MessageBox.Show(“There is currently no network connection available”, “Error:”, MessageBoxButtons.OK, MessageBoxIcon.Error)
Return False
Exit Function
End If

Dim check As Integer = InStr(URL.ToLower, “megaupload.com/?d=”)
If check = 0 Then
Return False
Exit Function
End If

If Not Mid(URL, 1, 7).ToLower = “http://” Then
URL = “http://” & URL
End If

Try
Dim rq As Net.HttpWebRequest = Net.HttpWebRequest.Create(URL)
Dim rs As Net.HttpWebResponse = rq.GetResponse()
Return True
Catch ex As Exception
Return False
End Try
End Function

Usage:

If MUURLCheck(“www.megaupload.com/?d=GY82RQ35″) = True Then
MsgBox(“URL exists”)
Else
MsgBox(“Incorrect URL”)
End If

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