vb获得当前IE地址栏中的地址的代码

这段代码展示了如何使用VB来获取当前打开的Internet Explorer浏览器地址栏中的URL。通过声明并调用FindWindow、SendMessage等函数,遍历窗口类名,最终从编辑框中提取出URL。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

Option Explicit

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 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 Function
   
' Public Function SetURL(sNewURL 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
'          lngRep = SendMessage(hwndChild, WM_SETTEXT, 0, ByVal sNewURL)
'          lngRep = SendMessage(hwndChild, WM_KEYDOWN, VK_RETURN, 0)
' End If
' Exit Function
'Fin:
' MsgBox "Erreur"
' End Function
'
Private 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 Function

Private Function ExtractURL(hwnd As Long) As String
Dim lngLength     As Long, sURL       As String, lngRep       As Long

lngLength = 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 String

hwndChild = 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 Function

bTrouve = 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 Function

评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值