Solved

Finding out what site is being visited.

Posted on 2000-04-19
21
155 Views
Last Modified: 2010-05-02
I need to be able to find out what site is currently being visited in a Netscape or IE5 browser. This site will then be displayed in a textbox.

ANY ideas appreciated.
0
Comment
Question by:danmessenger
  • 8
  • 7
  • 6
21 Comments
 
LVL 28

Expert Comment

by:AzraSound
ID: 2732286
Heres code for IE:


Private Declare Function shellexecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As _
String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessageLong& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Private 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
Const WM_USER = &H400
Const EM_LIMITTEXT = WM_USER + 21
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1

Private Sub cmdGet_Click()

    On Error GoTo CallErrorA
    Dim iPos As Integer
    Dim sClassName As String
    Dim GetAddressText As String
    Dim lhwnd As Long
    Dim WindowHandle As Long
   
    lhwnd = 0
    sClassName = ("IEFrame")
    lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
    sClassName = ("WorkerA")
    lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
    sClassName = ("ReBarWindow32")
    lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
    sClassName = ("ComboBoxEx32")
    lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
    sClassName = ("ComboBox")
    lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
    sClassName = ("Edit")
    lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
       
    WindowHandle& = lhwnd
    Dim buffer As String, TextLength As Long
    TextLength& = SendMessage(WindowHandle&, WM_GETTEXTLENGTH, 0&, 0&)
    buffer$ = String(TextLength&, 0&)
    Call SendMessageByString(WindowHandle&, WM_GETTEXT, TextLength& + 1, buffer$)
    MsgBox buffer$

   Exit Sub
CallErrorA:
    MsgBox Err.Description
    Err.Clear

End Sub
0
 

Author Comment

by:danmessenger
ID: 2732613
That is just what i am looking for, does anybody know it for Netscape?
0
 
LVL 28

Expert Comment

by:AzraSound
ID: 2732735
if you know the exact title name in the netscape window you may be able to do the same thing except pass the Netscape window title to the findwindow function to get its handle.  however the problem is that quite often we dont know the exact title.  i'm not at home right now but i believe i dnloaded a project that finds the title of the window based on finding a part of the title at www.mvps.org in the sample code section.  i think its called findpart.zip or something.  you may look into that and see if itll do what you want
0
 
LVL 5

Expert Comment

by:KDivad
ID: 2733075
For IE, here's an idea: Set a reference to shdocvw.dll and use code that is something like this:

Dim IE As New SHDocVw.InternetExplorer
Dim IEWindows As New SHDocVw.ShellWindows

For Each IE In IEWindows
    If IE.LocationURL ... Then
        'Got the URL, do something with it
    End If
Next
0
 
LVL 5

Expert Comment

by:KDivad
ID: 2733077
P.S. I've never used the code I posted, I've just seen it somewhere...
0
 

Author Comment

by:danmessenger
ID: 2736117
KDivad - I have no idea what u r talking about!
0
 

Author Comment

by:danmessenger
ID: 2736145
I need something specific, it is for a tracer on my schools network. We have been having problems with people going to 'Adult orientated' sites. It would help if it would give the exact page, eg.

http://www.altavista.com/cgi-bin/query?sc=on&hl=on&q=pamela+naked&kl=XX&pg=q

and not just:

http://www.altavista.com

which is what the top piece of code does.

Sorry about not being precise in the begining.
0
 
LVL 28

Expert Comment

by:AzraSound
ID: 2736455
so we just need to get it working for netscape?
0
 
LVL 5

Accepted Solution

by:
KDivad earned 15 total points
ID: 2737064
danmessenger,

The code I posted is supposed to give access to IE in the form of a collection containing all the open IE windows. I just tried it and works perfectly.

On the menu:
Got to "Project" - "References" and check "Microsoft Internet Controls".

In a new project, add this code:
Sub Form_Load()

    Dim IE As New SHDocVw.InternetExplorer
    Dim IEWindows As New SHDocVw.ShellWindows
    For Each IE In IEWindows
        MsgBox IE.LocationURL, , IE.LocationName
    Next

End Sub

It will pop up a msgbox containing the URL for each open IE window with the page title for the msgbox caption.
0
 
LVL 28

Expert Comment

