浏览器

开发平台：
Visual Basic

Plugin.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 = "cPluginData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'---------------------------------------------------------------------------------------
' Module    : cPluginData
' DateTime  : 2005-3-15 17:30
' Author    : Lingll
' Purpose   : 插件,command型插件
'---------------------------------------------------------------------------------------
Option Explicit
'插件数据--脚本插件
Private Type PluginData_Script
    'Title As String
    Language As String
    Script As String
    LoadedScript As Boolean '是否加载了脚本
    'FileName As String
    '程序启动时是否加载脚本,0:启动时不加载,1:启动时加载
    LoadAtExec As Long
    '执行类型,可以有三个值,0:在顶层页面中执行,1:在页面中的每一个frame都执行,2:仅在鼠标所在的frame中执行
    RunType As Long
End Type
'插件数据--exe插件
Private Type PluginData_Exe
    'Title As String
    'FileName As String
    Param As String
End Type
'插件数据--com插件
Private Type PluginData_Com
    'Title As String
    'FileName As String
    ObjectName As String
    ClassID As String
End Type
'插件数据--dll插件
Private Type PluginData_Dll
    'Title As String
    'FileName As String
    message As Long
    Reserve As Long
End Type
'插件数据--sendkey插件
Private Type PluginData_Sendkey
    Keydata As String
End Type
Private Declare Function RunDll Lib "rundllvb.dll" _
    (ByVal lpDll As String, ByVal lpWeb As Object, ByVal MSG&, ByVal wParam&, ByVal lParam&) As Long
Private Declare Function RegCom Lib "rundllvb.dll" _
    (ByVal lpDll As String, ByVal isreg&) As Long
Public Title As String      '名称,对应于菜单或按钮显示的文字
Public FileName As String   '要执行的文件名,exe | ini
Public Param As String
Public VisInMenu As Long    '是否在"插件菜单"中显示
Public IconFile As String
Private DirectExe As Long          '是否直接的exe文件
Private ModuleType As String    'script,exe,com,dll,sendkey
Private PluginType As String    'command,sideband,toolband,
                                '也就是执行与存在方式,对应的是命令,侧边栏,工具栏
Private o_FileName As String       'ini中指向的真实文件名
Private o_Title As String       'ini文件中的Title
Private mData_Script As PluginData_Script
Private mData_Exe As PluginData_Exe
Private mData_Com As PluginData_Com
Private mData_Dll As PluginData_Dll
Private mData_Sendkey As PluginData_Sendkey
Private Const m_MTStr_Script As String = "script"
Private Const m_MTStr_Exe As String = "exe"
Private Const m_MTStr_Com As String = "com"
Private Const m_MTStr_Dll As String = "dll"
Private Const m_MTStr_Sendkey As String = "sendkey"
'Private mPluginData As PluginData
Public Sub Run()
On Error Resume Next
Dim tPath$, tParam$
Debug.Print "run"
Select Case LCase$(ModuleType)
    Case m_MTStr_Script
        If loadedBrowserCount > 0 Then
            If Not mData_Script.LoadedScript Then
                Call LoadScriptFile2
            End If
            webbState(gActiveWebIndex).webForm.RunScript mData_Script.Script, mData_Script.Language, mData_Script.RunType
        End If
    Case m_MTStr_Exe
        tParam = TranslateParam(mData_Exe.Param)
        tPath = TranslatePath2(o_FileName)
        
        ShellExecute 0&, "open", tPath, _
        tParam, tPath, SW_SHOW
    Case m_MTStr_Com
        Call Run_Com
    Case m_MTStr_Dll
        If loadedBrowserCount > 0 Then
            Call RunDll(TranslatePath2(o_FileName), webbState(gActiveWebIndex).webForm.webMe, mData_Dll.message, 0, 0)
        Else
            Call RunDll(TranslatePath2(o_FileName), Nothing, mData_Dll.message, 0, 0)
        End If
    Case m_MTStr_Sendkey
        SendKeys mData_Sendkey.Keydata
End Select
End Sub
Private Sub Run_Com()
Dim tObj As LEPluginLib.ILEpluginCmd
Dim tDll As cCrDllObj
On Error Resume Next
Set tDll = New cCrDllObj
tDll.IniClsId mData_Com.ClassID
Set tObj = tDll.CreateMyDllObject(TranslatePath2(o_FileName))
If tObj Is Nothing Then
    Call MsgBox("some error", vbOKOnly Or vbExclamation)
Else
    If loadedBrowserCount > 0 Then
        tObj.SetSite webbState(gActiveWebIndex).webForm.webMe, gOutInfo
        tObj.RunCommand
    Else
        tObj.SetSite Nothing, gOutInfo
        tObj.RunCommand
    End If
    Set tObj = Nothing
End If
'On Error Resume Next
'Dim tObj As Object
'Err.Clear
'Set tObj = CreateObject(mData_Com.ObjectName)
'If Err.Number = 429 Then
'    Call RegCom(TranslatePath2(o_FileName), 1)
'    Set tObj = CreateObject(mData_Com.ObjectName)
'End If
'If tObj Is Nothing Then
'    Call MsgBox("some error", vbOKOnly Or vbExclamation)
'Else
'    If loadedBrowserCount > 0 Then
'        tObj.Run webbState(gActiveWebIndex).webForm.webMe, gMainForm
'    Else
'        tObj.Run Nothing, gMainForm
'    End If
'End If
End Sub
Private Function TranslatePath(vPath$) As String
Dim tPath$
Dim tSysDir$
    tPath = vPath
    tPath = Replace(tPath, "%app%", App.path, , , vbTextCompare)
    tPath = Replace(tPath, "%windir%", Environ("windir"), , , vbTextCompare)
    
    If InStr(1, tPath, "%system%", vbTextCompare) > 0 Then
        If IsWinNT() Then
            tSysDir = Environ("windir") & "system32"
        Else
            tSysDir = Environ("windir") & "system"
        End If
        tPath = Replace(tPath, "%system%", tSysDir, , , vbTextCompare)
    End If
    
    TranslatePath = tPath
    
