Posts Tagged ‘VB



28
Mar
09

[VB.Net] String To Binary Conversion

    Public Function StringToBinary(ByVal Text As String, Optional ByVal Separator As String = " ") As String
        Dim oReturn As New System.Text.StringBuilder
        For Each Character As Byte In System.Text.ASCIIEncoding.ASCII.GetBytes(Text)
            oReturn.Append(Convert.ToString(Character, 2).PadLeft(8, "0"))
            oReturn.Append(Separator)
        Next
        Return oReturn.ToString
    End Function

Usage:

Debug.WriteLine(StringToBinary("sim0n")

Would output:
01110011 01101001 01101101 00110000 01101110

Debug.WriteLine(StringToBinary("sim0n", ","))

Would output:
01110011,01101001,01101101,00110000,01101110,

Advertisements
28
Mar
09

[VB.Net] Mouse Hook Class

An updated version of “Low Level Mouse Hook (Global) – Installing a Low Level Mouse Hook” from the old blog. Allows easier access to the events, as each has their own handler.

Private Class MouseHook
        Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Integer, ByVal lpfn As MouseProcDelegate, ByVal hmod As Integer, ByVal dwThreadId As Integer) As Integer
        Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Integer, ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As MSLLHOOKSTRUCT) As Integer
        Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Integer) As Integer
        Private Delegate Function MouseProcDelegate(ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As MSLLHOOKSTRUCT) As Integer

        Private Structure MSLLHOOKSTRUCT
            Public pt As Point
            Public mouseData As Integer
            Public flags As Integer
            Public time As Integer
            Public dwExtraInfo As Integer
        End Structure

        Public Enum Wheel_Direction
            WheelUp
            WheelDown
        End Enum

        Private Const HC_ACTION As Integer = 0
        Private Const WH_MOUSE_LL As Integer = 14
        Private Const WM_MOUSEMOVE As Integer = &H200
        Private Const WM_LBUTTONDOWN As Integer = &H201
        Private Const WM_LBUTTONUP As Integer = &H202
        Private Const WM_LBUTTONDBLCLK As Integer = &H203
        Private Const WM_RBUTTONDOWN As Integer = &H204
        Private Const WM_RBUTTONUP As Integer = &H205
        Private Const WM_RBUTTONDBLCLK As Integer = &H206
        Private Const WM_MBUTTONDOWN As Integer = &H207
        Private Const WM_MBUTTONUP As Integer = &H208
        Private Const WM_MBUTTONDBLCLK As Integer = &H209
        Private Const WM_MOUSEWHEEL As Integer = &H20A

        Private MouseHook As Integer
        Private MouseHookDelegate As MouseProcDelegate

        Public Event Mouse_Move(ByVal ptLocat As Point)
        Public Event Mouse_Left_Down(ByVal ptLocat As Point)
        Public Event Mouse_Left_Up(ByVal ptLocat As Point)
        Public Event Mouse_Left_DoubleClick(ByVal ptLocat As Point)
        Public Event Mouse_Right_Down(ByVal ptLocat As Point)
        Public Event Mouse_Right_Up(ByVal ptLocat As Point)
        Public Event Mouse_Right_DoubleClick(ByVal ptLocat As Point)
        Public Event Mouse_Middle_Down(ByVal ptLocat As Point)
        Public Event Mouse_Middle_Up(ByVal ptLocat As Point)
        Public Event Mouse_Middle_DoubleClick(ByVal ptLocat As Point)
        Public Event Mouse_Wheel(ByVal ptLocat As Point, ByVal Direction As Wheel_Direction)

        Public Sub New()
            MouseHookDelegate = New MouseProcDelegate(AddressOf MouseProc)
            MouseHook = SetWindowsHookEx(WH_MOUSE_LL, MouseHookDelegate, System.Runtime.InteropServices.Marshal.GetHINSTANCE(System.Reflection.Assembly.GetExecutingAssembly.GetModules()(0)).ToInt32, 0)
        End Sub

        Private Function MouseProc(ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As MSLLHOOKSTRUCT) As Integer
            If (nCode = HC_ACTION) Then
                Select Case wParam
                    Case WM_MOUSEMOVE
                        RaiseEvent Mouse_Move(lParam.pt)
                    Case WM_LBUTTONDOWN
                        RaiseEvent Mouse_Left_Down(lParam.pt)
                    Case WM_LBUTTONUP
                        RaiseEvent Mouse_Left_Up(lParam.pt)
                    Case WM_LBUTTONDBLCLK
                        RaiseEvent Mouse_Left_DoubleClick(lParam.pt)
                    Case WM_RBUTTONDOWN
                        RaiseEvent Mouse_Right_Down(lParam.pt)
                    Case WM_RBUTTONUP
                        RaiseEvent Mouse_Right_Up(lParam.pt)
                    Case WM_RBUTTONDBLCLK
                        RaiseEvent Mouse_Right_DoubleClick(lParam.pt)
                    Case WM_MBUTTONDOWN
                        RaiseEvent Mouse_Middle_Down(lParam.pt)
                    Case WM_MBUTTONUP
                        RaiseEvent Mouse_Middle_Up(lParam.pt)
                    Case WM_MBUTTONDBLCLK
                        RaiseEvent Mouse_Middle_DoubleClick(lParam.pt)
                    Case WM_MOUSEWHEEL
                        Dim wDirection As Wheel_Direction
                        If lParam.mouseData < 0 Then
                            wDirection = Wheel_Direction.WheelDown
                        Else
                            wDirection = Wheel_Direction.WheelUp
                        End If
                        RaiseEvent Mouse_Wheel(lParam.pt, wDirection)
                End Select
            End If
            Return CallNextHookEx(MouseHook, nCode, wParam, lParam)
        End Function

        Protected Overrides Sub Finalize()
            UnhookWindowsHookEx(MouseHook)
            MyBase.Finalize()
        End Sub
    End Class

