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