danmessenger
asked on
Finding out what site is being visited.
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.
ANY ideas appreciated.
ASKER
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
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...
ASKER
KDivad - I have no idea what u r talking about!
ASKER
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.
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?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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("Netscap e", 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(TitleSta rt 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
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("Netscap
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(TitleSta
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
ASKER
Thankyou all for your help.
ASKER
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.
(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?
ASKER
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.
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.
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.
ASKER
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,
Later,
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&,
buffer$ = String(TextLength&, 0&)
Call SendMessageByString(Window
MsgBox buffer$
Exit Sub
CallErrorA:
MsgBox Err.Description
Err.Clear
End Sub