vb.net how to find all internet explorer sessions and the urls

in vb.Net i need to be able to find how many internet explorer sessions are open and the url each is browsing currently.

thanks for the help
ocsscottAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
SmashmadConnect With a Mentor Commented:
Hi!
put all this in a .bas Module

'----------------------
Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function EnumChildWindows Lib "user32.dll" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Const WM_GETTEXT = &HD
Const WM_GETTEXTLENGTH = &HE




Public Sub list()
Call EnumWindows(AddressOf EnumWindowsProc, 0)
End Sub


Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
  Dim slength As Long, buffer As String  ' title bar text length and buffer

  buffer = Space(8)
  slength = GetClassName(hwnd, buffer, 8)
 
  If Left(LCase(buffer), slength) = "ieframe" Then
    Debug.Print gettext(hwnd) ' <------------------------ HERE IS THE TITLE
     
    Call EnumChildWindows(hwnd, AddressOf EnumChildProc, 0)
         
  End If
 
   EnumWindowsProc = 1  ' return value of 1 means continue enumeration
End Function


Public Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
  Dim slength As Long, buffer As String  ' title bar text length and buffer

  buffer = Space(5)
  slength = GetClassName(hwnd, buffer, 5)
  If Left(LCase(buffer), slength) = "edit" Then
    Debug.Print gettext(hwnd) ' <<<--------------------- HERE IS THE URL
    EnumChildProc = 0
    Exit Function
  End If

  EnumChildProc = 1  ' nonzero return value means continue enumeration
End Function




Function gettext(ByVal win As Long) As String

' Display the title bar text of window Form1 by sending the
' appropriate messages to it.
Dim wintext As String  ' receives the copied text from the target window
Dim slength As Long  ' length of the window text
Dim retval As Long  ' return value of message

' First, determine how much space is necessary for the buffer.
' (1 is added for the terminating null character.)
slength = SendMessage(win, WM_GETTEXTLENGTH, ByVal CLng(0), ByVal CLng(0)) + 1
' Make enough room in the buffer to receive the text.
wintext = Space(slength)
' Copy the target window's text into the buffer.
retval = SendMessage(win, WM_GETTEXT, ByVal slength, ByVal wintext)
' Remove the terminating null and extra space from the buffer.
wintext = Left(wintext, retval)
' Display the result.
gettext = wintext


End Function







'NOW, CALLING FUNCTION LIST, YOU GET ALL URL AND TITLES
0
 
ocsscottAuthor Commented:
this will work in .net with no changes?  I cant test till tonight.  thanks

scott
0
 
ocsscottAuthor Commented:
this seems to be for vb6.. can you convert it to vb.net?
0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
SmashmadCommented:
I dont know vb.net. I made the code for vb5 or 6. have you test if it works?
0
 
SmashmadCommented:
it only use APIs, so I think it should work
0
 
ocsscottAuthor Commented:
the api's need to be coverted as data types have changes and I think other changes may be needed as well but I havent converted api calls yet.
0
 
SmashmadCommented:
well, in that case I cant help you... I cant get VB.net.. im trying..
0
 
ocsscottAuthor Commented:
ill try my hand at it tonight and post if if I get it working
0
 
ocsscottAuthor Commented:
I posted the code in the .net section it needs delegates whatever they are.  I'll post the code once converted
0
 
ocsscottAuthor Commented:
you are awesome.  great code.  here is the .net converted code


Option Strict Off
Option Explicit On

Imports System.Runtime.InteropServices
Imports System.Text


Module Module1
    '----------------------

    'Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Integer, ByVal lParam As Integer) As Integer
    Public Delegate Function EnumWindowsCallback(ByVal hWnd As Integer, ByVal lParam As Integer) As Integer
    Public Declare Function EnumWindows Lib "user32.dll" Alias "EnumWindows" (ByVal callback As EnumWindowsCallback, ByVal lParam As Integer) As Integer

    'UPGRADE_ISSUE: Declaring a parameter 'As Any' is not supported. Click for more: 'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1016"'
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As Integer


    Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Integer, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
    Public Delegate Function EnumChildWindowsCallback(ByVal hWnd As Integer, ByVal lParam As Integer) As Integer
    Declare Function EnumChildWindows Lib "user32.dll" (ByVal hWndParent As Integer, ByVal lpEnumFunc As EnumChildWindowsCallback, ByVal lParam As Integer) As Integer
      
      Const WM_GETTEXT As Short = &HDs
      Const WM_GETTEXTLENGTH As Short = &HEs
      Public intNumSessions As Short
      
      Public Sub list()
            
            'UPGRADE_WARNING: Add a delegate for AddressOf EnumWindowsProc Click for more: 'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1048"'
        Call EnumWindows(AddressOf EnumWindowsProc, 0)
            
            Form1.DefInstance.Label1.Text = intNumSessions & "  IE Sessions Open"
            
      End Sub



      Public Function EnumWindowsProc(ByVal hwnd As Integer, ByVal lParam As Integer) As Integer
            
            Dim slength As Integer
            Dim buffer As String ' title bar text length and buffer
            
            buffer = Space(8)
            slength = GetClassName(hwnd, buffer, 8)
            
            If Left(LCase(buffer), slength) = "ieframe" Then
                  
            'Form1.Text1.Text = Form1.Text1.Text & vbCrLf & gettext(hwnd)   ' <------------------------ HERE IS THE TITLE
                  
                  'UPGRADE_WARNING: Add a delegate for AddressOf EnumChildProc Click for more: 'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1048"'
                  Call EnumChildWindows(hwnd, AddressOf EnumChildProc, 0)
                  
                  intNumSessions = intNumSessions + 1
                  
            End If
            
            EnumWindowsProc = 1 ' return value of 1 means continue enumeration
            
      End Function
      
      Public Function EnumChildProc(ByVal hwnd As Integer, ByVal lParam As Integer) As Integer
            
            Dim slength As Integer
            Dim buffer As String ' title bar text length and buffer
            
            buffer = Space(5)
            slength = GetClassName(hwnd, buffer, 5)
            If Left(LCase(buffer), slength) = "edit" Then
                  
            ' <<<--------------------- HERE IS THE URL
                  Form1.DefInstance.Text1.Text = Form1.DefInstance.Text1.Text & vbCrLf & vbCrLf & gettext(hwnd)
                  
                  EnumChildProc = 0
            Exit Function

            End If
            
            EnumChildProc = 1 ' nonzero return value means continue enumeration
            
      End Function
      
      Function gettext(ByVal win As Integer) As String
            
            ' Display the title bar text of window Form1 by sending the
            ' appropriate messages to it.
            
        Dim wintext As String  ' receives the copied text from the target window
            Dim slength As Integer ' length of the window text
        Dim retval As Integer  ' return value of message
            
            ' First, determine how much space is necessary for the buffer.
            ' (1 is added for the terminating null character.)
            slength = SendMessage(win, WM_GETTEXTLENGTH, CInt(0), CInt(0)) + 1

        wintext = Space(slength)  ' Make enough room in the buffer to receive the text.

        retval = SendMessage(win, WM_GETTEXT, slength, wintext) ' Copy the target window's text into the buffer.

        wintext = Left(wintext, retval)  ' Remove the terminating null and extra space from the buffer.

        gettext = wintext  ' Display the result.
            
      End Function
End Module
0
All Courses

From novice to tech pro — start learning today.