• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 475
  • Last Modified:

Getting current browser url..

The points will be awarded to the person that can complete the following code and make it functional. At the very least I know it is missing a function. The function is to grab the text that is in the first text box on the topmost window ie. the browser url.


<<START CODE>>

'**************************************
'Windows API/Global Declarations for :WE
'     B ADDRESS SPY
'**************************************
' PLACE THIS IN A NEW MODULE (THIS WONT
'     WORK
' ON A FORMS GENERAL DECLARTIONS AREA)
'
' **************************************
'     ***********************
'
' Set or Get an edit objects text For wi
'     n 32
'
' **************************************
'     ***********************
'
' Four Functions GetWindowTitle,FindEdit
'     Info GetEditText And
' SetEditText.
'
'***************************************
'     **********************
'


Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long


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


Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long


Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long


Declare Function GetForegroundWindow Lib "user32" () 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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long


Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Const GWW_HINSTANCE = (-6)
    Const GWW_ID = (-12)
    Const GWL_STYLE = (-16)
    Const GW_CHILD = 5
    Const GW_HWNDFIRST = 0
    Const GW_HWNDLAST = 1
    Const GW_HWNDNEXT = 2
    Const GW_HWNDPREV = 3
    Const GW_OWNER = 4
    Const WM_GETTEXT = &HD
    Const WM_GETTEXTLENGTH = &HE
    Const WM_SETTEXT = &HC
    Global EditWnd As Long
    Global TheWndTitle As String


Public Function GetWindowTitle(ByVal hwnd As Long) As String
    ' **************************************
    '     ****
    ' GetWindowTitle Function:
    '
    ' Return the title bar text associated w
    '     ith
    ' the hwnd property
    '
    ' **************************************
    '     ****
    '
      '
    ' **************************************
    '     ****
   
    Dim l As Long
    Dim s As String
    l = GetWindowTextLength(hwnd)
    s = Space(l + 1)
    GetWindowText hwnd, s, l + 1
    GetWindowTitle = Left$(s, l)
   
End Function


Public Function FindEditInfo(window_hwnd As Long) As String
    ' **************************************
    '     ****
    ' FindEditInfo Function:
    '
    ' If the object class name contains EDIT
    '     ,
    ' return its contents. Otherwise search
    '     its
    ' children for an Edit object.
    '
    ' **************************************
    '     ****
    '
   
    '
    ' **************************************
    '     ****
    Dim txt As String
    Dim buf As String
    Dim buflen As Long
    Dim child_hwnd As Long
    Dim children() As Long
    Dim num_children As Integer
    Dim i As Integer
    ' Get the class name.
    buflen = 600
    buf = Space$(buflen - 1)
    buflen = GetClassName(window_hwnd, buf, buflen)
    buf = Left$(buf, buflen)
   
   
    ' See if we found an Edit object.
    MyPos = InStr(1, UCase(buf), "EDIT", 1)


    If MyPos > 0 Then
       
        FindEditInfo = GetEditText(window_hwnd)
        EditWnd = window_hwnd
       
        'Store the Edit Objects Hwnd property in
        '     a
        'global variable for retrieval by the se
        '     t
        'edit object function
       
       
        Exit Function
    End If
   
    ' It's not an Edit object. Search the ch
    '     ildren.
    ' Make a list of the child windows.
   
    num_children = 0
    child_hwnd = GetWindow(window_hwnd, GW_CHILD)


    Do While child_hwnd <> 0
       
        num_children = num_children + 1
        ReDim Preserve children(1 To num_children)
        children(num_children) = child_hwnd
       
        child_hwnd = GetWindow(child_hwnd, GW_HWNDNEXT)
    Loop
   
    ' Get information on the child windows.


    For i = 1 To num_children

'**************************************
' Name: WEB ADDRESS SPY
' Description:Set or Get an edit objects
'     text For win 32
Four Functions GetWindowTitle,FindEditInfo
GetEditText And SetEditText.
This function can retrieve any other apps
text in their textbox including current web
browser url or even hidden password fields
This example shows you how to spy on
Internet explorer or netscapes current web
browser url...
'
'
' Inputs:The hwnd property of the window
'     or edit object
'
' Returns:Either sets or gets the edit o
'     bjects text
'
'Assumes:' *****************************
'     *************
'
' Set or Get an edit objects text For wi
'     n 32
'
' **************************************
'     ****
'
' Four Functions GetWindowTitle,FindEdit
'     Info
' GetEditText And SetEditText.
'
'*************************************

' **************************************
'     ****
' IMPORTANT THIS CODE WON'T WORK UNLESS
'     YOU
' **************************************
'     ****
'
' PLACE A LABEL NAMED LABEL1 A TIMER NAM
'     ED
' TIMER1 TWO TEXTBOXES (TEXT1 AND TEXT2)
'    
' AND A COMMAND BUTTON NAMED COMMAND1 ON
'     A
' FORM.
'
' **************************************
'     ****
'
'PLACE THIS IN FORM_LOAD
'
' **************************************
'     ****
'
' Set or Get an edit objects text For wi
'     n 32
'
' **************************************
'     ****

