浏览器

开发平台：
Visual Basic

mMain.bas：源码内容
							Attribute VB_Name = "mMain"
Option Explicit
'确保strconv能正确转换
Public Const LocaleID_SC As Long = 2052&    '简中
Public Const LocaleID_CurUse As Long = LocaleID_SC
'主窗口
Public gMainForm As MDIFrmMain
'自画菜单类
Public gODrawMenu As cODMenus
'Public Const pi = 3.14159265358979
'被过滤的页面
Public FiltratePages As New cFiltratePages
'关闭的页面
Public ClosedPages As New cClosedPages
Public ErrorLog As cErrorLog
'Public gMenuHdc As Long
Public AppPath As String
Public Const MainIniName As String = "lexplorer.ini"
Public ScaleBtnImg1 As StdPicture
Public ScaleBtnImg2 As StdPicture
'是否win2k以上
Public gOver2K As Boolean
Public Sub Main()
gOver2K = IsWin2k
AppPath = App.path
If Right$(AppPath, 1) <> "" Then AppPath = AppPath & ""
Set dragCursor = LoadResPicture(101, vbResCursor)
def_searchurl(1).Title = "Google"
def_searchurl(1).Url = "http://www.google.com/search?ie=GB2312&hl=zh-CN&lr=&q=" & SearchUrlKeywordFlag
def_searchurl(2).Title = "AllTheWeb"
def_searchurl(2).Url = "http://www.alltheweb.com/search?cat=web&cs=gb2312&l=szh&q=" & SearchUrlKeywordFlag
def_searchurl(3).Title = "百度"
def_searchurl(3).Url = "http://www1.baidu.com/baidu?word=" & SearchUrlKeywordFlag
def_searchurl(4).Title = "天网(web)"
def_searchurl(4).Url = "http://e.pku.edu.cn/cgi-bin/allsearch?cdtype=GB&word=" & SearchUrlKeywordFlag
def_searchurl(5).Title = "天网(ftp)"
def_searchurl(5).Url = "http://bingle.pku.edu.cn/scripts/ftp_search.exe?word=" & SearchUrlKeywordFlag
def_searchurl(6).Title = ".com"
def_searchurl(6).Url = "http://www." & SearchUrlKeywordFlag & ".com"
def_searchurl(7).Title = ".com.cn"
def_searchurl(7).Url = "http://www." & SearchUrlKeywordFlag & ".com.cn"
def_searchurl(8).Title = ".net"
def_searchurl(8).Url = "http://www." & SearchUrlKeywordFlag & ".net"
FloatFavorite = 1 'tbrPressed
WebDraging = False
Call LoadProgressIcon
Call LoadScaleImg
'Call iniTagz
'Call iniDefaultEventIndex
Call LoadUrlFilter
'Call LoadExTools
Call LoadDownloadControl
Call LoadPageRule
Call MouseHand.Load(AppPath & MainIniName)
Call LoadTbrButton
'搜索栏菜单
Call IniSearchbarMenu
Call LoadSearchEgn
Call IniMulSearchbarMenu
Call LoadMulSearchEgn
'下载
Call LoadDownManager
Set ErrorLog = New cErrorLog
ErrorLog.LogFile = App.path & "Error.Log"
Call CreateFavoriteMenuPopMenus
Call IniAllVars
'Call LoadAllScriptFile
Set gOutInfo = New cOutPortInfo
Set gODrawMenu = New cODMenus
Set gMainForm = New MDIFrmMain
Load gMainForm
ShowWindow gMainForm.hWnd, SW_MAXIMIZE
'Load gMainForm
'ShowWindow gMainForm.hwnd, SW_MAXIMIZE
'ShowWindow gMainForm.hwnd, SW_NORMAL
End Sub
'Private Sub iniTagz()
'Dim pi8 As Double
'pi8 = pi / 8
'tg1 = Tan(pi8)
'tg2 = Tan(pi8 * 3)
'tg3 = Tan(pi8 * 5)
'tg4 = Tan(pi8 * 7)
'End Sub
'Private Sub iniMouseEventPrc()
'mouse_event_prc(0).setnone   'ur
'
'mouse_event_prc(1).previoustab   'u
'
'mouse_event_prc(2).setnone  'ul
'
'mouse_event_prc(3).goback   'l
'
'mouse_event_prc(4).setnone  'dl
'
'mouse_event_prc(5).nexttab   'd
'
'mouse_event_prc(6).setnone  'dr
'
'mouse_event_prc(7).goforward   'r
'
'End Sub
'
'
'Private Sub iniMouseEventPrc2()
'mouse_event_prc(0).nexttab 'ur
'mouse_event_prc(1).setnone  'u
'mouse_event_prc(2).previoustab  'ul
'mouse_event_prc(3).goback  'l
'mouse_event_prc(4).setnone  'dl
'mouse_event_prc(5).closetab  'd
'mouse_event_prc(6).setnone 'dr
'mouse_event_prc(7).goforward  'r
'End Sub
'Private Sub iniDefaultEventIndex()
'def_mouse_event(0) = 4
'def_mouse_event(1) = 0
'def_mouse_event(2) = 3
'def_mouse_event(3) = 1
'def_mouse_event(4) = 0
'def_mouse_event(5) = 5
'def_mouse_event(6) = 0
'def_mouse_event(7) = 2
'
'def_mouse_event_leftright = 5
'End Sub
Public Function IsWin2k() As Boolean
Dim OSInfo As OSVERSIONINFO ', PId As String
Dim ret&, rtn As Boolean
'Set the structure size
OSInfo.dwOSVersionInfoSize = Len(OSInfo)
'Get the Windows version
ret& = GetVersionEx(OSInfo)
'Chack for errors
If ret <> 0 Then
    If OSInfo.dwPlatformID = VER_PLATFORM_WIN32_NT And _
            OSInfo.dwMajorVersion >= 5 Then
        rtn = True
    Else
        rtn = False
    End If
