冰楓論壇

標題: 還在用Inet控件（MSINET.OCX）嗎？這個模組簡單多了！ [打印本頁]
作者: ai1118    時間: 2014-7-14 09:14
標題: 還在用Inet控件（MSINET.OCX）嗎？這個模組簡單多了！
Author: Inndy
Source: 別再用MSINET.OCX了，用這個模組簡單多了

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

請在VB當中新增一個模組 modDownload
  1. ' HTTP Downloading Module By Inndy
  2. Option Explicit
  3. ' For API
  4. Private Const CP_ACP = 0        ' default to ANSI code page
  5. Private Const CP_UTF8 = 65001   ' default to UTF-8 code page
  6. 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
  7. 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
  8. ' For module
  9. Public Enum Encode
  10.     ANSI = 0
  11.     BIG5 = 1
  12.     UTF8 = 2
  13. End Enum

  15. Private Function ToUTF8(ByVal sData As String) As Byte()
  16.     Dim aRetn() As Byte, nSize As Long
  17.     nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0)
  18.     ReDim aRetn(0 To nSize - 1) As Byte
  19.     WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
  20.     ToUTF8 = aRetn
  21. End Function

  23. Private Function FromUTF8(ByVal sData As String) As Byte()
  24.     Dim aRetn() As Byte, nSize As Long
  25.     nSize = MultiByteToWideChar(CP_UTF8, 0, StrPtr(sData), -1, 0, 0)
  26.     ReDim aRetn(0 To 2 * nSize - 1) As Byte
  27.     MultiByteToWideChar CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize
  28.     FromUTF8 = aRetn
  29. End Function

  31. Public Function DownloadData(ByVal url As String) As Byte()
  32.     Dim http As Object
  33.     Set http = CreateObject("MSXML2.ServerXMLHTTP")
  34.     http.Open "GET", url, False
  35.     http.setRequestHeader "Pragma", "no-cache"
  36.     http.send
  37.     DownloadData = http.responseBody
  38.     Set http = Nothing
  39. End Function

  41. Public Function DownloadString(ByVal url As String, Optional ByVal EncType As Encode = Encode.BIG5) As String
  42.     If EncType = Encode.ANSI Then
  43.         DownloadString = DownloadData(url)
  44.     ElseIf EncType = Encode.BIG5 Then
  45.         DownloadString = StrConv(DownloadData(url), vbUnicode)
  46.     Else
  47.         DownloadString = FromUTF8(DownloadData(url))
  48.     End If
  49. End Function

  51. Public Function DownloadFile(ByVal url As String, ByVal file As String) As Boolean
  52.     On Error GoTo Failed
  53.     Dim f As Integer
  54.     f = FreeFile
  55.     Open file For Binary As f
  56.     Put f, , DownloadData(url)
  57.     Close f
  58.     DownloadFile = True
  59.     Exit Function
  60. Failed:
  61.     DownloadFile = False
  62. End Function
複製代碼
[size=100%]來源: knowlet3389.blogspot.tw





歡迎光臨 冰楓論壇 (https://bingfong.com/) Powered by 冰楓