Microphone Grabbing in Camfrog

  • This topic has 2 replies, 1 voice, and was last updated 1 year ago by James.
Viewing 3 posts - 1 through 3 (of 3 total)
  • Author
    Posts
  • #71529
    James
    Member
    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
    

    #71530
    James
    Member

    Compiled

    #71549
    James
    Member
    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, "*: *", "*")
            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
    Attachments:
Viewing 3 posts - 1 through 3 (of 3 total)
  • You must be logged in to reply to this topic.