End Function
'用于有 . 的情况
Private Function TranslatePath2(vPath$) As String
TranslatePath2 = TranslatePath(Replace(vPath, ".", GetFileFolder(FileName) & ""))
End Function
Private Function TranslateParam(vParam$) As String
Dim tParam$
    tParam = vParam
    If loadedBrowserCount > 0 Then
        tParam = Replace(tParam, "%url%", webbState(gActiveWebIndex).webForm.GetWebUrl, , , vbTextCompare)
        tParam = Replace(tParam, "%WebWinHwnd%", webbState(gActiveWebIndex).webForm.hWnd, , , vbTextCompare)
    Else
        tParam = Replace(tParam, "%url%", "", , , vbTextCompare)
        tParam = Replace(tParam, "%WebWinHwnd%", "", , , vbTextCompare)
    End If
TranslateParam = tParam
End Function
Public Sub Reload()
If FileExist(TranslatePath(FileName)) Then
    If LCase$(GetExtendName(FileName)) = "ini" Then
        Call ReadData
    Else
        IconFile = vbNullString
        DirectExe = 1
        ModuleType = m_MTStr_Exe
        o_FileName = FileName
        o_Title = vbNullString
        mData_Exe.Param = Param
    End If
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : ReadData
' DateTime  : 2005-5-28 18:47
' Author    : Lingll
' Purpose   : 读取插件详细数据
'---------------------------------------------------------------------------------------
Private Sub ReadData()
Dim tIni As cINIFile
Set tIni = New cINIFile
tIni.IniFile = TranslatePath(FileName)
If Trim(tIni.ReadKey("General", "Flag")) = LEPluginFlag Then
    If LCase(Trim(tIni.ReadKey("General", "PluginType"))) = PluginTypeTag_Command Then
        o_FileName = tIni.ReadKey("General", "FileName")
        o_Title = tIni.ReadKey("General", "Title")
        ModuleType = LCase$(Trim$(tIni.ReadKey("General", "ModuleType")))
        IconFile = tIni.ReadKey("General", "IconFile")
        
        Select Case ModuleType
            Case "script"
                Call LoadScript(tIni)
            Case "exe"
                mData_Exe.Param = tIni.ReadKey(m_MTStr_Exe, "Param")
            Case "com"
                mData_Com.ClassID = tIni.ReadKey(m_MTStr_Com, "ClassID")
                mData_Com.ObjectName = tIni.ReadKey(m_MTStr_Com, "ObjectName")
            Case "dll"
                mData_Dll.message = tIni.ReadInt(m_MTStr_Dll, "Message", 0)
            Case "sendkey"
                mData_Sendkey.Keydata = tIni.ReadSection(m_MTStr_Sendkey)
        End Select
    End If
End If
End Sub
'读取脚本文件
Private Sub LoadScript(vIni As cINIFile)
Dim tFN&
With vIni
    mData_Script.Language = .ReadKey(m_MTStr_Script, "Language", "javascript")
    mData_Script.LoadedScript = False
    mData_Script.RunType = Val(.ReadKey(m_MTStr_Script, "RunType", "0"))
    'mData_Script.LoadAtExec = Val(.ReadKey(Script, "LoadAtExec", "0"))
    mData_Script.LoadAtExec = .ReadInt(m_MTStr_Script, "LoadAtExec", 0)
End With
If mData_Script.LoadAtExec <> 0 Then
    tFN = FreeFile
    Open TranslatePath2(o_FileName) For Binary As tFN
        mData_Script.Script = StrConv(InputB(LOF(tFN), tFN), vbUnicode)
    Close tFN
    mData_Script.LoadedScript = True
End If
End Sub
'运行时才加载脚本文件的sub
Private Sub LoadScriptFile2()
On Error GoTo due
Dim tFN&, tPos&
Dim tstr$
tFN = FreeFile
Open TranslatePath2(o_FileName) For Binary As tFN
    mData_Script.Script = StrConv(InputB(LOF(tFN), tFN), vbUnicode)
Close tFN
mData_Script.LoadedScript = True
Exit Sub
due:
    Reset
    mData_Script.LoadedScript = False
    mData_Script.Script = ""
    ErrorLog.AddLog "cPluginData.loadscriptfile2" & vbTab & Err.Description
End Sub
Public Function GetModuleTypeIndex() As Long
Select Case LCase$(ModuleType)
    Case m_MTStr_Script
        GetModuleTypeIndex = 0
    Case m_MTStr_Exe
        GetModuleTypeIndex = 1
    Case m_MTStr_Com
        GetModuleTypeIndex = 2
    Case m_MTStr_Dll
        GetModuleTypeIndex = 3
    Case m_MTStr_Sendkey
        GetModuleTypeIndex = 4
    Case Else
        GetModuleTypeIndex = 0
End Select
End Function
Public Function Get_O_FileName() As String
Get_O_FileName = TranslatePath2(o_FileName)
End Function
Public Function GetRealFileFolder() As String
GetRealFileFolder = GetFileFolder(TranslatePath2(FileName))
End Function

						