Microphone Grabbing in Camfrog

Imports System.Runtime.InteropServices
Imports System.Text.RegularExpressions
Imports System.Text

Public Class Form1

    <UnmanagedFunctionPointer(CallingConvention.StdCall)>
    Private Delegate Function EnumCallBackDelegate(ByVal hwnd As IntPtr, ByVal lParam As IntPtr) As Integer

    <DllImport("user32.dll", EntryPoint:="EnumChildWindows")>
    Private Shared Function EnumChildWindows(ByVal hWndParent As IntPtr, ByVal lpEnumFunc As EnumCallBackDelegate, ByVal lParam As Integer) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function

    Declare Ansi Function GetClassNameA Lib “user32” _
Alias “GetClassNameA” (
ByVal hWnd As IntPtr,
ByVal lpClassName As StringBuilder,
ByVal nMaxCount As Int32) As Int32

    Delegate Function EnumChildProc(
ByVal hWnd As IntPtr,
ByRef lParam As IntPtr) As Int32

    Declare Function EnumChildWindows Lib “user32” (
ByVal hWndParent As IntPtr,
ByVal lpEnumFunc As EnumChildProc,
ByRef lParam As IntPtr) As Int32

    Declare Ansi Function RegisterWindowMessage Lib “user32” _
Alias “RegisterWindowMessageA” (
ByVal lpString As String) As Int32

    Declare Ansi Function SendMessageTimeout Lib “user32” _
