Archive for the 'VB.Net' Category

05
May
09

[VB.Net] FindWindowsIndexOf – .Netish Version

A more .net style function for getting a window using an indexOf:

    ''API Imports
    <Runtime.InteropServices.DllImport("user32.dll", CharSet:=Runtime.InteropServices.CharSet.Auto)> Private Shared Sub GetClassName(ByVal hWnd As System.IntPtr, ByVal lpClassName As System.Text.StringBuilder, ByVal nMaxCount As Integer)
    End Sub
    <Runtime.InteropServices.DllImport("user32.dll", CharSet:=Runtime.InteropServices.CharSet.Auto)> Private Shared Function FindWindow(ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
    End Function

    ''FoundWindow stricture
    Public Structure FoundWindow
        Dim strWindowName As String
        Dim strClassName As String
        Dim hWnd As IntPtr
    End Structure

    ''' <summary>
    ''' This function is used to loop through all running processes, checking their main windows to see which ones contain a specific string
    ''' </summary>
    ''' <param name="strIndexOf">The string that you wish to check for in the window captions</param>
    ''' <param name="boolCase">Whether the function is should check for case</param>
    ''' <returns>A list of FoundWindow's containing the window name, class and handle</returns>
    ''' <remarks>As this function only loops through running processes main windows, it may miss some windows.</remarks>
    Public Function FindWindowsIndexOf(ByVal strIndexOf As String, ByVal boolCase As Boolean) As List(Of FoundWindow)
        Dim foundWindows As New List(Of FoundWindow)
        If boolCase = False Then
            strIndexOf = strIndexOf.ToLower
        End If
        For Each p As Process In Process.GetProcesses
            Dim windowCaption As String = p.MainWindowTitle
            If boolCase = False Then
                windowCaption = windowCaption.ToLower
            End If
            If windowCaption.IndexOf(strIndexOf) > -1 Then
                Dim foundWindow As New FoundWindow
                foundWindow.hWnd = FindWindow(vbNullString, p.MainWindowTitle)
                foundWindow.strWindowName = p.MainWindowTitle
                Dim sbClassName As New System.Text.StringBuilder("", 256)
                GetClassName(foundWindow.hWnd, sbClassName, 256)
                foundWindow.strClassName = sbClassName.ToString
                foundWindows.Add(foundWindow)
            End If
        Next
        Return foundWindows
    End Function

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        For Each fWnd As FoundWindow In FindWindowsIndexOf("TeST", False)
            Debug.WriteLine(fWnd.strWindowName & " : " & fWnd.hWnd.ToString)
        Next
    End Sub

Same as the last function, you can choose whether or not the function is case sensitive.

Advertisements
05
May
09

[VB.Net] FindWindowsIndexOf – API Version

Somebody on VBForums was asking how to do something similar to this, so after answering his question, I created this fairly useful function – for windows that names change each time you load them up or something…

    ''API Declarations
    Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As EnumWindowProc, ByVal lParam As IntPtr) As Integer
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Integer, ByVal lpString As System.Text.StringBuilder, ByVal cch As Integer) As Integer
    Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Integer) As Integer
    <Runtime.InteropServices.DllImport("user32.dll", CharSet:=Runtime.InteropServices.CharSet.Auto)> Private Shared Sub GetClassName(ByVal hWnd As System.IntPtr, ByVal lpClassName As System.Text.StringBuilder, ByVal nMaxCount As Integer)
    End Sub

    ''EnumWindow Callback Delegate Function
    Private Delegate Function EnumWindowProc(ByVal hwnd As Integer, ByVal lParam As IntPtr) As Boolean

    ''Found Window Structures
    Public Structure FoundWindows
        Dim boolCase As Boolean
        Dim strFindWindow As String
        Dim lstFoundWindows As List(Of FoundWindow)
    End Structure
    Public Structure FoundWindow
        Dim strWindowName As String
        Dim strClassName As String
        Dim hWnd As IntPtr
    End Structure

    ''' <summary>
    ''' ''EnumWindow Callback Function
    ''' </summary>
    ''' <param name="hwnd">Current windows handle</param>
    ''' <param name="lParam">Contains the FoundWindows structure</param>
    ''' <returns>The function passes the currently found windows in the lParam using a GCHandle to reform the data</returns>
    ''' <remarks>This function is called for each of the windows found, and is where the indexOf is called</remarks>
    Public Function EnumWindowsProc(ByVal hwnd As Integer, ByVal lParam As IntPtr) As Boolean
        Dim foundWindows As FoundWindows = CType(System.Runtime.InteropServices.GCHandle.FromIntPtr(lParam).Target, FoundWindows)
        Dim windowTitle As String = foundWindows.strFindWindow
        Dim wndTxtLen As Integer = GetWindowTextLength(hwnd)
        If Not wndTxtLen = 0 Then
            Dim sb As New System.Text.StringBuilder("", wndTxtLen + 1)
            GetWindowText(hwnd, sb, sb.Capacity)
            Dim windowCaption As String = sb.ToString
            If foundWindows.boolCase = False Then
                windowCaption = windowCaption.ToLower
                windowTitle = windowTitle.ToLower
            End If
            If windowCaption.IndexOf(windowTitle) > -1 Then
                Dim foundWindow As New FoundWindow
                foundWindow.hWnd = CType(hwnd, IntPtr)
                Dim sbClassName As New System.Text.StringBuilder("", 256)
                GetClassName(foundWindow.hWnd, sbClassName, 256)
                foundWindow.strClassName = sbClassName.ToString
                foundWindow.strWindowName = sb.ToString
                foundWindows.lstFoundWindows.Add(foundWindow)
            End If
        End If
        Return True
    End Function

    ''' <summary>
    ''' This function is used to loop through all open windows and check which ones contain a specific string
    ''' </summary>
    ''' <param name="strIndexOf">The string that you wish to check for in the window captions</param>
    ''' <param name="boolCase">Whether the function is should check for case</param>
    ''' <returns>A FoundWindows structure containing a list of FoundWindow</returns>
    ''' <remarks>The FoundWindows structure also contains the strIndexOf that was used to search the windows caption</remarks>
    Public Function FindWindowsIndexOf(ByVal strIndexOf As String, ByVal boolCase As Boolean) As FoundWindows
        Dim foundWindows As New FoundWindows
        foundWindows.boolCase = boolCase
        foundWindows.strFindWindow = strIndexOf
        foundWindows.lstFoundWindows = New List(Of FoundWindow)
        Dim ListHandle As System.Runtime.InteropServices.GCHandle = System.Runtime.InteropServices.GCHandle.Alloc(foundWindows)
        Try
            EnumWindows(AddressOf EnumWindowsProc, System.Runtime.InteropServices.GCHandle.ToIntPtr(ListHandle))
        Finally
            If ListHandle.IsAllocated Then ListHandle.Free()
        End Try
        Return foundWindows
    End Function

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        For Each fWnd As FoundWindow In FindWindowsIndexOf("Test", True).lstFoundWindows
            Debug.WriteLine(fWnd.strWindowName & " : " & fWnd.hWnd.ToString)
        Next
    End Sub

The function can check for casing as well. For example if you are running two windows one named “test” and another named “Test” if you use the function like this:

FindWindowsIndexOf("Test", True)

It will only return one window, however if you set the boolCase to false:

FindWindowsIndexOf("Test", False)

It will return both windows

03
May
09

[VB.Net] The beginnings of a Neopets bot

Ive decided that I’ve had enough of javascript, and so im going to move to VB.net to attempt to create a better bot. The auction bot itself, is, very good. However, now I want an autobuyer, and I cant get that to work in javascript as firefox doesn’t want to display the image when haggling..

Ive decided to do it using a webbrowser control, for ease of accessing the elements on the page, and below is a quick example of logging into neopets.

    Private Enum Bot_State
        Initial
        LogIn
        LoggingIn1
        LoggingIn2
        LoggingIn3
        LoggedIn
    End Enum

    Dim State As Bot_State = Bot_State.Initial
    Dim Username As String = "username"
    Dim Password As String = "password"

    ''web = System.Windows.Forms.WebBrowser
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        web.Navigate("http://neopets.com")
    End Sub

    Private Sub web_DocumentCompleted(ByVal sender As Object, ByVal e As System.Windows.Forms.WebBrowserDocumentCompletedEventArgs) Handles web.DocumentCompleted
        Select Case State
            Case Bot_State.Initial
                If web.Document.Body.InnerHtml.IndexOf("Login") <> -1 Then
                    State = Bot_State.LogIn
                    web.Navigate(web.Url.AbsoluteUri & "/loginpage.phtml")
                Else
                    State = Bot_State.LoggedIn
                End If
            Case Bot_State.LogIn
                Dim UserTB As HtmlElement = web.Document.GetElementById("txtUsername")
                UserTB.SetAttribute("value", Username)
                UserTB.Parent().Parent().Parent().Parent().DomElement.Submit()
                State = Bot_State.LoggingIn1
            Case Bot_State.LoggingIn1
                State = Bot_State.LoggingIn2
            Case Bot_State.LoggingIn2
                Dim PageInput As HtmlElementCollection = web.Document.GetElementsByTagName("input")
                For Each elem As HtmlElement In PageInput
                    If elem.GetAttribute("name") = "password" Then
                        elem.SetAttribute("value", Password)
                        elem.Parent().Parent().Parent().Parent().DomElement.Submit()
                    End If
                Next
                State = Bot_State.LoggingIn3
            Case Bot_State.LoggingIn3
                If web.Url.AbsoluteUri.IndexOf("index") Then
                    State = Bot_State.LoggedIn
                Else
                    State = Bot_State.LogIn
                    web.Navigate(web.Url.AbsoluteUri & "/loginpage.phtml")
                End If
        End Select
    End Sub
29
Apr
09

[Note] Neopets Autobidder Progress

This is the current workup for the neopets auction bot:

Currently, i have all the complex coding done, just have to work out the last few bugs here and there, and then decide how to integrate the bot with an auto stocker (wether to pass the sell price from url to url, until it reaches the stock, or to just query again later on).

Main Auction Page
Create list of items to query
Send request to php
Return list of items maxprice & sell price
Parse list
Loop through each row
Check if item is in list
If it is, check if its a NF only auction
If its not, check to see if maxprice is less than the current price
If it is, check to see if the page is on the ignore list
If it isnt, open the page in a new tab with max price as an url paramater (possibly also sell price?)
Add opened page to ignore list (greasemonkey var?)
Wait between 7 and 15 seconds, refresh page

Bid Page
Parse max price from url
Get username from page
Check to see if the auction is over/invalid/too expensive
If it is, close the page
If it isnt, Check to see if the last bidder was the user
If it is, refresh the page
If it isnt,
modify the form to pass the maxprice in the url when submitted (possibly also sell price)
submit the bid

Bid Submission
Parse max price from url
Check if bid successful (find BID SUCCESSFUL)
If yes,
find link on page (loop through ‘a’ elements)
modify link to pass the maxprice in the url when submitted (possibly also sell price)
If no, check reason
If not enough money, close
If need to wait, history back
If bid twice in a row, back : (Sorry, you are not allowed to bid on an auction two times in a row)

28
Apr
09

[Vb.Net] HTML Syntax Highlighter

Based very loosely on the original version I wrote in VBA for use in word.
Instead of looping through “words” this goes through each character and compares it with the colour of the last. Although this method may be slightly slower than splitting the string via spaces, the results are better as strings like Simon(“hithere”) would be incorrectly coloured.

    Private Sub SyntaxBtn_Press(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SyntaxBtn.Click
        CodeBox.SelectionStart = 0
        CodeBox.SelectionLength = 1
        Dim CurColour = CodeBox.SelectionColor
        Dim Output As String = "<div style='border: #660000 5px solid;color:#000000;'><pre style='background-color:#ffffff;padding:3px;line-height:15px;color:#000000;font-family: Courier New !important; font-size: 11px !important'>" & vbNewLine
        Output &= "<span style=""color:rgb(" & CurColour.R & ", " & CurColour.G & ", " & CurColour.B & ");"">"
        Output &= CodeBox.SelectedText
        Dim matches As System.Text.RegularExpressions.MatchCollection = System.Text.RegularExpressions.Regex.Matches(CodeBox.Text, "<")
        Progress.Maximum = CodeBox.TextLength + (matches.Count * 4)
        Progress.Value = 0
        For i As Integer = 1 To (CodeBox.TextLength + (matches.Count * 4))
            Progress.Value += 1
            CodeBox.SelectionStart = i
            CodeBox.SelectionLength = 1
            If CodeBox.SelectedText = "<" Then CodeBox.SelectedText = "\<"
            If CodeBox.SelectionColor <> CurColour Then CurColour = CodeBox.SelectionColor : Output &= "</span><span style=""color:rgb(" & CurColour.R & ", " & CurColour.G & ", " & CurColour.B & ");"">"
            Output &= CodeBox.SelectedText
        Next
        Output &= "</span> " & "</pre></div>"
        My.Computer.Clipboard.SetText(Output)
    End Sub

The example output for this is something like this:


Output &= \</span>\<span style="color:rgb(163, 21, 21);">"<span style=""color:rgb("\</span>\<span style="color:rgb(0, 0, 0);"> & CurColour.R & \</span>\<span style="color:rgb(163, 21, 21);">", "\</span>\<span style="color:rgb(0, 0, 0);"> & CurColour.G & \</span>\<span style="color:rgb(163, 21, 21);">", "\</span>\<span style="color:rgb(0, 0, 0);"> & CurColour.B & \</span>\<span style="color:rgb(163, 21, 21);">");"">"

\</span>\<span style="color:rgb(0, 0, 0);">        Output &= CodeBox.SelectedText

\</span>\<span style="color:rgb(0, 0, 255);">Dim\</span>\<span style="color:rgb(0, 0, 0);"> matches \</span>\<span style="color:rgb(0, 0, 255);">As\</span>\<span style="color:rgb(0, 0, 0);"> System.Text.RegularExpressions.MatchCollection = System.Text.RegularExpressions.Regex.Matches(CodeBox.Text, \</span>\<span style="color:rgb(163, 21, 21);">"<"\</span>\<span style="color:rgb(0, 0, 0);">)

Progress.Maximum = CodeBox.TextLength + (matches.Count * 4)

Progress.Value = 0

\</span>\<span style="color:rgb(0, 0, 255);">For\</span>\<span style="color:rgb(0, 0, 0);"> i \</span>\<span style="color:rgb(0, 0, 255);">As\</span>\<span style="color:rgb(0, 0, 0);"> \</span>\<span style="color:rgb(0, 0, 255);">Integer\</span>\<span style="color:rgb(0, 0, 0);"> = 1 \</span>\<span style="color:rgb(0, 0, 255);">To\</span>\<span style="color:rgb(0, 0, 0);"> (CodeBox.TextLength + (matches.Count * 4))

Progress.Value += 1

CodeBox.SelectionStart = i

CodeBox.SelectionLength = 1

\</span>\<span style="color:rgb(0, 0, 255);">If\</span>\<span style="color:rgb(0, 0, 0);"> CodeBox.SelectedText = \</span>\<span style="color:rgb(163, 21, 21);">"<"\</span>\<span style="color:rgb(0, 0, 0);"> \</span>\<span style="color:rgb(0, 0, 255);">Then\</span>\<span style="color:rgb(0, 0, 0);"> CodeBox.SelectedText = \</span>\<span style="color:rgb(163, 21, 21);">"\<"

\</span>\<span style="color:rgb(0, 0, 0);">            \</span>\<span style="color:rgb(0, 0, 255);">If\</span>\<span style="color:rgb(0, 0, 0);"> CodeBox.SelectionColor <> CurColour \</span>\<span style="color:rgb(0, 0, 255);">Then\</span>\<span style="color:rgb(0, 0, 0);"> CurColour = CodeBox.SelectionColor : Output &= \</span>\<span style="color:rgb(163, 21, 21);">"</span><span style=""color:rgb("\</span>\<span style="color:rgb(0, 0, 0);"> & CurColour.R & \</span>\<span style="color:rgb(163, 21, 21);">", "\</span>\<span style="color:rgb(0, 0, 0);"> & CurColour.G & \</span>\<span style="color:rgb(163, 21, 21);">", "\</span>\<span style="color:rgb(0, 0, 0);"> & CurColour.B & \</span>\<span style="color:rgb(163, 21, 21);">");"">"

\</span>\<span style="color:rgb(0, 0, 0);">            Output &= CodeBox.SelectedText

\</span>\<span style="color:rgb(0, 0, 255);">Next

\</span>\<span style="color:rgb(0, 0, 0);">        Output &= \</span>\<span style="color:rgb(163, 21, 21);">"</span> "\</span>\<span style="color:rgb(0, 0, 0);"> & \</span>\<span style="color:rgb(163, 21, 21);">"</pre></div>"

\</span>\<span style="color:rgb(0, 0, 0);">        \</span>\<span style="color:rgb(0, 0, 255);">My\</span>\<span style="color:rgb(0, 0, 0);">.Computer.Clipboard.SetText(Output)

\</span>\<span style="color:rgb(0, 0, 255);">End\</span>\<span style="color:rgb(0, 0, 0);"> \</span>\<span style="color:rgb(0, 0, 255);">Sub\</span> \</pre>\</div>
26
Apr
09

[C++] :Minesweeper: In-game Toggle Mine Visibility 2

A much cleaner solution than what I made here: /c-minesweeper-in-game-toggle-mine-visibility/
It just uses the in game “ShowMines” function rather than having to write your own.

void __stdcall ShowMines(void)
{
	typedef void (__stdcall *ptrFn)(DWORD);
	ptrFn ptrShowMinesFn = (ptrFn)(0x01002F80);
	ptrShowMinesFn(0xE);
}

You call the function ptrShowMinesFn with one of the possible values for mines, the list can be found here:
/c-minesweeper-toggle-mine-visibility/
So, for example 0xE would display flags.

17
Apr
09

[VB.Net] Bin Packing

An algorithm for packing a bin with a set of items
Allows for packing in descending order, which in most cases are more efficient

    Public Class Packing_Bin
        Public Number As Integer
        Public Size As Integer
        Public BinSpace As Integer
        Public Items As List(Of Integer)
    End Class

    Private Sub BinPack(ByVal Items As List(Of Integer), ByVal BinSize As Integer, Optional ByVal DecendingBinPack As Boolean = True)
        'Items:
        ''List of items to pack into the bins
        'BinSize:
        ''Declare the maximum size of the bins
        ''This is not necessary, you can just state the BinSize when you create a new bin
        'DecendingBinPack:
        ''Sorts the items into decending size order 

        If DecendingBinPack = True Then
            Items.Sort()
            Items.Reverse()
        End If

        ''Determine minimum number of bins required
        ''Again, not necessary, just used to check efficency of algorithm
        Dim MinimumBins As Integer
        For Each item As Integer In Items
            MinimumBins += item
        Next
        MinimumBins = Math.Ceiling(MinimumBins / BinSize)

        ''Create initial bin to be packed
        Dim Bins As New List(Of Packing_Bin)
        Dim InitialBin As New Packing_Bin
        With InitialBin
            .Number = 1
            .Size = BinSize
            .BinSpace = BinSize
            .Items = New List(Of Integer)
        End With
        Bins.Add(InitialBin)

        ''#Note - If you want to start with x bins with different properties, then create them here too
        ''Just declare a new Packing_Bin and set the properties

        ''Loop through out list of items
        For Each item As Integer In Items
            Dim Allocated As Boolean = False
            ''Loop through current bins
            For i As Integer = 0 To Bins.Count - 1
                ''If there is space in the bin, add it
                If Bins(i).BinSpace >= item Then
                    Bins(i).Items.Add(item)
                    Bins(i).BinSpace -= item
                    Allocated = True
                    Exit For
                End If
            Next
            ''If the item was not added to a bin, create a new bin an add it
            If Allocated = False Then
                Dim NewBin As New Packing_Bin
                With NewBin
                    .Number = Bins.Count + 1
                    .Size = BinSize
                    .BinSpace = BinSize - item
                    .Items = New List(Of Integer)
                    .Items.Add(item)
                End With
                ''Add the bin to our bin collection
                Bins.Add(NewBin)
            End If
        Next

        Debug.WriteLine("Minimum Number of Bins Required: " & MinimumBins)
        For Each bin As Packing_Bin In Bins
            Debug.Write("Bin #" & bin.Number & ": ")
            For i As Integer = 0 To bin.Items.Count - 2
                Debug.Write(bin.Items(i) & ", ")
            Next
            Debug.Write(bin.Items(bin.Items.Count - 1) & " - Space Remaining: " & bin.BinSpace & " of " & bin.Size & vbNewLine)
        Next
    End Sub

Usage:

        Dim BinSize As Integer = 15
        Dim Items As New List(Of Integer)
        Items.AddRange(New Integer() {12, 14, 15, 9, 8, 14, 9, 5, 9, 1, 5, 2, 6, 4, 14, 15, 1, 2, 12, 9})
        BinPack(Items, 15, True)

Would Output:
Minimum Number of Bins Required: 12
Bin #1: 15 – Space Remaining: 0 of 15
Bin #2: 15 – Space Remaining: 0 of 15
Bin #3: 14, 1 – Space Remaining: 0 of 15
Bin #4: 14, 1 – Space Remaining: 0 of 15
Bin #5: 14 – Space Remaining: 1 of 15
Bin #6: 12, 2 – Space Remaining: 1 of 15
Bin #7: 12, 2 – Space Remaining: 1 of 15
Bin #8: 9, 6 – Space Remaining: 0 of 15
Bin #9: 9, 5 – Space Remaining: 1 of 15
Bin #10: 9, 5 – Space Remaining: 1 of 15
Bin #11: 9, 4 – Space Remaining: 2 of 15
Bin #12: 8 – Space Remaining: 7 of 15