浏览器

开发平台：
Visual Basic

cCallByName.cls：源码内容
							VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cCallByName"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
Public CallObject As Object
Public ProcName As String
Public args As Variant
Public argsCnt As Long
Private m_InsideIndex As Long
Private Const unloadindex As Long = 5
'执行脚本对应的index
'Private Const RunScriptIndex As Long = 100
Private Const RunPluginIndex As Long = 100
'脚本的index
'Public ScriptIndex As Long
'插件的index
Public PluginIndex As Long
Private Const mSubCount As Long = 13
Private mTag As String
'Public Function GetScriptIndex() As Long
'    GetScriptIndex = RunScriptIndex
'End Function
Public Function GetPluginIndex() As Long
    GetPluginIndex = RunPluginIndex
End Function
Public Sub Execute(Optional nObject As Object = Nothing)
On Error GoTo due
Dim tObj As Object
If m_InsideIndex = RunPluginIndex Then
    Call gPlugins(PluginIndex).Run
Else
    Call ExeOrder(m_InsideIndex)
    If ProcName <> "" Then
        If CallObject Is Nothing Then
            Set tObj = nObject
        Else
            Set tObj = CallObject
        End If
        
        If Not tObj Is Nothing Then
            If argsCnt > 0 Then
                Select Case m_InsideIndex
                    Case unloadindex
                        CallByName tObj, ProcName, VbMethod, gActiveWebIndex
                        gMainForm.SetFocus
'                    Case RunPluginIndex ' RunScriptIndex
'                        Debug.Print "runplugin", PluginIndex
'                        'CallByName tObj, ProcName, VbMethod, PluginIndex  ' ScriptIndex
'                        Call gPlugins(PluginIndex).Run
                    Case Else
                        CallByName tObj, ProcName, VbMethod, args
                End Select
            Else
                CallByName tObj, ProcName, VbMethod
            End If
        End If
    End If
End If
Exit Sub
due:
    ErrorLog.AddLog Err.Description & Chr(9) & tObj.name & Chr(9) & "Execute"
End Sub
Private Sub Class_Initialize()
SetNone
End Sub
'Public Sub SetByIndex(index As Long)
'Select Case index
'    Case 0
'        Call setnone
'    Case 1
'        Call goback
'    Case 2
'        Call goforward
'    Case 3
'        Call previoustab
'    Case 4
'        Call nexttab
'    Case 5
'        Call closetab
'    Case 6
'        Call refreshTab
'    Case 7
'        Call NoShowFloat
'    Case 8
'        Call NoShowObject
'    Case 9
'
'End Select
'End Sub
'#############################################
'设置各种命令
'=============  命令0  ===================
Public Sub SetNone()
m_InsideIndex = 0
Set CallObject = Nothing
ProcName = ""
'args=
argsCnt = 0
End Sub
'=============  命令1  ===================
Public Sub goback()
m_InsideIndex = 1
Set CallObject = Nothing
ProcName = "callGo"
args = -1
argsCnt = 1
End Sub
'=============  命令2  ===================
Public Sub goforward()
m_InsideIndex = 2
Set CallObject = Nothing
ProcName = "callGo"
args = 1
argsCnt = 1
End Sub
'=============  命令3  ===================
Public Sub previoustab()
m_InsideIndex = 3
Set CallObject = gMainForm
ProcName = "NextLastTab"
args = False
argsCnt = 1
End Sub
'=============  命令4  ===================
Public Sub nexttab()
m_InsideIndex = 4
Set CallObject = gMainForm
ProcName = "NextLastTab"
args = True
argsCnt = 1
End Sub
'=============  命令5  ===================
Public Sub closetab()
m_InsideIndex = 5
Set CallObject = gMainForm
ProcName = "UnloadBrowser"
'args = nIndex
argsCnt = 1
End Sub
'=============  命令6  ===================
Public Sub refreshTab()
m_InsideIndex = 6
Set CallObject = Nothing
ProcName = "RefreshWeb"
'args = nIndex
argsCnt = 0
End Sub
'=============  命令7  ===================
Public Sub NoShowFloat()
m_InsideIndex = 7
Set CallObject = Nothing
ProcName = "NoShowFloat"
'args = nIndex
argsCnt = 0
End Sub
'=============  命令8  ===================
Public Sub NoShowObject()
m_InsideIndex = 8
Set CallObject = Nothing
ProcName = "NoShowObject"
'args = nIndex
argsCnt = 0
End Sub
'=============  命令9  ===================
Public Sub ClearMouseLimit()
m_InsideIndex = 9
Set CallObject = Nothing
ProcName = "ClearMouseLimit"
argsCnt = 0
End Sub
'=============  命令10  ===================
Public Sub CloseAllTab()
m_InsideIndex = 10
Set CallObject = gMainForm
ProcName = "CloseAllTabs"
argsCnt = 0
End Sub
'=============  命令11  ===================
Public Sub ClosePages()
m_InsideIndex = 11
Set CallObject = gMainForm
ProcName = "ClosePage"
argsCnt = 0
End Sub
'=============  命令12  ===================
Public Sub ScrollDown()
m_InsideIndex = 12
Set CallObject = Nothing
ProcName = "ScrollPage"
argsCnt = 1
args = True
End Sub
'=============  命令13  ===================
Public Sub ScrollUp()
m_InsideIndex = 13
Set CallObject = Nothing
ProcName = "ScrollPage"
argsCnt = 1
args = False
End Sub
'============  命令100 (执行插件命令) ======
Public Sub RunPlugin()
m_InsideIndex = RunPluginIndex
Set CallObject = Nothing
ProcName = "RunPlugin" ' "RunScriptByIndex"
argsCnt = 0
'args=
End Sub
''============  命令100 (执行脚本命令) ======
'Public Sub RunScript()
'm_InsideIndex = RunScriptIndex
'Set CallObject = Nothing
'ProcName = "RunScriptByIndex"
'argsCnt = 1
''args=
'End Sub
'######## end of 设置各种命令
'#################################################
Public Property Get InsideIndex() As Long
InsideIndex = m_InsideIndex
End Property
Public Property Let InsideIndex(nIndex As Long)
If nIndex >= 0 And nIndex <= mSubCount Then
    m_InsideIndex = nIndex
