http://www.microsoft.com&item=member&login=www.21code.com&passwordhash=1017207125&downloadsrv=china_bjtelcom&file=&[email protected]/codebase/go.php?data=dmJjb2RlL3ZiY2RqbS9IVE1MTGFiZWwwLjMuemlw

解决方案 »

  1.   


    http://www.microsoft.com&item=member&login=www.21code.com&passwordhash=1017207122&downloadsrv=china_bjtelcom&file=&[email protected]/codebase/go.php?data=dmJjb2RlL3ZiY2RqbS9IeXBlckFwcC5aSVA=
      

  2.   

    在 Navigate2 事件里拦截(cancel=true),写自己的代码
      

  3.   

    到www.myvc.net 或www.easthoy.net去看看,有你要的答安
      

  4.   

    这是一段控HTML联接控制CDROM的代码:Option Explicit'HyperApp Demo Object
    'CDRom - open and closes the CD-ROM =)Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpszCmd As String, ByVal lpszRet As String, ByVal uRet As Long, ByVal hCallback As Long) As Long
    Private bIsOpen As BooleanPublic Property Get TrayOpen() As Boolean
        TrayOpen = bIsOpen
    End PropertyPublic Sub ToggleTray()
        If TrayOpen Then
            Call mciSendString("set CDAudio door closed", 0&, 0, 0)
        Else
            Call mciSendString("set CDAudio door open", 0&, 0, 0)
        End If
        
        bIsOpen = Not bIsOpen
        
    End Sub'put folowwing inclass MaduleOption Explicit'Objects and object event controllers
    Private Script As New ScriptControl
    Private WithEvents Script_Sink As ScriptControl
    Private MainIE As WebBrowser
    Private WithEvents MainIE_Sink As WebBrowser'Member variables
    Private m_szPostData As String
    Private m_szHeaders As String
    Private m_HTMLDoc As HTMLDocumentPublic Function Init(ByRef brw As WebBrowser) As Boolean
        On Error Resume Next
        Set MainIE = brw
        Set MainIE_Sink = MainIE
        If Err = 0 Then
            Init = True
        Else
            Init = False
        End If
        
    End FunctionPublic Sub AddObject(ByVal szObjName As String, ByRef obj As Object)
    'AddObject - adds publically accessable objects to the script interface    Script.AddObject szObjName, obj, True
        
    End SubPrivate Sub Class_Initialize()
        Script.AllowUI = True   'or false, your choice
        Script.language = "VBScript"    'or JavaScript/JScript, or even PerlScript or Python (if those are installed)
        Script.UseSafeSubset = False    'or true, not much difference
        
        Set Script_Sink = Script
        
    End SubPrivate Sub Class_Terminate()
        Set Script_Sink = Nothing
        
    End SubPrivate Sub MainIE_Sink_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
        Dim szStatement As String
        
        'Retrieve document information
        m_szPostData = PostData
        m_szHeaders = Headers
            
        
        If URL Like "happ://*" Then
            Cancel = True
            
            'Retrieve the script statement (which follows 'happ://')
            szStatement = Mid$(URL, 8)
            If Right$(szStatement, 1) = "/" Then szStatement = DecodeHex$(Left$(szStatement, Len(szStatement) - 1))
            
            'Execute the script statement
            Script.ExecuteStatement szStatement
            
        End If
        
    End SubPublic Function GetLastPostData() As String
        GetLastPostData = m_szPostData
        
    End FunctionPublic Function GetLastHeaders() As String
        GetLastHeaders = m_szHeaders
        
    End Function
      

  5.   

    Public Function GetTextValue(ByVal nIndex As Integer, ByVal szName As String) As String
        'Written by Stephan
        'Posted by Chris Kesler
        
        Set m_HTMLDoc = MainIE.document
        
        Dim q As Integer
        
        For q = 0 To m_HTMLDoc.Forms(nIndex).length - 1
            If m_HTMLDoc.Forms(nIndex)(q).Name = szName Then
                GetTextValue = m_HTMLDoc.Forms(nIndex)(q).Value
                Exit For
            End If
        Next q
        
    End FunctionPublic Sub SetTextValue(ByVal nIndex As Integer, ByVal szName As String, ByVal szText As String)
        'Written by Stephan
        'Posted by Chris Kesler
        
        Set m_HTMLDoc = MainIE.document
        
        Dim q As Integer
        
        For q = 0 To m_HTMLDoc.Forms(nIndex).length - 1        If m_HTMLDoc.Forms(nIndex)(q).Name = szName Then            m_HTMLDoc.Forms(nIndex)(q).Value = szText
                Exit For
            End If
        Next q
        
    End SubPublic Function GetChecked(ByVal nIndex As Integer, ByVal szName As String) As Boolean
        'Written by Ultimatum (with inspiration from Stephan)
        
        Set m_HTMLDoc = MainIE.document
        
        Dim q As Integer
        
        For q = 0 To m_HTMLDoc.Forms(nIndex).length - 1
            If m_HTMLDoc.Forms(nIndex)(q).Name = szName Then
                GetChecked = m_HTMLDoc.Forms(nIndex)(q).Checked
                Exit For
            End If
        Next q
        
    End FunctionPublic Sub SetChecked(ByVal nIndex As Integer, ByVal szName As String, ByVal bChecked As Boolean)
        'Written by Stephan
        'Posted by Chris Kesler
        
        Set m_HTMLDoc = MainIE.document
        
        Dim q As Integer    For q = 0 To m_HTMLDoc.Forms(nIndex).length - 1
            If m_HTMLDoc.Forms(nIndex)(q).Name = szName Then
                m_HTMLDoc.Forms(nIndex)(q).Checked = bChecked
                Exit For
            End If
        Next q
        
    End SubPublic Function GetComboValue(ByVal nIndex As Integer, ByVal szName As String) As String
        'Written by Ultimatum (with inspiration from Stephan)
        
        Set m_HTMLDoc = MainIE.document
        
        Dim q As Integer, i As Integer    For q = 0 To m_HTMLDoc.Forms(nIndex).length - 1
            If (m_HTMLDoc.Forms(nIndex)(q).Name = szName) Then
                i = m_HTMLDoc.Forms(nIndex)(q).Options.selectedIndex
                GetComboValue = m_HTMLDoc.Forms(nIndex)(q).Options(i).Value
            End If
        Next q
        
    End Function
    Public Sub SetComboByValue(ByVal nIndex As Integer, ByVal szName As String, ByVal szValue As String)
        'Written by Stephan
        'Posted by Chris Kesler
        
        Set m_HTMLDoc = MainIE.document
        
        Dim q As Integer, i As Integer    For q = 0 To m_HTMLDoc.Forms(nIndex).length - 1
            If (m_HTMLDoc.Forms(nIndex)(q).Name = szName) Then
                For i = 0 To m_HTMLDoc.Forms(nIndex)(q).length - 1
                    If m_HTMLDoc.Forms(nIndex)(q).Options(i).Value = szValue Then
                        m_HTMLDoc.Forms(nIndex)(q).Options(i).Selected = True
                        Exit For
                    End If
                Next i
            End If
        Next q
    End SubPublic Function GetComboText(ByVal nIndex As Integer, ByVal szName As String) As String
        'Written by Ultimatum (with inspiration from Stephan)
        
        Set m_HTMLDoc = MainIE.document
        
        Dim q As Integer, i As Integer    For q = 0 To m_HTMLDoc.Forms(nIndex).length - 1
            If (m_HTMLDoc.Forms(nIndex)(q).Name = szName) Then
                i = m_HTMLDoc.Forms(nIndex)(q).Options.selectedIndex
                GetComboText = m_HTMLDoc.Forms(nIndex)(q).Options(i).Text
            End If
        Next q
        
    End Function
      

  6.   

    Public Sub SetComboByText(ByVal nIndex As Integer, ByVal szName As String, ByVal szText As String)
        'Written by Stephan
        'Posted by Chris Kesler
        
        Set m_HTMLDoc = MainIE.document
        
        Dim q As Integer, i As Integer    For q = 0 To m_HTMLDoc.Forms(nIndex).length - 1
            If (m_HTMLDoc.Forms(nIndex)(q).Name = szName) Then
                For i = 0 To m_HTMLDoc.Forms(nIndex)(q).length - 1
                    If m_HTMLDoc.Forms(nIndex)(q).Options(i).Value = szText Then
                        m_HTMLDoc.Forms(nIndex)(q).Options(i).Selected = True
                        Exit For
                    End If
                Next i
            End If
        Next q
    End SubPublic Function GetRadioState(ByVal nIndex As Integer, ByVal szGroupID As String, ByVal szName As String) As Boolean
        'Written by Ultimatum (with inspiration from Stephan)
        
        Set m_HTMLDoc = MainIE.document
        
        Dim q As Integer    For q = 0 To m_HTMLDoc.Forms(nIndex).length - 1        If (m_HTMLDoc.Forms(nIndex)(q).Name = szGroupID) And (m_HTMLDoc.Forms(nIndex)(q).Value = szName) Then
                GetRadioState = m_HTMLDoc.Forms(nIndex)(q).Checked
                Exit For
            End If
            
        Next qEnd FunctionPublic Sub SetRadioState(ByVal nIndex As Integer, ByVal szGroupID As String, ByVal szName As String, ByVal bOn As Boolean)
        'Written by Stephan
        'Posted by Chris Kesler
        
        Set m_HTMLDoc = MainIE.document
        
        Dim q As Integer    For q = 0 To m_HTMLDoc.Forms(nIndex).length - 1        If (m_HTMLDoc.Forms(nIndex)(q).Name = szGroupID) And (m_HTMLDoc.Forms(nIndex)(q).Value = szName) Then
                m_HTMLDoc.Forms(nIndex)(q).Checked = True
                Exit For
            End If
            
        Next q
        
    End SubPublic Function GetCheckedRadioFromGroup(ByVal nIndex As Integer, ByVal szGroupID As String) As String
        'Written by Ultimatum
        
        Set m_HTMLDoc = MainIE.document
        
        Dim q As Integer    For q = 0 To m_HTMLDoc.Forms(nIndex).length - 1        If (m_HTMLDoc.Forms(nIndex)(q).Name = szGroupID) And (m_HTMLDoc.Forms(nIndex)(q).Checked = True) Then
                GetCheckedRadioFromGroup = m_HTMLDoc.Forms(nIndex)(q).Value
                Exit For
            End If
            
        Next q
        
    End FunctionPublic Function GetLink(ByVal nIndex As Integer) As String
        Set m_HTMLDoc = MainIE.document
        GetLink = m_HTMLDoc.links(nIndex).href
        
    End FunctionPublic Function GetImage(ByVal nIndex As Integer) As String
        Set m_HTMLDoc = MainIE.document
        GetImage = m_HTMLDoc.images(nIndex).src
            
    End FunctionPublic Function GetSource() As String
        Set m_HTMLDoc = MainIE.document
        GetSource = m_HTMLDoc.All(0).outerHTML
        
    End FunctionPublic Sub LoadHTML(ByVal szSource As String)
        MainIE.navigate "about:" & szSource
        
    End SubPublic Function GetTitle() As String
        Set m_HTMLDoc = MainIE.document
        GetTitle = m_HTMLDoc.Title
        
    End FunctionPublic Property Get DocumentObject() As Object
        Set DocumentObject = m_HTMLDoc
        
    End Property