设计要求:
通过VB里的Shell运行浏览器且让浏览器打开指定的网页。
主窗体代码(main.frm):
VERSION 5.00 Begin VB.Form main BorderStyle = 1 'Fixed Single Caption = "OpenWebPage" ClientHeight = 3885 ClientLeft = 45 ClientTop = 375 ClientWidth = 5700 Icon = "main.frx":0000 MaxButton = 0 'False ScaleHeight = 3885 ScaleWidth = 5700 StartUpPosition = 2 '屏幕中心 Begin VB.CommandButton openUrl Caption = "Open" BeginProperty Font Name = "宋体" Size = 11.25 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Left = 1440 TabIndex = 1 Top = 3000 Width = 2775 End Begin VB.TextBox url BeginProperty Font Name = "宋体" Size = 11.25 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 2535 Left = 240 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 0 Top = 240 Width = 5175 End End Attribute VB_Name = "main" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Public sizeFocus As Byte Public appPath As String Public iniPath As String Private Sub Form_DblClick() setting.Show 1 End Sub Private Sub Form_Load() Me.Caption = Me.Caption & " Designer:Leisureeen" Me.BackColor = &HAABBFF iniPath = app.Path & "\" & app.EXEName & ".ini" sizeFocus = 4 appPath = "cmd" Dim inTmp$ On Error Resume Next If dir(iniPath) <> "" Then Open iniPath For Input As #1 Line Input #1, inTmp Close sizeFocus = VBA.CByte(VBA.Left$(inTmp, 1)) appPath = VBA.Mid$(inTmp, 2) End If End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) On Error Resume Next Open iniPath For Output As #1 Print #1, sizeFocus & appPath Close End End Sub Private Sub openUrl_Click() On Error GoTo Err Shell appPath & " " & url.Text, sizeFocus Exit Sub Err: MsgBox "ERROR", 16, "ERROR" End Sub
设置浏览器exe文件位置窗体代码(setting.frm):
VERSION 5.00 Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" Begin VB.Form setting BorderStyle = 1 'Fixed Single Caption = "Setting" ClientHeight = 3045 ClientLeft = 45 ClientTop = 375 ClientWidth = 5145 Icon = "setting.frx":0000 MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 3045 ScaleWidth = 5145 StartUpPosition = 2 '屏幕中心 Begin VB.ComboBox selSize BeginProperty Font Name = "宋体" Size = 11.25 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 ItemData = "setting.frx":030A Left = 960 List = "setting.frx":031A TabIndex = 2 Top = 2280 Width = 3255 End Begin VB.CommandButton scan Caption = "Scan" BeginProperty Font Name = "宋体" Size = 11.25 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Left = 3840 TabIndex = 1 Top = 840 Width = 1095 End Begin VB.TextBox dir BeginProperty Font Name = "宋体" Size = 11.25 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1815 Left = 240 MultiLine = -1 'True TabIndex = 0 Top = 240 Width = 3375 End Begin MSComDlg.CommonDialog dia Left = 4200 Top = 240 _ExtentX = 847 _ExtentY = 847 _Version = 393216 End End Attribute VB_Name = "setting" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Sub dir_Change() main.appPath = dir.Text End Sub Private Sub Form_Load() Me.Caption = Me.Caption & " Designer:Leisureeen" Me.BackColor = &HAABBFF selSize.Text = main.sizeFocus dir.Text = main.appPath End Sub Private Sub scan_Click() On Error Resume Next dia.DialogTitle = "Open File" dia.Filter = "exe File(*.exe)|*.exe" dia.ShowOpen If dia.FileName <> "" And dia.FileName <> dir.Text Then dir.Text = dia.FileName End Sub Private Sub selSize_Click() main.sizeFocus = VBA.CByte(VBA.Right$(selSize.Text, 1)) End Sub