九美子护肤品效果好吗:使用WININET的函数写下载功能 -- VB

使用WININET的函数写下载功能 -- VB

现在杀毒软件对URLDOWNTOFILEA这个API查的是越来越严了，无论我怎么加密，动态调用等等就是被查出来。哎，我还不会很底层的东西，老老实实使用wininet的API写了一个下载的FUNCTION。感觉倒是很爽！

简单列一下遇到的主要问题：

1、InternetReadFile这个函数原型是

Declare Function InternetReadFile Lib "wininet.dll" (ByRef hFile As Long,ByVal sBuffer As String, ByVal dwNumberOfBytesToRead As Long, ByRef lpdwNumberOfBytesRead As Long)as integer

由于第二个参数是string型，在获取二进制文件的时候肯定会出问题的。很无奈，改了改去试了N久，改成Byte型的数组，终于可以了

Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer

2、二进制文件确实可以下载了，但是如果想下载一个文件还要知道这个文件的大小（InternetReadFile函数的第三个参数就是获取的长度），后来想了半天都很麻烦，后来看到了InternetReadFile函数的最后一个参数突然想到了方法。最后一个参数lNumberOfBytesRead就是读取数据的长度。如果文件只有30字节，使用

    InternetReadFile hFile, sBuffer(0), 1000, Ret

读取这个文件，ret会返回30。这就好办了，使用循环来读取，如果ret返回了0说明文件到头了。

    Do
    InternetReadFile hFile, sBuffer(0), 1000, Ret
    If Ret <> 0 Then
         '说明读取到了文件内容
       Else
         '说明文件读取完了
         Exit Do
    End If
    Loop

3、读的最后一次，应该不会把sBuffer(1000)这个数组填满（除非文件的大小刚好是1000的整数倍），那么最后一次put写文件的时候就会写入多余的00，这个情况很简单，使用redim来重新定义一下数组的长度就OK了。

         If Ret < 1000 Then ReDim Preserve sBuffer(Ret - 1)

使用Preserve这个参数，保留原有数据改变数组长度。

废话说了这么多，贴出来代码：

Private Const scUserAgent = "BF"
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const INTERNET_FLAG_RELOAD = &H80000000

Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Function DownFile(ByVal strURL As String, ByVal strPath As String) As Boolean
On Error GoTo ERR:
    Dim hOpen As Long, hFile As Long, sBuffer() As Byte, Ret As Long

    hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
    If hOpen = 0 Then DownFile = False: Exit Function
    hFile = InternetOpenUrl(hOpen, strURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
    If hFile = 0 Then DownFile = False: Exit Function
   
    If Dir(strPath) <> "" Then
        If (MsgBox("目标文件存在，是否覆盖？", vbYesNo)) = vbYes Then
                 Kill strPath
             Else
                 DownFile = False
                 Exit Function
        End If
    End If
    Open strPath For Binary As #1
    ReDim sBuffer(999)
    Do
    InternetReadFile hFile, sBuffer(0), 1000, Ret
    If Ret <> 0 Then
         If Ret < 1000 Then ReDim Preserve sBuffer(Ret - 1)
         Put #1, , sBuffer
       Else
         Exit Do
    End If
    DoEvents
    Loop
   
    Close #1
   
    InternetCloseHandle hFile
    InternetCloseHandle hOpen
   
    DownFile = True
    Exit Function
   
ERR:
    DownFile = False
End Function

调用就是DownFIle 文件网址，本地路径

比如 DownFile http://www.mm.com/mm.exe,"c:\a.exe"

成功返回True，失败返回False

大家玩好！~