browser-vb

Posted on | In | | Visitors:

介绍

使用 VB 编写浏览器，调用 WebBrowser 控件

  • 网址导航
  • 输入网址记录
  • 多窗口
  • 首页导航
  • 页面的前进和后退
  • 窗体的自适应
  • 页面的刷新和停止

还有更多功能，结合控件属性可以实现

窗体

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Begin VB.Form Form1
   Caption         =   "=YY="
   ClientHeight    =   6390
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9795
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6390
   ScaleWidth      =   9795
   StartUpPosition =   3  '窗口缺省
   WindowState     =   2  'Maximized
   Begin SHDocVwCtl.WebBrowser WebBrowser1
      Height          =   3495
      Left            =   120
      TabIndex        =   11
      Top             =   480
      Width           =   9255
      ExtentX         =   16325
      ExtentY         =   6165
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   1
      AutoArrange     =   0   'False
      NoClientEdge    =   0   'False
      AlignLeft       =   0   'False
      NoWebView       =   0   'False
      HideFileNames   =   0   'False
      SingleClick     =   0   'False
      SingleSelection =   0   'False
      NoFolders       =   0   'False
      Transparent     =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   "http:///"
   End
   Begin VB.Frame Frame1
      Height          =   460
      Left            =   120
      TabIndex        =   0
      Top             =   0
      Width           =   9255
      Begin VB.CommandButton Command9
         Caption         =   "下"
         Height          =   300
         Left            =   2760
         TabIndex        =   12
         Top             =   120
         Width           =   300
      End
      Begin VB.CommandButton Command8
         Caption         =   "首"
         Height          =   300
         Left            =   2400
         TabIndex        =   10
         Top             =   120
         Width           =   375
      End
      Begin VB.CommandButton Command7
         Caption         =   "清"
         Height          =   300
         Left            =   8760
         TabIndex        =   9
         Top             =   120
         Width           =   375
      End
      Begin VB.CommandButton Command6
         Caption         =   "X"
         Height          =   300
         Left            =   2160
         TabIndex        =   8
         Top             =   120
         Width           =   255
      End
      Begin VB.CommandButton Command5
         Caption         =   "刷新"
         Height          =   300
         Left            =   1560
         TabIndex        =   6
         Top             =   120
         Width           =   615
      End
      Begin VB.CommandButton Command4
         Caption         =   "==>"
         Height          =   300
         Left            =   1080
         TabIndex        =   5
         Top             =   120
         Width           =   495
      End
      Begin VB.CommandButton Command3
         Caption         =   "<=="
         Height          =   300
         Left            =   600
         TabIndex        =   4
         Top             =   120
         Width           =   495
      End
      Begin VB.CommandButton Command2
         Caption         =   "New"
         Height          =   300
         Left            =   120
         TabIndex        =   3
         Top             =   120
         Width           =   495
      End
      Begin VB.ComboBox Combo1
         Height          =   300
         Left            =   3720
         TabIndex        =   2
         Top             =   120
         Width           =   4335
      End
      Begin VB.CommandButton Command1
         Caption         =   "转至"
         Height          =   300
         Left            =   8160
         TabIndex        =   1
         Top             =   120
         Width           =   615
      End
      Begin VB.Line Line1
         BorderColor     =   &H80000011&
         X1              =   3120
         X2              =   3120
         Y1              =   120
         Y2              =   420
      End
      Begin VB.Label Label1
         Alignment       =   2  'Center
         AutoSize        =   -1  'True
         Caption         =   "地址"
         Height          =   180
         Left            =   3240
         TabIndex        =   7
         Top             =   180
         Width           =   375
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
Option Explicit
Dim WithEvents Web_V1 As SHDocVwCtl.WebBrowser_V1
Attribute Web_V1.VB_VarHelpID = -1
Private Const SplitWord = vbCrLf
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Sub combo1_KeyPress(KeyAscii As Integer)
  If KeyAscii = 13 Then
  Command1_Click
  End If
End Sub


Private Sub Command1_Click()
  WebBrowser1.Navigate Combo1.Text
  If Combo1.ListIndex < 0 Then
  Combo1.AddItem Combo1.Text
  End If
End Sub


Private Sub Command2_Click()
  Dim NewForm As Form1
  Set NewForm = New Form1
  NewForm.Show
End Sub

Private Sub Command9_Click()
  If Command9.Caption = "下" Then
  Command9.Caption = "上"
  SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
  Else
  Command9.Caption = "下"
  SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 3
  End If
End Sub

Private Sub Form_Load()
  Dim s As String, ss() As String
  Dim i As Integer
  WebBrowser1.Navigate "http://www.baidu.com"
  Set Web_V1 = WebBrowser1.Object
  s = GetSetting("OldUrl", "OldUrl", "OldUrl", "")
  If s <> "" Then
  ss = Split(s, SplitWord)
  Combo1.Clear
  For i = 0 To UBound(ss)
  Combo1.AddItem ss(i)
  Next
  Else
  Combo1.AddItem "www.baidu.com"
  End If
  Combo1.ListIndex = 0
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  Dim i As Integer
  Dim s As String
  With Combo1
  If .ListCount > 0 Then
  s = .List(0)
  For i = 1 To .ListCount - 1
  s = s & SplitWord & .List(.ListIndex)
  Next
  SaveSetting "OldUrl", "OldUrl", "OldUrl", s
  End If
  End With
End Sub

Private Sub Command3_Click()
  On Error Resume Next '如果出错
  If Err.Number <> 0 Then
  Else
  WebBrowser1.GoBack
  End If
End Sub

Private Sub Command4_Click()
  On Error Resume Next '如果出错
  If Err.Number <> 0 Then
  Else
  WebBrowser1.GoForward
  End If
End Sub

Private Sub Command5_Click()
  WebBrowser1.Refresh
End Sub

Private Sub Command6_Click()
  WebBrowser1.Stop
End Sub

Private Sub Command8_Click()
  WebBrowser1.Navigate "http://www.baidu.com"
End Sub

Private Sub Command7_Click()
  With Combo1
  If .ListIndex >= 0 Then
  If .ListCount > 1 Then
  Combo1.RemoveItem .ListIndex
  .ListIndex = 0
  Else
  MsgBox "至少应保留一个网址"
  End If
  End If
  End With
End Sub

Private Sub Form_Resize()
  On Error Resume Next
  If Me.WindowState = vbMinimized Then Exit Sub '最小化时跳过
  Frame1.Width = Width - 340
  Command7.Left = Frame1.Width - Command7.Width - 100
  Command1.Left = Command7.Left - Command1.Width
  Combo1.Width = Frame1.Width - 4800
  WebBrowser1.Width = Frame1.Width
  WebBrowser1.Height = Height - 1100
End Sub


Private Sub WebBrowser1_DownloadComplete()
  Combo1.Text = WebBrowser1.LocationURL
  Caption = "=YY=" + WebBrowser1.LocationName
End Sub

Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
  Dim NewForm As Form1
  Set NewForm = New Form1
  NewForm.Show
  NewForm.WebBrowser1.RegisterAsBrowser = True '防止名称相同
  Set ppDisp = NewForm.WebBrowser1.Object
End Sub
坚持原创技术分享，您的支持将鼓励我继续创作！