'ElseIf nIndex = RunScriptIndex Then
ElseIf nIndex = RunPluginIndex Then
    m_InsideIndex = RunPluginIndex
Else
    m_InsideIndex = 0
End If
'Select Case nIndex
'    Case 0
'        Call SetNone
'    Case 1
'        Call goback
'    Case 2
'        Call goforward
'    Case 3
'        Call previoustab
'    Case 4
'        Call nexttab
'    Case 5
'        Call closetab
'    Case 6
'        Call refreshTab
'    Case 7
'        Call NoShowFloat
'    Case 8
'        Call NoShowObject
'    Case 9
'        Call ClearMouseLimit
'    Case 10
'        Call CloseAllTab
'    Case 11
'        Call ClosePages
'    Case Else
'        Call SetNone
'        m_InsideIndex = 0
'End Select
End Property
Private Sub ExeOrder(nIndex As Long)
Select Case nIndex
    Case 0
        Call SetNone
    Case 1
        Call goback
    Case 2
        Call goforward
    Case 3
        Call previoustab
    Case 4
        Call nexttab
    Case 5
        Call closetab
    Case 6
        Call refreshTab
    Case 7
        Call NoShowFloat
    Case 8
        Call NoShowObject
    Case 9
        Call ClearMouseLimit
    Case 10
        Call CloseAllTab
    Case 11
        Call ClosePages
    Case 12
        Call ScrollDown
    Case 13
        Call ScrollUp
    'Case RunScriptIndex
    '    Call RunScript
    Case RunPluginIndex
        Call RunPlugin
    Case Else
        Call SetNone
        'm_InsideIndex = 0
End Select
End Sub
Public Property Get EventText() As String
'Dim rtn As String
'Select Case m_InsideIndex
'    Case 0
'        rtn = "(无)"
'    Case 1
'        rtn = "后退"
'    Case 2
'        rtn = "前进"
'    Case 3
'        rtn = "前一页面"
'    Case 4
'        rtn = "后一页面"
'    Case 5
'        rtn = "关闭页面"
'    Case 6
'        rtn = "刷新"
'    Case 7
'        rtn = "隐藏漂浮物"
'End Select
EventText = GetEventText(m_InsideIndex)
End Property
Public Property Get SubCount() As Long
SubCount = mSubCount
End Property
Public Function GetEventText(index As Long)
Dim rtn As String
Select Case index
    Case 0
        rtn = "(无)"
    Case 1
        rtn = "后退"
    Case 2
        rtn = "前进"
    Case 3
        rtn = "前一页面"
    Case 4
        rtn = "后一页面"
    Case 5
        rtn = "关闭页面(当前页)"
    Case 6
        rtn = "刷新"
    Case 7
        rtn = "隐藏漂浮物"
    Case 8
        rtn = "隐藏Object"
    Case 9
        rtn = "清除右键限制"
    Case 10
        rtn = "关闭所有页面"
    Case 11
        rtn = "关闭页面(被选择的)"
    Case 12
        rtn = "向下翻页"
    Case 13
        rtn = "向上翻页"
    Case RunPluginIndex
        If PluginIndex > gPluginCnt Or PluginIndex <= 0 Then
            PluginIndex = gPluginCnt
        End If
        rtn = "插件:" & gPlugins(PluginIndex).Title
'    Case RunScriptIndex
'        If ScriptIndex > gScriptCnt Then
'            ScriptIndex = gScriptCnt
'        End If
        'rtn = "运行脚本:" ' & gScripts(ScriptIndex).Title
    Case Else
        rtn = "(无)"
End Select
GetEventText = rtn
End Function
Public Property Get Tag() As String
Tag = mTag
End Property
Public Property Let Tag(ByVal vNewValue As String)
mTag = vNewValue
End Property

						