Alias “SendMessageTimeoutA” (
ByVal hWnd As IntPtr,
ByVal msg As Int32,
ByVal wParam As Int32,
ByVal lParam As Int32,
ByVal fuFlags As Int32,
ByVal uTimeout As Int32,
ByRef lpdwResult As Int32) As Int32

    Const SMTO_ABORTIFHUNG As Int32 = &H2

    Declare Function ObjectFromLresult Lib “oleacc” (
ByVal lResult As Int32,
ByRef riid As System.Guid,
ByVal wParam As Int32,
ByRef ppvObject As HtmlDocument) As Int32

    Public Function IEDOMFromhWnd(ByVal hWnd As IntPtr) As HtmlDocument

        Dim IID_IHTMLDocument As System.Guid = New System.Guid(“626FC520-A41E-11CF-A731-00A0C9082637”)
        Dim hWndChild As Int32
        Dim lRes As Int32
        Dim lMsg As Int32
        Dim hr As Int32

        If Not hWnd.Equals(0) Then

            If Not IsIEServerWindow(hWnd) Then

                ' Get 1st child IE server window
                EnumChildWindows(hWnd, AddressOf EnumChild, hWnd)

            End If

            If Not hWnd.Equals(0) Then

                ' Register the message
                lMsg = RegisterWindowMessage(“WM_HTML_GETOBJECT”)

                ' Get the object
                Call SendMessageTimeout(hWnd, lMsg, 0, 0,
SMTO_ABORTIFHUNG, 1000, lRes)

                If lRes Then

                    ' Get the object from lRes
                    hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0, IEDOMFromhWnd)

                    If hr Then Throw New COMException(hr)

                End If

            End If

        End If

    End Function

    Private Function EnumChild(ByVal hWnd As IntPtr, ByRef lParam As IntPtr) As Int32

        If IsIEServerWindow(hWnd) Then
            lParam = hWnd
        Else
            EnumChild = 1
        End If

    End Function

    Private Function IsIEServerWindow(ByVal hWnd As IntPtr) As Boolean

        Dim Res As Int32
        Dim ClassName As StringBuilder = New StringBuilder(100)

        ' Get the window class name
        Res = GetClassNameA(hWnd, ClassName, ClassName.MaxCapacity)
        IsIEServerWindow = StrComp(
ClassName.ToString(),
“Internet Explorer_Server”,
CompareMethod.Text) = 0

    End Function

    Public Declare Function EnableWindow Lib "user32" (ByVal hwnd As IntPtr, ByVal fEnable As IntPtr) As IntPtr
    Private Declare Auto Function FindWindow Lib "user32.dll" (
ByVal lpClassName As String,
ByVal lpWindowName As String
) As IntPtr

    Private Declare Auto Function FindWindowEx Lib "user32.dll" (
ByVal hwndParent As IntPtr,
ByVal hwndChildAfter As IntPtr,
ByVal lpszClass As String,
ByVal lpszWindow As String
) As IntPtr
    Private Function findPartialTitle(ByVal partialTitle As String) As IntPtr
        For Each p As Process In Process.GetProcesses()
            If p.MainWindowTitle.IndexOf(partialTitle, 0, StringComparison.CurrentCultureIgnoreCase) > -1 Then
                Return p.MainWindowHandle
            End If
        Next
        Return IntPtr.Zero
    End Function
    Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As IntPtr
    Public Declare Function GetWindow Lib "user32" (ByVal hwnd As IntPtr, ByVal wCmd As IntPtr) As IntPtr
    Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As IntPtr, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
    Public Declare Function SendMessageLong& Lib "user32" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As IntPtr, ByVal wParam As IntPtr, ByVal lParam As IntPtr)
    Public Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As IntPtr, ByVal wParam As IntPtr, ByVal lParam As String) As IntPtr
    'Public Declare Function ShowWindow Lib "user32" (ByVal handle As IntPtr, ByVal nCmdShow As Integer) As Integer
    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
    Private Shared Function ShowWindow(ByVal hwnd As IntPtr, ByVal nCmdShow As Int32) As Boolean
    End Function
    Public Declare Function SetForegroundWindow Lib "user32" (ByVal handle As IntPtr) As Integer
    'Declare functions and constants
    ' Private Declare Function ShowWindow Lib "user32" (ByVal handle As IntPtr, ByVal nCmdShow As Integer) As Integer

    Public Const BM_SETCHECK = &HF1
    Public Const BM_GETCHECK = &HF0

    Public Const CB_GETCOUNT = &H146
    Public Const CB_GETLBTEXT = &H148
    Public Const CB_SETCURSEL = &H14E

    Public Const GW_HWNDFIRST = 0
    Public Const GW_HWNDNEXT = 2
    Public Const GW_CHILD = 5

    Public Const LB_GETCOUNT = &H18B
    Public Const LB_GETTEXT = &H189
    Public Const LB_SETCURSEL = &H186

    Public Const SW_HIDE = 0
    Public Const SW_MAXIMIZE = 3
    Public Const SW_MINIMIZE = 6
    Public Const SW_NORMAL = 1
    Public Const SW_SHOW = 5
    Private Const SW_SHOWMAXIMIZED As Integer = 3

    Public Const VK_SPACE = &H20

    Public Const WM_CHAR = &H102
    Public Const WM_CLOSE = &H10
    Public Const WM_COMMAND = &H111
    Public Const WM_GETTEXT = &HD
    Public Const WM_GETTEXTLENGTH = &HE
    Public Const WM_KEYDOWN = &H100
    Public Const WM_KEYUP = &H101
    Public Const WM_LBUTTONDBLCLK = &H203
    Public Const WM_LBUTTONDOWN = &H201
    Public Const WM_LBUTTONUP = &H202
    Public Const WM_MOVE = &HF012
    Public Const WM_RBUTTONDOWN = &H204
    Public Const WM_RBUTTONUP = &H205
    Public Const WM_SETTEXT = &HC
    Public Const WM_SYSCOMMAND = &H112


    Public Declare Function GetWindow Lib "user32" _
      (ByVal hwnd As Integer,
       ByVal wCmd As Integer) As Integer

    Public Declare Function GetClassNameA Lib "user32" (ByVal hwnd As IntPtr, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer

    Public Declare Function GetDesktopWindow Lib "user32" () As Integer

    Public Declare Function GetWindowText Lib "user32" _
       Alias "GetWindowTextA" _
      (ByVal hwnd As Integer,
       ByVal lpString As String,
       ByVal cch As Integer) As Integer

    Private Function FindWindowLike(ByVal hWndStart As Integer,
    ByVal WindowText As String,
    ByVal Classname As String) As Integer

        Dim hwnd As Integer
        Dim sWindowText As String
        Dim sClassname As String
        Dim r As Integer

        'Hold the level of recursion and
        'hold the number of matching windows
        Static level As Integer

        'Initialize if necessary. This is only executed
        'when level = 0 and hWndStart = 0, normally
        'only on the first call to the routine.
        If level = 0 Then
            If hWndStart = 0 Then hWndStart = GetDesktopWindow()
        End If

        'Increase recursion counter      
        level = level + 1

        'Get first child window
        hwnd = GetWindow(hWndStart, GW_CHILD)

        Do Until hwnd = 0

            'Search children by recursion
            Call FindWindowLike(hwnd, WindowText, Classname)

            'Get the window text and class name
            sWindowText = Space$(255)
            r = GetWindowText(hwnd, sWindowText, 255)
            sWindowText = sWindowText.Substring(0, r)
            'sWindowText = Left(sWindowText, r)

            sClassname = Space$(255)
            r = GetClassNameA(hwnd, sClassname, 255)
            sClassname = sClassname.Substring(0, r)
            'sClassname = Left(sClassname, r)

            'Check if window found matches the search parameters
            If (sWindowText Like WindowText) And
               (sClassname Like Classname) Then

                'List1.AddItem(hwnd & vbTab & _
                '              sClassname & vbTab & _
                '              sWindowText)
                FindWindowLike = hwnd

                'uncommenting the next line causes the routine to
                'only return the first matching window.
                'Exit Do

            End If

            'Get next child window
            hwnd = GetWindow(hwnd, GW_HWNDNEXT)

        Loop

        'Reduce the recursion counter
        level = level - 1

    End Function

    Private Function ControlSearchBottomUp(hWndMain As IntPtr, readTextClass As Object, readTextIndex As Object, readTextSearchQuadrant As Object) As IntPtr
        Throw New NotImplementedException()
    End Function


    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim HWND As IntPtr
        HWND = FindWindowLike(0, "*Video Chat Room*", "*")
        ShowWindow(HWND, SW_MINIMIZE)
        HWND = FindWindowLike(0, "*Topic*", "*")
        ShowWindow(HWND, SW_MINIMIZE)
    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        Dim HWND As IntPtr
        HWND = FindWindowLike(0, "*Video Chat Room*", "*")
        ShowWindow(HWND, SW_NORMAL)
        HWND = FindWindowLike(0, "*Topic*", "*")
        ShowWindow(HWND, SW_NORMAL)
    End Sub

    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        Dim csplitterctrlsts, x, cbuttonts, hParentWindow, hParentWindow2 As IntPtr
        hParentWindow = FindWindowLike(0, "*Video Chat Room*", "*")
        SetForegroundWindow(hParentWindow)
        x = FindWindowEx(hParentWindow, 0&, "#32770", vbNullString)
        x = FindWindowEx(hParentWindow, x, "#32770", vbNullString)
        x = FindWindowEx(hParentWindow, x, "#32770", vbNullString)
        x = FindWindowEx(hParentWindow, x, "#32770", vbNullString)
        x = FindWindowEx(hParentWindow, x, "#32770", vbNullString)
        csplitterctrlsts = FindWindowEx(x, 0&, "csplitterctrlsts", vbNullString)
        x = FindWindowEx(csplitterctrlsts, 0&, "#32770", vbNullString)
        cbuttonts = FindWindowEx(x, 0&, "cbuttonts", vbNullString)
        SendMessage(cbuttonts, WM_LBUTTONDOWN, 0, Nothing)
        SendMessage(cbuttonts, WM_LBUTTONUP, 0, Nothing)
        hParentWindow = FindWindowLike(0, "*Topic*", "*")
        SetForegroundWindow(hParentWindow)
        x = FindWindowEx(hParentWindow, 0&, "#32770", vbNullString)
        x = FindWindowEx(hParentWindow, x, "#32770", vbNullString)
        x = FindWindowEx(hParentWindow, x, "#32770", vbNullString)
        x = FindWindowEx(hParentWindow, x, "#32770", vbNullString)
        x = FindWindowEx(hParentWindow, x, "#32770", vbNullString)
        csplitterctrlsts = FindWindowEx(x, 0&, "csplitterctrlsts", vbNullString)
        x = FindWindowEx(csplitterctrlsts, 0&, "#32770", vbNullString)
        cbuttonts = FindWindowEx(x, 0&, "cbuttonts", vbNullString)
        SendMessage(cbuttonts, WM_LBUTTONDOWN, 0, Nothing)
        SendMessage(cbuttonts, WM_LBUTTONUP, 0, Nothing)
    End Sub

    Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.Click
        TextBox1.Clear()
    End Sub

    Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
        System.Diagnostics.Process.Start("camfrog:join:" + TextBox1.Text.ToLower)
    End Sub

    Private Sub LinkLabel1_LinkClicked(sender As Object, e As LinkLabelLinkClickedEventArgs) Handles LinkLabel1.LinkClicked
        System.Diagnostics.Process.Start("mailto:jmes@hotmail.com")
        System.Diagnostics.Process.Start("camfrog:im:James420")
    End Sub

    Public Sub AddListToListbox(TheList As IntPtr, NewList As ListBox)
        ' This sub will only work with standard listboxes.
        Dim lCount As IntPtr, Item As String, i As Integer, TheNull As Integer
        ' get the item count in the list
        lCount = SendMessageLong(TheList, LB_GETCOUNT, 0&, 0&)
        For i = 0 To lCount - 1
            Item = Chr(0)
            Call SendMessageByString(TheList, LB_GETTEXT, i, Item)
            TheNull = InStr(Item, Chr(0))
            ' remove any null characters that might be on the end of the string
            If TheNull <> 0 Then
                NewList.Items.Add(Microsoft.VisualBasic.Mid$(Item, 1, TheNull - 1))
            Else
                NewList.Items.Add(Item)
            End If
        Next
    End Sub
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

    End Sub

End Class

MicGrabber-Compiled-3