我从网上查询到获得地址栏的代码,不过只可以获得 打开后IE后的界面中地址栏的地址,
不可以获得打开桌面上的"我的电脑"后的界面中的地址栏.为什么?Option ExplicitPrivate 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 Any _
) As Long
Private Declare Function GetWindow Lib "user32" ( _
ByVal hwnd As Long, _
ByVal wCmd As Long _
) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long _
) As Long
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_SETTEXT = &HC
Private Const WM_KEYDOWN = &H100
Private Const VK_RETURN = &HD
Private Const MAX_PATH = 260
Public Function GetURL() As String
Dim sIEClassName As String, hIE As Long, lngRep As Long
Dim sText As String * 255, sClass As String * 255
Dim iNum As Long, hwndChild As Long, lngRepClassName As Long
Dim lngLength As Long, sURL As String
On Error GoTo Fin
sIEClassName = "IEFrame"
hIE = FindWindow(sIEClassName, vbNullString)
If hIE <> 0 Then
hwndChild = hIE
hwndChild = hwndFindWindow(hwndChild, "WorkerW")
If hwndChild = 0 Then Err.Raise 10
hwndChild = hwndFindWindow(hwndChild, "ReBarWindow32")
If hwndChild = 0 Then Err.Raise 10
hwndChild = hwndFindWindow(hwndChild, "ComboBoxEx32")
If hwndChild = 0 Then Err.Raise 10
hwndChild = hwndFindWindow(hwndChild, "ComboBox")
If hwndChild = 0 Then Err.Raise 10
hwndChild = hwndFindWindow(hwndChild, "Edit")
If hwndChild = 0 Then Err.Raise 10
GetURL = ExtractURL(hwndChild)
End If
Exit Function
Fin:
MsgBox "Erreur"
End FunctionPrivate Function SupprimeNull(sM As String) As String
If (InStr(sM, Chr(0)) > 0) Then
sM = Left(sM, InStr(sM, Chr(0)) - 1)
End If
SupprimeNull = sM
End FunctionPrivate Function ExtractURL(hwnd As Long) As String
Dim lngLength As Long, sURL As String, lngRep As LonglngLength = SendMessage(hwnd, WM_GETTEXTLENGTH, 0, ByVal 0)
sURL = Space(lngLength + 1)
lngRep = SendMessage(hwnd, WM_GETTEXT, lngLength + 1, ByVal sURL)
ExtractURL = SupprimeNull(sURL)
End Function
'
Private Function hwndFindWindow(hwndParent As Long, sClassName As String) As Long
Dim hwndChild As Long, sClass As String * MAX_PATH
Dim bTrouve As Boolean, lngRepClassName As StringhwndChild = GetWindow(hwndParent, GW_CHILD)
lngRepClassName = GetClassName(hwndChild, sClass, 255)
If Left(sClass, lngRepClassName) = sClassName Then
hwndFindWindow = hwndChild
Exit Function
End If
If hwndChild = 0 Then Exit FunctionbTrouve = False
Do Until bTrouve
hwndChild = GetWindow(hwndChild, GW_HWNDNEXT)
If hwndChild = 0 Then Exit Do
lngRepClassName = GetClassName(hwndChild, sClass, MAX_PATH)
If Left(sClass, lngRepClassName) = sClassName Then
hwndFindWindow = hwndChild
Exit Function
End If
Loop
End FunctionPrivate Sub Command1_Click()
Dim strURL As String
strURL = GetURL() '获得地址
End Sub
不可以获得打开桌面上的"我的电脑"后的界面中的地址栏.为什么?Option ExplicitPrivate 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 Any _
) As Long
Private Declare Function GetWindow Lib "user32" ( _
ByVal hwnd As Long, _
ByVal wCmd As Long _
) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long _
) As Long
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_SETTEXT = &HC
Private Const WM_KEYDOWN = &H100
Private Const VK_RETURN = &HD
Private Const MAX_PATH = 260
Public Function GetURL() As String
Dim sIEClassName As String, hIE As Long, lngRep As Long
Dim sText As String * 255, sClass As String * 255
Dim iNum As Long, hwndChild As Long, lngRepClassName As Long
Dim lngLength As Long, sURL As String
On Error GoTo Fin
sIEClassName = "IEFrame"
hIE = FindWindow(sIEClassName, vbNullString)
If hIE <> 0 Then
hwndChild = hIE
hwndChild = hwndFindWindow(hwndChild, "WorkerW")
If hwndChild = 0 Then Err.Raise 10
hwndChild = hwndFindWindow(hwndChild, "ReBarWindow32")
If hwndChild = 0 Then Err.Raise 10
hwndChild = hwndFindWindow(hwndChild, "ComboBoxEx32")
If hwndChild = 0 Then Err.Raise 10
hwndChild = hwndFindWindow(hwndChild, "ComboBox")
If hwndChild = 0 Then Err.Raise 10
hwndChild = hwndFindWindow(hwndChild, "Edit")
If hwndChild = 0 Then Err.Raise 10
GetURL = ExtractURL(hwndChild)
End If
Exit Function
Fin:
MsgBox "Erreur"
End FunctionPrivate Function SupprimeNull(sM As String) As String
If (InStr(sM, Chr(0)) > 0) Then
sM = Left(sM, InStr(sM, Chr(0)) - 1)
End If
SupprimeNull = sM
End FunctionPrivate Function ExtractURL(hwnd As Long) As String
Dim lngLength As Long, sURL As String, lngRep As LonglngLength = SendMessage(hwnd, WM_GETTEXTLENGTH, 0, ByVal 0)
sURL = Space(lngLength + 1)
lngRep = SendMessage(hwnd, WM_GETTEXT, lngLength + 1, ByVal sURL)
ExtractURL = SupprimeNull(sURL)
End Function
'
Private Function hwndFindWindow(hwndParent As Long, sClassName As String) As Long
Dim hwndChild As Long, sClass As String * MAX_PATH
Dim bTrouve As Boolean, lngRepClassName As StringhwndChild = GetWindow(hwndParent, GW_CHILD)
lngRepClassName = GetClassName(hwndChild, sClass, 255)
If Left(sClass, lngRepClassName) = sClassName Then
hwndFindWindow = hwndChild
Exit Function
End If
If hwndChild = 0 Then Exit FunctionbTrouve = False
Do Until bTrouve
hwndChild = GetWindow(hwndChild, GW_HWNDNEXT)
If hwndChild = 0 Then Exit Do
lngRepClassName = GetClassName(hwndChild, sClass, MAX_PATH)
If Left(sClass, lngRepClassName) = sClassName Then
hwndFindWindow = hwndChild
Exit Function
End If
Loop
End FunctionPrivate Sub Command1_Click()
Dim strURL As String
strURL = GetURL() '获得地址
End Sub
把参数lpClassName的值设置为"CabinetWClass"就可以了."CabinetWClass"是打开桌面上的"我的电脑"后的窗口的类名.