Usage:

   Private WithEvents mHook As New MouseHook

Since each mouse event raises its own event, you handle them like so:

    Private Sub mHook_Mouse_Left_DoubleClick(ByVal ptLocat As System.Drawing.Point) Handles mHook.Mouse_Left_DoubleClick
        Debug.WriteLine("Mouse Left Double Click At: (" & ptLocat.X & "," & ptLocat.Y & ")")
    End Sub

    Private Sub mHook_Mouse_Left_Down(ByVal ptLocat As System.Drawing.Point) Handles mHook.Mouse_Left_Down
        Debug.WriteLine("Mouse Left Down At: (" & ptLocat.X & "," & ptLocat.Y & ")")
    End Sub

    Private Sub mHook_Mouse_Left_Up(ByVal ptLocat As System.Drawing.Point) Handles mHook.Mouse_Left_Up
        Debug.WriteLine("Mouse Left Up At: (" & ptLocat.X & "," & ptLocat.Y & ")")
    End Sub

    Private Sub mHook_Mouse_Middle_DoubleClick(ByVal ptLocat As System.Drawing.Point) Handles mHook.Mouse_Middle_DoubleClick
        Debug.WriteLine("Mouse Middle Double Click At: (" & ptLocat.X & "," & ptLocat.Y & ")")
    End Sub

    Private Sub mHook_Mouse_Middle_Down(ByVal ptLocat As System.Drawing.Point) Handles mHook.Mouse_Middle_Down
        Debug.WriteLine("Mouse Middle Down At: (" & ptLocat.X & "," & ptLocat.Y & ")")
    End Sub

    Private Sub mHook_Mouse_Middle_Up(ByVal ptLocat As System.Drawing.Point) Handles mHook.Mouse_Middle_Up
        Debug.WriteLine("Mouse Middle Up At: (" & ptLocat.X & "," & ptLocat.Y & ")")
    End Sub

    Private Sub mHook_Mouse_Move(ByVal ptLocat As System.Drawing.Point) Handles mHook.Mouse_Move
        ''Will be called every time the mouse moves
    End Sub

    Private Sub mHook_Mouse_Right_DoubleClick(ByVal ptLocat As System.Drawing.Point) Handles mHook.Mouse_Right_DoubleClick
        Debug.WriteLine("Mouse Right Double Click At: (" & ptLocat.X & "," & ptLocat.Y & ")")
    End Sub

    Private Sub mHook_Mouse_Right_Down(ByVal ptLocat As System.Drawing.Point) Handles mHook.Mouse_Right_Down
        Debug.WriteLine("Mouse Right Down At: (" & ptLocat.X & "," & ptLocat.Y & ")")
    End Sub

    Private Sub mHook_Mouse_Right_Up(ByVal ptLocat As System.Drawing.Point) Handles mHook.Mouse_Right_Up
        Debug.WriteLine("Mouse Right Up At: (" & ptLocat.X & "," & ptLocat.Y & ")")
    End Sub

    Private Sub mHook_Mouse_Wheel(ByVal ptLocat As System.Drawing.Point, ByVal Direction As MouseHook.Wheel_Direction) Handles mHook.Mouse_Wheel
        Debug.WriteLine("Mouse Scroll: " & Direction.ToString & " At: (" & ptLocat.X & "," & ptLocat.Y & ")")
    End Sub

