前端之家收集整理的这篇文章主要介绍了
VB网络操作学习笔记，
前端之家小编觉得挺不错的，现在分享给大家，也给大家做个参考。
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3225
ClientLeft = 60
ClientTop = 345
ClientWidth = 8820
LinkTopic = "Form1"
ScaleHeight = 3225
ScaleWidth = 8820
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command3
Caption = "Command3"
Height = 495
Left = 3720
TabIndex = 7
Top = 1440
Width = 1215
End
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 735
Left = 0
TabIndex = 6
Top = 2160
Width = 8775
_ExtentX = 15478
_ExtentY = 1296
_Version = 393216
Appearance = 1
End
Begin VB.CommandButton Command2
Caption = "Command2"
Height = 495
Left = 6360
TabIndex = 5
Top = 1440
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 1320
TabIndex = 4
Top = 1440
Width = 1215
End
Begin VB.TextBox Text2
Height = 495
Left = 1440
TabIndex = 3
Text = "\\10.33.52.240\AQSystem\GUJIEJING\"
Top = 600
Width = 7095
End
Begin VB.TextBox Text1
Height = 495
Left = 1440
TabIndex = 2
Text = "C:\Documents and Settings\jing\My Documents\VB6\进销存程序\JXC12120501.gif"
Top = 0
Width = 7095
End
Begin VB.Label Label2
Caption = "Label2"
Height = 495
Left = 0
TabIndex = 1
Top = 600
Width = 1215
End
Begin VB.Label Label1
Caption = "Label1"
Height = 495
Left = 0
TabIndex = 0
Top = 0
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim workarea(40) As String
Private Sub Command1_Click()
'只能复制文件夹
On Error GoTo Err_Command1_Click
a = MsgBox("是否确定复制该文件",4,"提示信息")
If a = vbYes Then
Me.ProgressBar1.Visible = True
Me.ProgressBar1.Max = UBound(workarea)
Me.ProgressBar1.Value = Me.ProgressBar1.Min
For Counter = LBound(workarea) To UBound(workarea)
workarea(Counter) = "initial value" & Counter
Me.ProgressBar1.Value = Counter
Set p_ofso = CreateObject("scripting.filesystemobject")
p_ofso.CopyFolder Trim(Me.Text1.Text),Trim(Me.Text2.Text),True
Next Counter
Me.ProgressBar1.Value = Me.ProgressBar1.Min
MsgBox "备份完成"
End If
Exit Sub
Err_Command1_Click:
MsgBox Err.Description
End Sub
Private Sub Command2_Click()
'
End
End Sub
Private Sub Command3_Click()
'只能复制文件
FileCopy Me.Text1.Text,Me.Text2.Text
End Sub
VERSION 5.00
Begin VB.Form Form6
Caption = "Form6"
ClientHeight = 930
ClientLeft = 60
ClientTop = 345
ClientWidth = 7740
LinkTopic = "Form6"
ScaleHeight = 930
ScaleWidth = 7740
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command4
Caption = "我的微薄"
Height = 495
Left = 6240
TabIndex = 3
Top = 240
Width = 1215
End
Begin VB.CommandButton Command3
Caption = "物流支持"
Height = 495
Left = 4080
TabIndex = 2
Top = 240
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "百度"
Height = 495
Left = 2040
TabIndex = 1
Top = 240
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "淘宝"
Height = 495
Left = 240
TabIndex = 0
Top = 240
Width = 1215
End
End
Attribute VB_Name = "Form6"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long,ByVal lpOperation As String,ByVal lpFile As String,ByVal lpParameters As String,ByVal lpDirectory As String,ByVal nShowCmd As Long) As Long
Dim mystr As String
Private Sub Command1_Click()
'淘宝
mystr = "http://www.taobao.com"
Call ShellExecute(Me.hwnd,"open",mystr,vbNullString,sw_shownormal)
End Sub
Private Sub Command2_Click()
'百度
mystr = "http://www.baidu.com"
Call ShellExecute(Me.hwnd,sw_shownormal)
End Sub
Private Sub Command3_Click()
'物流支持
mystr = "http://10.33.52.173"
Call ShellExecute(Me.hwnd,sw_shownormal)
End Sub
Private Sub Command4_Click()
'我的微薄
mystr = "http://blog.csdn.net/laotou99"
Call ShellExecute(Me.hwnd,sw_shownormal)
End Sub
VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Begin VB.Form Form5
Caption = "Form5"
ClientHeight = 8205
ClientLeft = 60
ClientTop = 345
ClientWidth = 10890
LinkTopic = "Form5"
ScaleHeight = 8205
ScaleWidth = 10890
StartUpPosition = 2 '屏幕中心
Begin SHDocVwCtl.WebBrowser WebBrowser1
Height = 4575
Left = 0
TabIndex = 3
Top = 2880
Width = 10815
ExtentX = 19076
ExtentY = 8070
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 = ""
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 9600
TabIndex = 2
Top = 7560
Width = 1215
End
Begin VB.TextBox Text1
Height = 495
Left = 600
TabIndex = 1
Top = 7560
Width = 8775
End
Begin VB.ListBox List1
Height = 2580
Left = 0
TabIndex = 0
Top = 0
Width = 10815
End
Begin InetCtlsObjects.Inet Inet1
Left = 0
Top = 7560
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
End
Begin VB.Label Label1
Caption = "Label1"
Height = 375
Left = 0
TabIndex = 4
Top = 2640
Width = 10815
End
End
Attribute VB_Name = "Form5"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long,ByVal wMsg As Long,ByVal wParam As Long,lParam As Any) As Long
Const LB_SETHORIZONTALEXTENT = &H194
Private Sub Command1_Click()
'分析网页中的超级链接
Dim TagName As String,str As String
Dim count As Integer,i As Integer,k As Integer
Dim cols
Set cols = Me.WebBrowser1.Document.All
count = cols.length
k = 0
While i < count
TagName = cols.Item(i).TagName
If TagName = "A" Or TagName = "IMG" Then
str = k & " " & TagName & "..." & cols.Item(i).href
Me.List1.AddItem (str)
SendMessage List1.hwnd,LB_SETHORIZONTALEXTENT,Me.TextWidth(str),ByVal 0&
k = k + 1
End If
i = i + 1
Wend
Me.Label1.Caption = "all in html" & k & "个"
End Sub
Private Sub Form_Load()
'
Me.Text1.Text = "http://product.pconline.com.cn/cpu/intel/"
Me.WebBrowser1.Navigate Me.Text1.Text
End Sub
VERSION 5.00
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Begin VB.Form Form4
Caption = "Form4"
ClientHeight = 6240
ClientLeft = 60
ClientTop = 345
ClientWidth = 9390
LinkTopic = "Form4"
ScaleHeight = 6240
ScaleWidth = 9390
StartUpPosition = 3 '窗口缺省
Begin VB.ListBox List1
Height = 5100
Left = 0
TabIndex = 2
Top = 480
Width = 8295
End
Begin InetCtlsObjects.Inet Inet1
Left = 8640
Top = 600
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 8280
TabIndex = 1
Top = 0
Width = 1215
End
Begin VB.TextBox Text1
Height = 495
Left = 0
TabIndex = 0
Top = 0
Width = 8295
End
End
Attribute VB_Name = "Form4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ending As Boolean,comd As String
Private Sub Command1_Click()
'
End Sub
Private Sub Inet1_StateChanged(ByVal State As Integer)
'
Dim Directory As String
Dim Position As Long,Newposition As Long
If State = icResponseCompleted Then
Select Case comd
Case "dir"
Position = -1
Directory = Me.Inet1.GetChunk(0)
Me.List1.AddItem ("..")
Do
DoEvents
Newposition = InStr(Position + 2,Directory,vbCr + vbLf,1)
If Newposition = Len(Directory) - 1 Then Exit Sub
If Newposition = 0 Then GoTo loop1
Me.List1.AddItem Mid(Directory,Position + 2,Newposition - (Position + 2))
Position = Newposition
loop1:
Loop
End Select
ending = True
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
'
If KeyAscii = vbKeyReturn Then
comd = "dir"
Me.Inet1.Execute Me.Text1.Text,"dir"
End If
End Sub
VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Begin VB.Form Form3
Caption = "Form3"
ClientHeight = 8070
ClientLeft = 60
ClientTop = 345
ClientWidth = 11955
LinkTopic = "Form3"
ScaleHeight = 8070
ScaleWidth = 11955
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command3
Caption = "Command3"
Height = 495
Left = 4920
TabIndex = 5
Top = 7560
Width = 1215
End
Begin InetCtlsObjects.Inet Inet1
Left = 0
Top = 7560
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
End
Begin VB.TextBox Text2
Height = 7095
Left = 120
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 4
Top = 480
Visible = 0 'False
Width = 11775
End
Begin VB.CommandButton Command2
Caption = "Command2"
Height = 495
Left = 2520
TabIndex = 3
Top = 7560
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 10800
TabIndex = 2
Top = 0
Width = 1215
End
Begin VB.TextBox Text1
Height = 495
Left = 120
TabIndex = 1
Top = 0
Width = 10695
End
Begin SHDocVwCtl.WebBrowser WebBrowser1
Height = 7095
Left = 120
TabIndex = 0
Top = 480
Width = 11775
ExtentX = 20770
ExtentY = 12515
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 = ""
End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
'
Me.WebBrowser1.Visible = True
Me.WebBrowser1.Navigate Me.Text1.Text
End Sub
Private Sub Command2_Click()
'
Dim l1 As Long
Me.Text2.Visible = True
Me.Inet1.Protocol = icHTTP
Me.Text2.Text = Me.Inet1.OpenURL(Me.Text1.Text)
Me.WebBrowser1.Visible = False
Open App.Path & "\myfile.txt" For Output As #1
For l1 = 1 To Len(Me.Text2.Text)
Print #1,Mid(Me.Text2.Text,l1,1);
Next l1
Close #1
MsgBox "OK"
End Sub
Private Sub Command3_Click()
'读取网页中所有文字部分
Debug.Print Me.WebBrowser1.Document.body.innertext
Debug.Print Chr(13)
Debug.Print Left(Me.WebBrowser1.Document.body.innertext,InStr(1,Me.WebBrowser1.Document.body.innertext,Chr(13)))
Dim l1 As Long
Me.Text2.Visible = True
Me.Inet1.Protocol = icHTTP
Me.Text2.Text = Left(Me.WebBrowser1.Document.body.innertext,Chr(13)))
Me.WebBrowser1.Visible = False
Open App.Path & "\myfile2.txt" For Output As #1
For l1 = 1 To Len(Me.Text2.Text)
Print #1,1);
Next l1
Close #1
MsgBox "OK"
End Sub
VERSION 5.00
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Begin VB.Form Form2
Caption = "Form2"
ClientHeight = 8115
ClientLeft = 60
ClientTop = 345
ClientWidth = 10590
LinkTopic = "Form2"
ScaleHeight = 8115
ScaleWidth = 10590
StartUpPosition = 2 '屏幕中心
Begin InetCtlsObjects.Inet Inet1
Left = 0
Top = 7560
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 4680
TabIndex = 2
Top = 7560
Width = 1215
End
Begin VB.TextBox Text2
Height = 6975
Left = 0
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 1
Top = 600
Width = 10575
End
Begin VB.TextBox Text1
Height = 495
Left = 0
TabIndex = 0
Top = 0
Width = 10575
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
'
Me.Text2.Text = Me.Inet1.OpenURL(Me.Text1.Text)
End Sub
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 1860
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 1860
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command6
Caption = "myweb"
Height = 495
Left = 3240
TabIndex = 6
Top = 1320
Width = 1215
End
Begin VB.CommandButton Command5
Caption = "href"
Height = 495
Left = 1680
TabIndex = 5
Top = 1320
Width = 1215
End
Begin VB.CommandButton Command4
Caption = "queryweb"
Height = 495
Left = 120
TabIndex = 4
Top = 1320
Width = 1215
End
Begin VB.CommandButton Command3
Caption = "GETIP"
Height = 495
Left = 120
TabIndex = 3
Top = 720
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "Form2"
Height = 495
Left = 3240
TabIndex = 2
Top = 720
Width = 1215
End
Begin VB.TextBox Text1
Height = 495
Left = 0
TabIndex = 1
Top = 0
Width = 4695
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 1680
TabIndex = 0
Top = 720
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As String) As Long
Private Sub Command1_Click()
'
Dim sDownload As String
sDownload = StrConv(Me.Text1.Text,vbUnicode)
Call DoFileDownload(sDownload)
End Sub
Private Sub Command2_Click()
'
Form2.Show 1
End Sub
Private Sub Command3_Click()
'
Form3.Show 1
End Sub
Private Sub Command4_Click()
'
Form4.Show 1
End Sub
Private Sub Command5_Click()
'
Form5.Show 1
End Sub
Private Sub Command6_Click()
'
Form6.Show 1
End Sub
原文链接：https://www.f2er.com/vb/259323.html