Else
    rtn = False
End If
IsWin2k = rtn
End Function
Public Function IsWinNT() As Boolean
Dim OSInfo As OSVERSIONINFO
Dim ret&
'Set the structure size
OSInfo.dwOSVersionInfoSize = Len(OSInfo)
'Get the Windows version
ret& = GetVersionEx(OSInfo)
'Chack for errors
If ret <> 0 Then
    IsWinNT = (OSInfo.dwPlatformID = VER_PLATFORM_WIN32_NT)
Else
    IsWinNT = False
End If
End Function
Public Sub LoadProgressIcon()
'Set ProgressIcon(0) = LoadImageEx(IDI_Progress_0, "icon2")
'Set ProgressIcon(1) = LoadImageEx(IDI_Progress_1, "icon2")
'Set ProgressIcon(2) = LoadImageEx(IDI_Progress_2, "icon2")
'Set ProgressIcon(3) = LoadImageEx(IDI_Progress_3, "icon2")
'Set ProgressIcon(4) = LoadImageEx(IDI_Progress_4, "icon2")
Dim tImg As cImgEx
Dim tDskDc&, i&
tDskDc = GetDC(0)
Set tImg = New cImgEx
tImg.Create 55, 16, tDskDc
tImg.CopyByBmp LoadImageEx(IDB_ProgressIcon, "gif").handle
ReleaseDC 0, tDskDc
For i = 0 To 4
    Set ProgressIcon(i) = tImg.ExtractImg2(11, 16, i)