by:AzraSound
ID: 2737103
Ok here is the solution for Netscape:

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetActiveWindow Lib "user32" Alias "SetForegroundWindow" (ByVal hwnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private 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

Const SW_RESTORE = 9
Const GW_HWNDNEXT = 2
Const FWP_STARTSWITH = 0
Const FWP_CONTAINS = 1
Const WM_GETTEXT = &HD
Const WM_GETTEXTLENGTH = &HE

Function GetNetscapeURL()
    On Error GoTo Errhandler
    Dim hwnd As Long
    Dim urlText As String
    Dim TextLength As Long
    Dim buffer As String
    hwnd = FindWindowPartial("Netscape", FWP_CONTAINS)
    TextLength = SendMessage(hwnd, WM_GETTEXTLENGTH, 0&, 0&)
    buffer = String(TextLength, 0&)
    Call SendMessageByString(hwnd, WM_GETTEXT, TextLength& + 1, buffer$)
    MsgBox buffer
    Exit Function
Errhandler:
    MsgBox Err.Description
    Err.Clear
End Function

Function FindWindowPartial(TitleStart As String, Method As Integer) As Long
   Dim hWndTmp
   Dim nRet
   Dim TitleTmp As String
   '
   ' Find first window and loop through all subsequent
   ' windows in master window list.
   '
   hWndTmp = FindWindow(vbNullString, vbNullString)
   Do Until hWndTmp = 0
      '
      ' Make sure this window has no parent.
      '
      If GetParent(hWndTmp) = 0 Then
         '
         ' Retrieve caption text from current window.
         '
         TitleTmp = Space(256)
         nRet = GetWindowText(hWndTmp, TitleTmp, Len(TitleTmp))
         If nRet Then
            '
            ' Clean up return string, preparing for
            ' case-insensitive comparison.
            '
            TitleTmp = UCase(Left(TitleTmp, nRet))

            If InStr(TitleTmp, UCase(TitleStart)) Then
                FindWindowPartial = hWndTmp
                Exit Do
            End If
         End If
      End If
      '
      ' Get next window in master window list and continue.
      '
      hWndTmp = GetWindow(hWndTmp, GW_HWNDNEXT)
   Loop
End Function

Private Sub Command1_Click()
    Call GetNetscapeURL
End Sub


0
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 

Author Comment

by:danmessenger
ID: 2737958
Thankyou all for your help.
0
 

Author Comment

by:danmessenger
ID: 2737964
KDivad - Is there anything that simple for Netscape?
0
 
LVL 28

Expert Comment

by:AzraSound
ID: 2737979
no not simple for netscape b/c it is not a miscrosoft product.  ie has simple routine b/c it is part of MS and they supply built in routines for it
0
 
LVL 5

Expert Comment

by:KDivad
ID: 2738579
danmessenger,
(like AzraSound said) only if NetScape had included the capability into their browser, which I have doubts that they did.
0
 
LVL 28

Expert Comment

by:AzraSound
ID: 2738659
why is that the answer? it only takes care of IE?
0
 

Author Comment

by:danmessenger
ID: 2738672
i would accept both of the answers, his because it is shorter than yours and yours because it does netscape, BUT this site only allows me to give the points to one of you.

If you come up with a shorter sollution for Netscape then i will post another question and you can have the points for that one.
0
 
LVL 28

Expert Comment

by:AzraSound
ID: 2738690
sorry that is the only way.  for future reference you can ask customer service to split points up.  also i recommend you read the sites policies about point values for questions.  50 points is considered easy.  some people might give you a hard time about that.  if you find shorter way to get netscape to work please let me know as i know of no other way.  i'm glad you are able to use my code for a good cause.
0
 
LVL 5

Expert Comment

by:KDivad
ID: 2739390
{sour laugh} I wasn't even after the points, because I didn't know a method for NetScape and don't have NetScape to create one with.

AzraSound, I have a few extra points. If you like, I'll post a question to you to give you the same amount dan gave me (15 * A).

DanMessenger, AzraSound does have a point. For the amount of work he(?) did, 15 points isn't very much. A lot of people would give you trouble over it. You got lucky that we were the ones who found your question, because many experts here won't even LOOK at a 15-pointer.
0
 

Author Comment

by:danmessenger
ID: 2739594
Thanks, I shall remember that in future.
0
 
LVL 28

Expert Comment

by:AzraSound
ID: 2740008
not a problem kdivad.  its not that big of an issue.  thanks for the offer though.  
0
 
LVL 5

Expert Comment

by:KDivad
ID: 2741241
You're welcome! (to both of you)

Later,
0

Featured Post

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.

Join & Write a Comment

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
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 Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

759 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

19 Experts available now in Live!

Get 1:1 Help Now