自制IE浏览器

个人认为对于新手 用VB 做 myie 比较简单易上手些...下面我就说下具体的做法:

一  加载VB

二 添加 microsoft internet controls 部件  和   mircrosoft common dialog control 6.0 部件

    再添一  microsoft windows common controls 6.0 部件....

三  在窗体内添加 webbrowser  组件并取名 wb. ..添加两个 toolbar组件 分别为

    toolbar1和 toolbar2 .. 添加 menu.  在 toolbar1 上 加上  后退 前进 停止  主页 刷新 属性 全选 复制 保存

     关于 查源  等按钮 ...在toolbar2  上 添加 combobox 组件 和  一 commandbutton .....

       再在窗体上 添加 statusbar 取名 sbar1  ..  好..东西 都添好了..下面开始写 代码 ...

四 代码如下...

 

Dim  wancheng  As   Boolean
Dim  Copy1  As   String
Private   Sub  About_Click()
 a  =   MsgBox (Copy1, vbOKOnly,  " 关于myIE... " )  ' ("制作: pzhan!" & vbCrLf & "QQ:103706666", vbOKOnly, "关于myIE...")
End Sub

Private   Sub  Combo1_Click()
wb.Navigate Combo1.Text
End Sub

Private   Sub  Combo1_KeyPress(KeyAscii  As   Integer )
Dim  I  As   Long
Dim  existed  As   Boolean

If  KeyAscii  =   13   Then
If   Left (Combo1.Text,  7 )  <>   " http:// "   Then
Combo1.Text  =   " http:// "   +  Combo1.Text
End   If
wb.Navigate Combo1.Text
     For  I  =   0   To  Combo1.ListCount  -   1
     If  Combo1.List(I)  =  Combo1.Text  Then
    existed  =   True
     Exit   For
     Else
    existed  =   False
     End   If
     Next
     If   Not  existed  Then
    Combo1.AddItem (Combo1.Text)
     End   If
End   If
End Sub

Private   Sub  Command1_Click()
wb.Navigate Combo1.Text
End Sub


Private   Sub  Exit_Click()
End
End Sub

Private   Sub  Form_Load()
On   Error   Resume   Next
Copy1  =   " 制作: pzhan! "   &  vbCrLf  &   " QQ:103706666 "
wb.Navigate Combo1.Text
Form1.Move (Screen.Width  -  Form1.Width)  /   2 , (Screen.Height  -  Form1.Height)  /   2
End Sub

Private   Sub  Form_Resize()
On   Error   Resume   Next
Text1.Visible  =   False
Combo1.Width  =  Me.ScaleWidth  -  Combo1.Left  *   2   -  Command1.Width  *   9   /   7
wb.Left  =   60
wb.Width  =  Combo1.Width  +  Command1.Width  *   9   /   7
wb.Top  =  Toolbar1.Height  +  Toolbar2.Height
wb.Height  =  Me.ScaleHeight  -  Toolbar1.Height  -  Toolbar2.Height  -  SBar1.Height
Command1.Left  =  Combo1.Width  +  Command1.Width  /   5
Text1.Width  =  wb.Width
Text1.Height  =  wb.Height
Text1.Top  =  wb.Top
Text1.Left  =  wb.Left
End Sub

Private   Sub  New_Click()
Dim  newForm  As   New  Form1
newForm.Show
newForm.wb.Navigate wb.LocationURL
End Sub

Private   Sub  Open_Click()
CD1.ShowOpen
If  CD1.FileName  <>   ""   Then
wb.Navigate CD1.FileName
End   If
End Sub

Private   Sub  Text1_DblClick()
Text1.Visible  =   False
End Sub

Private   Sub  Toolbar2_ButtonClick(ByVal Button  As  MSComctlLib.Button)
On   Error   Resume   Next
Select   Case  Button.Index
Case   1
wb.GoBack
Case   2
wb.GoForward
Case   4
wb.Stop
Case   5
wb.GoHome
Case   6
wb.Refresh
Case   7
wb.ExecWB  10 ,  1   ' 查看网页属性 OLECMDID_PROPERTIES, OLECMDEXECOPT_PROMPTUSER
Case   8
wb.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_PROMPTUSER  ' 全选 17,1
Case   9
wb.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DONTPROMPTUSER  ' 复制
Case   10
wb.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_PROMPTUSER   ' 保存 4,1
Case   11
 a  =   MsgBox (Copy1, vbOKOnly,  " 关于myIE... " )  ' ("制作: pzhan!" & vbCrLf & "QQ:103706666", vbOKOnly, "关于myIE...")
Case   12
  ' wb.Navigate "view-source:" & wb.LocationURL
 html  =  getHTTPPage(wb.LocationURL)
 Text1.Text  =  vbCrLf  &   "                 双击可以关闭 "   &  vbCrLf  &  vbCrLf  &  html
 Text1.Visible  =   True
End   Select
End Sub

Private   Sub  wb_BeforeNavigate2(ByVal pDisp  As   Object , url  As  Variant, Flags  As  Variant, TargetFrameName  As  Variant, PostData  As  Variant, Headers  As  Variant, Cancel  As   Boolean )
If   Left (url,  12 )  <>   " view-source: "   Then
Combo1.Text  =  url
End   If
End Sub

Private   Sub  wb_DocumentComplete(ByVal pDisp  As   Object , url  As  Variant)
Me.Caption  =  wb.LocationName  &   "  - my IE Browser "
End Sub

Private   Sub  wb_DownloadBegin()
SBar1.Panels( 1 ).Text  =   " 正在下载 "   &  wb.LocationURL
wancheng  =   True
End Sub

Private   Sub  wb_DownloadComplete()
SBar1.Panels( 1 ).Text  =   " 下载完成-欢迎使用 "
wancheng  =   True
End Sub

Private   Sub  wb_NewWindow2(ppDisp  As   Object , Cancel  As   Boolean )
Dim  newForm  As   New  Form1
On   Error   Resume   Next
' wancheng = False
' Cancel = wancheng
newForm.Move (Screen.Width  -  newForm.Width)  /   2 , (Screen.Height  -  newForm.Height)  /   2
newForm.Show
Set  ppDisp  =  newForm.wb.Object
End Sub

' 以下是获得源代码的部分
Function  getHTTPPage(url)
Dim  Http
Set  Http  =   CreateObject ( " MSXML2.XMLHTTP " )
Http.Open  " GET " , url,  False
Http.send
If  Http.ReadyState  <>   4   Then
Exit   Function
End   If
getHTTPPage  =  BytesToBstr(Http.responseBody,  " GB2312 " )
Set  Http  =   Nothing
If  Err.Number  <>   0   Then  Err.Clear
End Function

Function  BytesToBstr(body, Cset)
Dim  objstream
Set  objstream  =   CreateObject ( " adodb.stream " )
objstream.Type  =   1
objstream.Mode  =   3
objstream.Open
objstream.Write body
objstream.Position  =   0
objstream.Type  =   2
objstream.Charset  =  Cset
BytesToBstr  =  objstream.ReadText
objstream.Close
Set  objstream  =   Nothing
End Function

 

五  后记 ..好了..一个  自制 的 IE  就 这样 诞生了..只是 界面不好看.....想好看的话..再 加 一个 imagelist 组件.

    把 toolbar1  加上 图标就会好看点了....

谢谢....BYE !!!

 附图