Note: To run this inside Visual Studio, you will need to go to:
Project -> [Project Name] Properties -> Debug -> Uncheck “Enable the Visual Studio hosting process”
As that intercepts the hooked messages before your program.

28
Mar
09

[VB.Net] Hex to String Conversion

Function HexToString(ByVal hex As String) As String
    Dim text As New System.Text.StringBuilder(hex.Length \ 2)
    For i As Integer = 0 To hex.Length - 2 Step 2
        text.Append(Chr(Convert.ToByte(hex.Substring(i, 2), 16)))
    Next
    Return text.ToString
End Function

Usage:

Debug.WriteLine(HexToString("73696D306E"))

Would output:
sim0n

28
Mar
09

[VB.Net] String to Hex Conversion

Migrating old code snippits over to the new blog.

Function StringToHex(ByVal text As String) As String
    Dim hex As String
    For i As Integer = 0 To text.Length - 1
        hex &= Asc(text.Substring(i, 1)).ToString("x").ToUpper
    Next
    Return hex
End Function

Usage:

Debug.WriteLine(StringToHex("sim0n"))

Would Output:
73696D306E

27
Mar
09

[VB.Net] Q: Sending Mouseclicks/Keystrokes into minimized window

The question asked “What i want is how do i make a program to be able to send inputs (key clicks) into the application when it is minimized”

The solution:

Imports System.Runtime.InteropServices
Public Class Form1
    ''--------------------
    ''Minimise the window
    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto) >  _
    Private Shared Function ShowWindow(ByVal hwnd As IntPtr, _
                          ByVal nCmdShow As Integer) As Integer
    End Function
    Private Const SW_SHOWMINIMIZED = 2
    ''--------------------
    ''Finding the Control
    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto) >  _
    Private Shared Function FindWindowEx(ByVal parentHandle As IntPtr, _
                          ByVal childAfter As IntPtr, _
                          ByVal lclassName As String, _
                          ByVal windowTitle As String) As IntPtr
    End Function
    ''--------------------
    ''Sending the click
    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 Const BM_CLICK = &HF5

    Private Const WM_LBUTTONDOWN = &H201
    Private Const WM_LBUTTONUP = &H202
    Private Const BM_SETSTATE = &HF3
    ''--------------------
    ''Read the edit control
    Private Declare Auto Function SendMessage Lib "user32" (ByVal hwnd As IntPtr, ByVal msg As Integer, ByVal wParam As Integer, ByVal lParam As System.Text.StringBuilder) As IntPtr
    Private Const WM_GETTEXT = &HD
    Private Const WM_GETTEXTLENGTH As Integer = &HE
    ''--------------------
    ''Keyboard Input
    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto) >  _
    Private Shared Function PostMessage( _
                          ByVal hWnd As IntPtr, _
                          ByVal Msg As UInteger, _
                          ByVal wParam As IntPtr, _
                          ByVal lParam As IntPtr) As Boolean
    End Function
    Private Const WM_KEYDOWN = &H100
    Private Const WM_KEYUP = &H101
    Private Const WM_SYSKEYDOWN = &H104
    Private Const WM_SYSKEYUP = &H105

    Private Function GetAnswer(ByVal hWnd As Integer) As String
        ''Get the controls handle
        Dim calc_textHandle As Integer = FindWindowEx(hWnd, IntPtr.Zero, "Edit", vbNullChar)
        ''Get length of the text
        Dim calc_textLen As IntPtr = SendMessage(calc_textHandle, WM_GETTEXTLENGTH, IntPtr.Zero, IntPtr.Zero)
        ''Create string builder
        Dim calc_textSb As New System.Text.StringBuilder(calc_textLen.ToInt32 + 2)
        ''Get text
        SendMessage(calc_textHandle, WM_GETTEXT, calc_textLen.ToInt32 + 2, calc_textSb)
        ''Return
        If Not calc_textSb.ToString = "" Then
            Return ("Result: " & calc_textSb.ToString)
        Else
            Return ("Error Reading Answer")
        End If
    End Function

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim ProcessFileName As String = "calc"
        Dim p As Process = Process.GetProcessesByName(ProcessFileName)(0)
        '   Instead of using Process.GetProcessByName, you could use:
        '        Private Declare Auto Function FindWindow Lib "user32" (ByVal lpClassName As String,_
        '                                    ByVal lpWindowName As String) As IntPtr
        ' FindWindow('SciCalc', 'Calculator')
        '    or FindWindow('SciCalc', vbNullChar)
        '       or FindWindow(vbNullChar, 'Calculator')
        'To return the handle of the window

        ''Minimise Window
        ShowWindow(p.MainWindowHandle, SW_SHOWMINIMIZED)

        ''Now to do a basic sum on the calculator
        ''Firstly reset the calculator, and then do 1+1="

        Dim calc_CButton As Integer = FindWindowEx(p.MainWindowHandle, IntPtr.Zero, "Button", "C")
        ''Clear
        SendMessage(calc_CButton, BM_CLICK, 0, 0)
        Dim calc_1Button As Integer = FindWindowEx(p.MainWindowHandle, IntPtr.Zero, "Button", "1")
        ''1
        SendMessage(calc_1Button, BM_CLICK, 0, 0)
        Dim calc_plusButton As Integer = FindWindowEx(p.MainWindowHandle, IntPtr.Zero, "Button", "+")
        ''+
        SendMessage(calc_plusButton, BM_CLICK, 0, 0)
        ''1, instead of using BM_CLICK using Mouse events [BM_CLICK works fine]
        SendMessage(calc_1Button, WM_LBUTTONDOWN, 0, 0)
        SendMessage(calc_1Button, BM_SETSTATE, 1, 0)
        SendMessage(calc_1Button, WM_LBUTTONUP, 0, 0)
        Dim calc_equalButton As Integer = FindWindowEx(p.MainWindowHandle, IntPtr.Zero, "Button", "=")
        ''=
        SendMessage(calc_equalButton, BM_CLICK, 0, 0)

        ''Now read the results
        Debug.WriteLine(GetAnswer(p.MainWindowHandle))

        ''Now using Keyboard input
        ''Escape Key to clear textbox
        PostMessage(p.MainWindowHandle, WM_KEYDOWN, Keys.Escape, 0)
        PostMessage(p.MainWindowHandle, WM_KEYUP, Keys.Escape, 0)
        ''5
        PostMessage(p.MainWindowHandle, WM_KEYUP, Keys.D5, 0)
        ''*
        PostMessage(p.MainWindowHandle, WM_KEYUP, Keys.Multiply, 0)
        ''10
        PostMessage(p.MainWindowHandle, WM_KEYUP, Keys.D1, 0)
        PostMessage(p.MainWindowHandle, WM_KEYUP, Keys.D0, 0)
        ''=
        PostMessage(p.MainWindowHandle, WM_KEYUP, &HBB, 0)
        Debug.WriteLine(GetAnswer(p.MainWindowHandle))
    End Sub
