用Shell打开网址问题

[cannycsy]

Shell IEXPLORE.EXE http://www.baidu.com,1

请问如何设置访问www.baidu.com的来路呢。

不用Shell或者用ShellExecute能实现也行.


虑拟一个来路的意思就是，如：我在谷歌搜索之后打开百度的，那么，打开百度的来路就是谷歌。

不知怎么实现这个功能呢？

[贝隆]

没有理解楼主之意...回复内容太短了

[cannycsy]

像这样也可以实现访问来路,但它会不在IE里显示。

Dim HTTP As MSXML2.XMLHTTP26
URL = "http://www.google.com"
HTTP.Open "POST", URL, True
HTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 7.0; Windows NT 6.0; SV1; .NET CLR 2.0.50727)"
HTTP.setRequestHeader "Referer", "http://www.baidu.com"
HTTP.send


我要用IE来做来路，不知怎么实现呢？

[lyserver]

下面是拦截地址栏事件的例子，输入www.baidu.com，将导自动转向www.google.com.hk，输入www.google.com，将会自动转向www.baidu.com。

[lyserver]

'* ************************************** *
'* 类名称：IEHooker
'* 类功能：IE事件监控类
'* 作者：lyserver
'* 备注：需要引用Microsoft Internet Controls类库
'* ************************************** *
  
Option Explicit
  
Dim WithEvents m_shWindows As ShellWindows
Dim m_ieEvent() As IEEvent
Dim m_nIeCount As Long
  
'- -----------------------------------
' 过程说明：类初始化
'- -----------------------------------
Private Sub Class_Initialize()
    Dim objIE As InternetExplorer
       
    '加入已打开的IE对象到数组中
    Set m_shWindows = New ShellWindows
    For Each objIE In m_shWindows
        If InStr(objIE.FullName, "\iexplore.exe") Then
            ReDim Preserve m_ieEvent(m_nIeCount)
            Set m_ieEvent(m_nIeCount) = New IEEvent
            Set m_ieEvent(m_nIeCount).m_objIE = objIE
            Set m_ieEvent(m_nIeCount).m_objDoc = objIE.Document
            m_nIeCount = m_nIeCount + 1
        End If
    Next
End Sub
  
'- -----------------------------------
' 过程说明：类销毁
'- -----------------------------------
Private Sub Class_Terminate()
    Dim i As Long
       
    '销毁数组
    For i = 0 To m_nIeCount - 1
        Set m_ieEvent(i) = Nothing
    Next
    Erase m_ieEvent
End Sub
  
'- -----------------------------------
' 过程说明：IE窗口打开事件
'- -----------------------------------
Private Sub m_shWindows_WindowRegistered(ByVal lCookie As Long)
    Dim objIE As InternetExplorer
        
    '加入将要打开的IE对象到数组中
    Set objIE = m_shWindows(m_shWindows.Count - 1)
    If InStr(objIE.FullName, "\iexplore.exe") = 0 Then Exit Sub
    ReDim Preserve m_ieEvent(m_nIeCount)
    Set m_ieEvent(m_nIeCount) = New IEEvent
    Set m_ieEvent(m_nIeCount).m_objIE = objIE
    m_nIeCount = m_nIeCount + 1
End Sub
  
'- -----------------------------------
' 过程说明：IE窗口关闭事件
'- -----------------------------------
Private Sub m_shWindows_WindowRevoked(ByVal lCookie As Long)
    Dim i As Long
    Dim blnFound As Boolean
  
    '从数组中移出将要关闭的IE对象
    For i = 0 To m_nIeCount - 1
        If m_ieEvent(i).m_objIE Is Nothing Then blnFound = True
        If blnFound Then
            If i = m_nIeCount - 1 Then Exit For
            Set m_ieEvent(i) = m_ieEvent(i + 1)
        End If
    Next
    m_nIeCount = m_nIeCount - 1
    If m_nIeCount > 0 Then ReDim Preserve m_ieEvent(m_nIeCount - 1)
End Sub

[lyserver]

'* ************************************** *
'* 类名称：IEEvent
'* 类功能：IE事件类
'* 作者：lyserver
'* 备注：需要引用Microsoft Internet Controls
'*     和Microsoft HTML Object Library类库
'* ************************************** *
  
Option Explicit
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
  
Public WithEvents m_objIE As InternetExplorer
Public WithEvents m_objDoc As HTMLDocument
  
'- -----------------------------------
' 过程说明：类初始化
'- -----------------------------------
Private Sub Class_Initialize()
    '
End Sub
  
'- -----------------------------------
' 过程说明：类销毁
'- -----------------------------------
Private Sub Class_Terminate()
    Set m_objDoc = Nothing
    Set m_objIE = Nothing
End Sub
  
'- -----------------------------------
' 函数说明：拦载IE导航事件
'- -----------------------------------
Private Sub m_objIE_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
    Static blnChanged As Boolean
    Dim strURL As String
    
    If blnChanged = True Then
        blnChanged = False
    Else
        strURL = LCase(URL)
        If strURL Like "*www.baidu.com*" Then
            blnChanged = True
            Cancel = True
            m_objIE.Navigate2 "http://www.google.com.hk"
        ElseIf strURL Like "*.www.google.*" Then
            blnChanged = True
            Cancel = True
            m_objIE.Navigate2 "http://www.baidu.com"
        End If
    End If
End Sub

'- -----------------------------------
' 过程说明：IE窗口关闭事件
'- -----------------------------------
Private Sub m_objIE_OnQuit()
    Set m_objIE = Nothing
End Sub