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
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。