End Class

This is an old project demonstrating how to click buttons and send keys to a minimised window.
Use FindWindow/FindWindowEx/EnumChildWindows/etc to get the handle of the button
Then I would use the BM_CLICK message as the Msg param however you could also use WM_LBUTTONDOWN+BM_SETSTATE(1)+WM_LBUTTONUP

The above is an example using Windows Calculator. It clicks the buttons on the form, sends key presses, and gets the answer.

27
Mar
09

[VBA] Q: How to get pixel colour

The question asked “On the image if i click anywhere, im supposed to tell the user what colour the pixel they clicked on was”

The solution:

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (ByVal lpPoint As POINT) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long

Private Type POINT
    x As Long
    y As Long
End Type

Private Sub Image1_Click()
    Dim pLocation As POINT
    Dim lColour, lDC As Long
    lDC = GetWindowDC(0)
    Call GetCursorPos(pLocation)
    lColour = GetPixel(lDC, pLocation.x, pLocation.y)
    Me.BackColor = lColour
End Sub

27
Mar
09

[VB.Net] Q: How to get pixel colour

The question asked “On the image if i click anywhere, im supposed to tell the user what colour the pixel they clicked on was”

The solution:

Imports System.Runtime.InteropServices
Public Class Form1

    ''Required API DLL Imports
    <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
    ''GetPixelColour Function
    Public Shared Function GetPixelColour(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

    Private Sub PictureBox1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PictureBox1.Click
        Debug.WriteLine(GetPixelColour(Cursor.Position.X, Cursor.Position.Y))
    End Sub
End Class

Just add a picture box to the form, when you click on the picturebox it will write the colour to the debug output