還在用Inet控件(MSINET.OCX)嗎?這個模組簡單多了!

Author: Inndy
Source: 別再用MSINET.OCX了,用這個模組簡單多了

這個模組能做甚麼?他能取代VB控件Inet,更簡單更活用,也不必再調用MSINET.OCX就能用VB讀取網路上的文字資料!

請在VB當中新增一個模組 modDownload

' HTTP Downloading Module By Inndy
Option Explicit
' For API
Private Const CP_ACP = 0        ' default to ANSI code page
Private Const CP_UTF8 = 65001   ' default to UTF-8 code page
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
' For module
Public Enum Encode
    ANSI = 0
    BIG5 = 1
    UTF8 = 2
End Enum

Private Function ToUTF8(ByVal sData As String) As Byte()
    Dim aRetn() As Byte, nSize As Long
    nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0)
    ReDim aRetn(0 To nSize - 1) As Byte
    WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
    ToUTF8 = aRetn
End Function

Private Function FromUTF8(ByVal sData As String) As Byte()
    Dim aRetn() As Byte, nSize As Long
    nSize = MultiByteToWideChar(CP_UTF8, 0, StrPtr(sData), -1, 0, 0)
    ReDim aRetn(0 To 2 * nSize - 1) As Byte
    MultiByteToWideChar CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize
    FromUTF8 = aRetn
End Function

Public Function DownloadData(ByVal url As String) As Byte()
    Dim http As Object
    Set http = CreateObject("MSXML2.ServerXMLHTTP")
    http.Open "GET", url, False
    http.setRequestHeader "Pragma", "no-cache"
    http.send
    DownloadData = http.responseBody
    Set http = Nothing
End Function

Public Function DownloadString(ByVal url As String, Optional ByVal EncType As Encode = Encode.BIG5) As String
    If EncType = Encode.ANSI Then
        DownloadString = DownloadData(url)
    ElseIf EncType = Encode.BIG5 Then
        DownloadString = StrConv(DownloadData(url), vbUnicode)
    Else
        DownloadString = FromUTF8(DownloadData(url))
    End If
End Function

Public Function DownloadFile(ByVal url As String, ByVal file As String) As Boolean
    On Error GoTo Failed
    Dim f As Integer
    f = FreeFile
    Open file For Binary As f
    Put f, , DownloadData(url)
    Close f
    DownloadFile = True
    Exit Function
Failed:
    DownloadFile = False
End Function

調用範例:
1. 下載音樂檔案 "Let it out.mp3"
If DownloadFile("http://sites.google.com/site/mu5iccite/attach/Let%20it%20out.mp3?attredirects=0&d=1", "C:\Let it out.mp3") Then MsgBox "下載完成!", vbInformation, "Tips"
2. 讀取網路TXT文字
MsgBox DownloadString("https://sites.google.com/site/kaoyouyuzz/kao-you-yu/Reggae.txt")
3. 讀取網頁HTML
MsgBox DownloadString("https://www.google.com.tw/", UTF8)
本範例非原作者編寫,如有錯誤敬請告知。

作者調用範例下載:
HTTP Download模組使用範例

留言

本月最夯

偷用電腦,怎知?事件檢視器全記錄!(開機時間、啟動項時間...)

[Chrome] 不用任何擴充功能,Chrome 內建開發者工具讓您輕鬆下載任何影片!