'
' **************************************
'     ****


Form1.Width = 6015


    Form1.height = 3600


        Form1.caption = "Set or get edit object example"
            Label1.left = 135
            label1.top = 240
            label1.autosize = true
            label1.caption = "Current URL"
            Command1.width = 870
            Command1.caption = "SET"
            Command1.left = 135
            Command1.height = 345
            Command1.Top = 675
            text1.text = ""
            text1.left = 1290
            text1.top = 225
            text1.height = 360
            text2.text = "http://www.digital-harmony.com/"
            text2.height = 360
            text2.left = 1290
            text2.top = 690
            Timer1.enabled = True
            Timer1.interval = 100
            ' **************************************
            '     ****
            '
            ' PLACE THIS IN TIMER1
            '
            ' **************************************
            '     ****
            '
            ' Set or Get an edit objects text For wi
            '     n 32
            '
            ' **************************************
           
            '     ****
            'Declare variables
            Dim MyHwnd As Long
            Dim Found As Integer
            Dim Compare
            'Initialize the find routine
            Found = False
            'Returns the hwnd property of the active
            '     window
            MyHwnd = GetForegroundWindow
            'Get the titlebar text of the active win


            '     dow
                'And store it in a global string
                TheWndTitle = GetWindowTitle(MyHwnd)
                'Use instr compare method for IE as the
                '     title bar is
                'often different 'For example: on mine i
                '     t says
                '"Microsoft Internet Explorer Provided b
                '     y 4Thenet.co.uk"
                ' On some peoples machines it maybe
                '"Microsoft Internet Explorer Provided b
                '     y freeserve"
                Dim SearchWord As String
                SearchWord = LCase("MiCrOsoFt InTeRneT ExPloReR")
                'The Lcase function makes the search non
                '     case
                'sensative (Turning everything to lowerc
                '     ase)
                Compare = InStr(1, LCase(TheWndTitle), SearchWord, 1)
                'If the position of The SearchWord is gr
                '     eater
                'than Zero We found a match


                If Compare > 0 Then
                    Found = True
                End If
                'As I have never seen that on netscape,
                '     just use
                'Last word compare method
                SearchWord = LCase("- NoTePaD")


                If Len(TheWndTitle) >= Len(SearchWord) Then
                    'Make sure the length of the title bar t
                    '     ext
                    'is greater than or equal too the length
                    '     of the
                    'SearchWord otherwise the mid function w
                    '     ill cause
                    'An error
                    Compare = Mid(LCase(TheWndTitle), Len(TheWndTitle) - Len(SearchWord) + 1, Len(SearchWord))
                   


                    If Compare = SearchWord Then
                        Found = True
                    End If
                   
                End If


                If Found = True Then
                    Dim TheEditText As String
                    TheEditText = FindEditInfo(MyHwnd)
                    'FindEditInfo Function searches the MyHw
                    '     nds children
                    'For object class names containing "EDIT
                    '     " 'If it finds
                    'an edit object it launches the GetEditT
'     ext Function
'
'The GetEditText Function returns the te
'     xt in the edit
'object. EDIT OBJECT'S can be things lik
'     e TEXT BOXES
'RICH EDIT BOXES , Web browser URL boxes
'     (Where you
'type in your web address) and even pass
'     word fields
                    Text1.Text = TheEditText
                End If
<<END CODE>>
0
stephenblade
Asked:
stephenblade
  • 7
  • 7
  • 4
1 Solution
 
Erick37Commented:
Getting the URL string from IE's edit window:
http://www.vbcode.com/asp/showsn.asp?theID=1005
0
 
stephenbladeAuthor Commented:
ROFLOL... Ruchi.. That is where I got the code..LOL Just can't seem to get it to work.


0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
RuchiCommented:
LOL!!!!

is the program not working successfully?
0
 
stephenbladeAuthor Commented:
That's just it I think it is missing the GetEditText function I emailed the author and he said quite abruptly that it is all there. Pop the code into VB6 and it spits out an error on the first call for GetEditText.
0
 
RuchiCommented:
when i ran the program, i did not get any error.
0
 
stephenbladeAuthor Commented:
Did it work? and if it did would you email me a zip of the project?

stephen@savvyshoppers.com
0
 
RuchiCommented:
i don't know how to use with that code, but it seems to be working fine..

ok, i am going to email you..
just a few minutes.
0
 
RuchiCommented:
my email message is on the way to your address.
0
 
stephenbladeAuthor Commented:
Run the program then click on any open browser window. That will tell the program to try and grab the current url for that window. You will get an error.

0
 
RuchiCommented:
Yes, I got an error...
I read the comments from the code he posted on planet source code web.

