- 最後登錄
- 2024-11-12
- 在線時間
- 723 小時
- 註冊時間
- 2007-5-12
- 閱讀權限
- 70
- 精華
- 0
- UID
- 1286899
- 帖子
- 1412
- 積分
- 17880 點
- 潛水值
- 39747 米
| 成為伊莉的版主,你將獲得更高級和無限的權限。把你感興趣的版面一步步地發展和豐盛,那種滿足感等著你來嚐嚐喔。 本帖最後由 darkjack 於 2014-2-1 08:48 PM 編輯
這是我在網路上搜尋到的 一段程式碼..我修改了一些
請自行增加 Textbox 與 Button 各一個- Sub Loading(ByRef MyWeb As WebBrowser)
- Do Until WebBrowserRead.ReadyState = WebBrowserReadyState.Complete
- Application.DoEvents()
- Loop
- End Sub
- Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
- Dim url As Uri = New Uri("https://www.google.com.tw/search?safe=off&hl=zh-TW&site=imghp&tbm=isch&source=hp&q=" & TextBox1.Text)
- Dim objWebClient As New WebClient
- Dim temp As Integer
- Dim DataLinkStr(1), DataLinkStr2(1) As String
- Dim GetStrAllLen, Str1, Str2 As Integer
- '載入網頁
- WebBrowserRead.Navigate(url)
- Loading(WebBrowserRead)
- For Each [HtmlElement] As HtmlElement In WebBrowserRead.Document.All
- If [HtmlElement].TagName = "A" And [HtmlElement].GetAttribute("href") <> Nothing Then
- DataLinkStr = Split([HtmlElement].OuterHtml, "imgurl=")
- If DataLinkStr.Length > 1 Then
- DataLinkStr2 = Split(DataLinkStr(1), "&") '分割
- RichTextBox1.Text &= DataLinkStr2(0) & vbCrLf
- Str1 = InStrRev(DataLinkStr2(0), "/") '取得 某字串位置
- Str1 = Str1 + 1 '往後推一字元
- GetStrAllLen = DataLinkStr2(0).Length '取得總字數(包涵http://)
- Str2 = GetStrAllLen - Str1
- If Strings.Right(DataLinkStr2(0), 4) = ".jpg" Or Strings.Right(DataLinkStr2(0), 4) = ".png" Then
- ListBox1.Items.Add(Strings.Mid(DataLinkStr2(0), Str1, Str2 + 1)) '取出要存的檔名
- Try
- HttpWebDownload(DataLinkStr2(0))
- Download_Count += 1
- Catch ex As WebException
- End Try
- Else
- Dim str3split() As String
- Dim str3 As String
- str3split = Split(DataLinkStr2(0), ".jpg")
- str3 = str3split(0) & ".jpg"
- temp += 1
- End If
- 'objWebClient.DownloadFileAsync(New Uri(DataLinkStr2(0)), "G:\test\1\" & Strings.Mid(DataLinkStr2(0), Str1, Str2 + 1))
- End If
- End If
- Next
- End Sub
- Private Download_Count As Integer
- Private Download_C_temp As Integer
- Private Function HttpWebDownload(ByVal InputUrl As String)
- Dim bytes_ As Integer = 0
- Dim MyResponse As HttpWebResponse
- Dim MyRequest As HttpWebRequest
- Dim RemoteStream As Stream
- Dim MyFilewStream As Stream
- Dim TimeStart As DateTime = Now
- Dim TS As TimeSpan
- MyRequest = HttpWebRequest.Create(InputUrl)
- If MyRequest IsNot Nothing Then
- 'MyResponse.GetResponseStream()
- MyRequest.Timeout = (5 * 1000)
- MyResponse = MyRequest.GetResponse
- If MyResponse IsNot Nothing Then
- '判斷網頁狀態
- If MyResponse.StatusCode = HttpStatusCode.OK Then
- RemoteStream = MyResponse.GetResponseStream
- MyFilewStream = File.Create("G:\temp\1\" & Download_Count & ".jpg") '檔名
- Dim buffer(1024) As Byte
- Dim bytesRead As Integer
- TimeStart = Now
- Do
- bytesRead = RemoteStream.Read(buffer, 0, buffer.Length)
- MyFilewStream.Write(buffer, 0, bytesRead)
- bytes_ += bytesRead
- Application.DoEvents()
- '判斷執行時間
- TS = Now.Subtract(TimeStart)
- Console.WriteLine(TS)
- If TS.TotalSeconds > 7 Then
- Exit Do
- End If
- Loop While bytesRead > 0
- End If
- End If
- End If
- If MyResponse IsNot Nothing Then MyResponse.Close()
- If RemoteStream IsNot Nothing Then RemoteStream.Close()
- If MyFilewStream IsNot Nothing Then MyFilewStream.Close()
- Return bytes_
- End Function
複製代碼 ... |
|