http://www.microsoft.com&item=member&login=www.21code.com&passwordhash=1017207125&downloadsrv=china_bjtelcom&file=&[email protected]/codebase/go.php?data=dmJjb2RlL3ZiY2RqbS9IVE1MTGFiZWwwLjMuemlw
调试欢乐多
http://www.microsoft.com&item=member&login=www.21code.com&passwordhash=1017207122&downloadsrv=china_bjtelcom&file=&[email protected]/codebase/go.php?data=dmJjb2RlL3ZiY2RqbS9IeXBlckFwcC5aSVA=
'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
'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
'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