"""""
TheWndTitle = GetWindowTitle(MyHwnd)
'Use instr compare method for IE as the

'     title bar is
'often different 'For example: on mine i
'     t says
'"Microsoft Internet Explorer Provided b
'     y 4Thenet.co.uk"
' On some peoples machines it maybe
'"Microsoft Internet Explorer Provided b
'     y freeserve"
""""""

what does that mean?
0
 
stephenbladeAuthor Commented:
He is saying check the title bar for the words microsoft internet explorer using the instr function.
0
 
RuchiCommented:
ok, i see. i am going to stop for now. i will be back by late tonight or tomorrow. i will work with this problem.
0
 
Erick37Commented:
Try this out:

'~~~~Form Code~~~~

Option Explicit

Private Sub Form_Load()
    Timer1.Interval = 1000
End Sub

Private Sub Timer1_Timer()
    Dim lhWnd As Long
    lhWnd = GetForegroundWindow
    Text1.Text = GetFirstVisibleEditText(lhWnd)
End Sub

'~~~~Module Code~~~~

Option Explicit

Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE

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 EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) 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 GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Private sWndText As String

Public Function EnumChildProc(ByVal lhWnd As Long, ByVal lParam As Long) As Long
    Dim sClassName As String
    Dim lRet As Long
    sClassName = String(260, Chr(0))
    lRet = GetClassName(lhWnd, sClassName, 260)
    sClassName = Left(sClassName, lRet)
    If UCase(sClassName) = "EDIT" Then
        lRet = SendMessage(lhWnd, WM_GETTEXTLENGTH, 0&, 0&)
        sWndText = String(lRet, Chr(0))
        Call SendMessageByString(lhWnd, WM_GETTEXT, lRet + 1, sWndText)
        EnumChildProc = 0
    Else
        EnumChildProc = 1
    End If
End Function

Public Function GetFirstVisibleEditText(ByVal lhWnd As Long) As String
    Dim lRet As Long
    Dim sAppTitle As String
    sWndText = ""
    lRet = SendMessage(lhWnd, WM_GETTEXTLENGTH, 0&, 0&)
    sAppTitle = String(lRet, Chr(0))
    Call SendMessageByString(lhWnd, WM_GETTEXT, lRet + 1, sAppTitle)
    'Filter the applications here:
    If UCase(sAppTitle) Like "*INTERNET EXPLORER*" Then
        Call EnumChildWindows(lhWnd, AddressOf EnumChildProc, &H0)
        GetFirstVisibleEditText = sWndText
    End If
End Function
0
 
stephenbladeAuthor Commented:
Perfect but can you make it work for netscape as well?

0
 
Erick37Commented:
Modified to find the first edit window that has text.  Now it works w/Netscape.

'~~~~Form Code~~~~

Option Explicit

Private sPrevWndText As String

Private Sub Form_Load()
    Timer1.Interval = 1000
    sPrevWndText = ""
End Sub

Private Sub Timer1_Timer()
    Dim lhWnd As Long
    Dim sWndText As String
    lhWnd = GetForegroundWindow
    sWndText = GetFirstVisibleEditText(lhWnd)
    If sPrevWndText <> sWndText Then
        Text1.Text = sWndText
        sPrevWndText = sWndText
    End If
End Sub



'~~~~Module Code~~~~

Option Explicit

Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE

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 EnumChildWindows Lib "user32" _
    (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) 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 GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Private sWndText As String

Public Function EnumChildProc(ByVal lhWnd As Long, ByVal lParam As Long) As Long
    Dim sClassName As String
    Dim lRet As Long
    sClassName = String(260, Chr(0))
    lRet = GetClassName(lhWnd, sClassName, 260)
    sClassName = Left(sClassName, lRet)
    If UCase(sClassName) = "EDIT" Then
        lRet = SendMessage(lhWnd, WM_GETTEXTLENGTH, 0&, 0&)
        If lRet = 0 Then 'Keep looking
            EnumChildProc = 1
            Exit Function
        End If
        sWndText = String(lRet, Chr(0))
        Call SendMessageByString(lhWnd, WM_GETTEXT, lRet + 1, sWndText)
        EnumChildProc = 0
    Else
        EnumChildProc = 1
    End If
End Function

Public Function GetFirstVisibleEditText(ByVal lhWnd As Long) As String
    Dim lRet As Long
    Dim sAppTitle As String
    sWndText = ""
    lRet = SendMessage(lhWnd, WM_GETTEXTLENGTH, 0&, 0&)
    sAppTitle = String(lRet, Chr(0))
    Call SendMessageByString(lhWnd, WM_GETTEXT, lRet + 1, sAppTitle)
    'Filter the applications here:
    sAppTitle = UCase(sAppTitle)
    If (sAppTitle Like "*INTERNET EXPLORER*") Or (sAppTitle Like "*NETSCAPE*") Then
        Call EnumChildWindows(lhWnd, AddressOf EnumChildProc, &H0)
        GetFirstVisibleEditText = sWndText
    End If
End Function
0
 
stephenbladeAuthor Commented:
Works great thanks so much!

0
 
Erick37Commented:
Thank you!
Glad to help.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 7
  • 7
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now