Solved

Getting current browser url..

Posted on 2000-02-23
18
456 Views
Last Modified: 2012-08-13
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
Comment
Question by:stephenblade
  • 7
  • 7
  • 4
18 Comments
 
LVL 32

Expert Comment

by:Erick37
ID: 2552291
Getting the URL string from IE's edit window:
http://www.vbcode.com/asp/showsn.asp?theID=1005
0
 
LVL 9

Expert Comment

by:Ruchi
ID: 2552324
0
 
LVL 1

Author Comment

by:stephenblade
ID: 2552337
ROFLOL... Ruchi.. That is where I got the code..LOL Just can't seem to get it to work.


0
 
LVL 9

Expert Comment

by:Ruchi
ID: 2552367
LOL!!!!

is the program not working successfully?
0
 
LVL 1

Author Comment

by:stephenblade
ID: 2552399
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
 
LVL 9

Expert Comment

by:Ruchi
ID: 2552453
when i ran the program, i did not get any error.
0
 
LVL 1

Author Comment

by:stephenblade
ID: 2552459
Did it work? and if it did would you email me a zip of the project?

stephen@savvyshoppers.com
0
 
LVL 9

Expert Comment

by:Ruchi
ID: 2552491
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
 
LVL 9

Expert Comment

by:Ruchi
ID: 2552520
my email message is on the way to your address.
0
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 1

Author Comment

by:stephenblade
ID: 2552539
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
 
LVL 9

Expert Comment

by:Ruchi
ID: 2552598
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
 
LVL 1

Author Comment

by:stephenblade
ID: 2552613
He is saying check the title bar for the words microsoft internet explorer using the instr function.
0
 
LVL 9

Expert Comment

by:Ruchi
ID: 2552637
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
 
LVL 32

Expert Comment

by:Erick37
ID: 2552716
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
 
LVL 1

Author Comment

by:stephenblade
ID: 2552807
Perfect but can you make it work for netscape as well?

0
 
LVL 32

Accepted Solution

by:
Erick37 earned 300 total points
ID: 2553055
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
 
LVL 1

Author Comment

by:stephenblade
ID: 2553064
Works great thanks so much!

0
 
LVL 32

Expert Comment

by:Erick37
ID: 2553096
Thank you!
Glad to help.
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now