Finding out what site is being visited.

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

That is just what i am looking for, does anybody know it for Netscape?

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

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

P.S. I've never used the code I posted, I've just seen it somewhere...

KDivad - I have no idea what u r talking about!

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.

so we just need to get it working for netscape?

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

Thankyou all for your help.

KDivad - Is there anything that simple for Netscape?

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

danmessenger,
(like AzraSound said) only if NetScape had included the capability into their browser, which I have doubts that they did.

why is that the answer? it only takes care of IE?

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.

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.

{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.

Thanks, I shall remember that in future.

not a problem kdivad.  its not that big of an issue.  thanks for the offer though.  

You're welcome! (to both of you)

Later,