Next i
End Sub
Public Sub LoadScaleImg()
Set ScaleBtnImg1 = LoadResPicture(501, vbResBitmap)
Set ScaleBtnImg2 = LoadResPicture(502, vbResBitmap)
End Sub
Public Sub IniAllVars()
NOExeActive = False
gFullScreenMode = False
gShowMainToolbar = True
gShowAddressbar = True
gShowSearchbar = True
gShowTabsbar = True
gShowSmallToolbar = True
gShowStatusbar = True
Call IniDragDrop
End Sub
'初始化拖拽相关
Public Sub IniDragDrop()
Dim i&
Dim tDD As cDragDropEvent
Set gSelfDrag = New cSelfDrag
For i = 0 To 3
    Set gDDEventImage(i) = New cDragDropEvent
    gDDEventImage(i).DragType = ddTypeImage
    Set gDDEventText(i) = New cDragDropEvent
    gDDEventText(i).DragType = ddTypeText
    Set gDDEventLink(i) = New cDragDropEvent
    gDDEventLink(i).DragType = ddTypeLink
Next
Set gDragDropMenu = New cPopMenu
Set gDragDropMenu2 = New cPopMenu
Set tDD = New cDragDropEvent
With gDragDropMenu2
    .Create
End With
With gDragDropMenu
    .Create
    For i = 0 To tDD.SpIndex_Replace - 1
        .Add tDD.GetEventText(i), , 100 + i
    Next i
    .Add tDD.GetEventText(tDD.SpIndex_Replace), pmsString Or pmsPopup, gDragDropMenu2.hWnd
    .Add "", pmsSeparator
    .Add tDD.GetEventText(tDD.SpIndex_ShowMenu), , 300
End With
End Sub
'Public Sub LoadAllScriptFile()
'Dim tPath$
'Dim tFileName() As String, tcnt&
'Dim i&
'tPath = AppPath & "script"
'Call FindFilesAPI(tPath, "*.htm", tcnt, tFileName)
'
'gScriptCnt = tcnt
'ReDim gScripts(0 To gScriptCnt)
'For i = 1 To tcnt
'    Call LoadScriptFile(tPath & tFileName(i), gScripts(i))
'Next i
'
'End Sub
''读取脚本文件
'Public Sub LoadScriptFile(nfile$, nScript As ScriptData)
'Dim tIni As cINIFile
'Dim tFN&, tPos&
'Dim tstr$
'Set tIni = New cINIFile
'With tIni
'    .IniFile = nfile
'    nScript.Title = .ReadKey(ScriptInfoFlag_Info, ScriptInfoFlag_Title, "无题")
'    nScript.Language = .ReadKey(ScriptInfoFlag_Info, ScriptInfoFlag_Language, "javascript")
'    nScript.FileName = nfile
'    nScript.LoadedScript = False
'    nScript.RunType = Val(.ReadKey(ScriptInfoFlag_Info, ScriptInfoFlag_RunType, "0"))
'    nScript.LoadAtExec = Val(.ReadKey(ScriptInfoFlag_Info, ScriptInfoFlag_LoadAtExec, "0"))
'End With
'
'If nScript.LoadAtExec <> 0 Then
'    tFN = FreeFile
'    Open nfile For Binary As tFN
'        tstr = StrConv(InputB(LOF(tFN), tFN), vbUnicode)
'    Close tFN
'
'    tPos = InStr(1, tstr, ScriptInfoFlag_Script)
'    If tPos > 0 Then
'        nScript.Script = Mid(tstr, tPos + Len(ScriptInfoFlag_Script))
'    End If
'    nScript.LoadedScript = True
'End If
'
'End Sub
''运行时才加载脚本文件的sub
'Public Sub LoadScriptFile2(nScript As ScriptData)
'On Error GoTo due
'Dim tFN&, tPos&
'Dim tstr$
'
'tFN = FreeFile
'Open nScript.FileName For Binary As tFN
'    tstr = StrConv(InputB(LOF(tFN), tFN), vbUnicode)
'Close tFN
'
'tPos = InStr(1, tstr, ScriptInfoFlag_Script)
'If tPos > 0 Then
'    nScript.Script = Mid(tstr, tPos + Len(ScriptInfoFlag_Script))
'End If
'nScript.LoadedScript = True
'
'Exit Sub
'
'due:
'    Reset
'    nScript.LoadedScript = False
'    nScript.Script = ""
'    Debug.Print "loadscriptfile2", Err.Description
'End Sub

						