用VB+API实现网页下载和数据提交功能。

        其实如果是单纯的下载网页，代码可以更简单，但俺这段代码不仅可以下载WEB页面，同时还可以向WEB页传递参数，完全可以替换XMLHTTP的GET功能，俺本来还想加上POST功能的，后来项目中不需要，所以就没加了，想了解WININET API的朋友，应该依此作一些扩展。

Option Explicit'* ************************************************************** *'* 程序名称：wininetSample.bas'* 程序功能：使用Wininet下载WEB页面'* 作者：lyserver'* 联系方式：http://blog.csdn.net/lyserver'* ************************************************************** *'WININET APIPublic Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As LongPublic Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternet As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As LongPublic Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal dwNumberOfBytesToRead As Long, lpdwNumberOfBytesRead As Long) As BooleanPublic Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInternet As Long) As BooleanPublic Const INTERNET_OPEN_TYPE_PRECONFIG As Long = &H0Public Const INTERNET_FLAG_NO_CACHE_WRITE As Long = &H4000000Public Const INTERNET_FLAG_RELOAD As Long = &H80000000Public Declare Function InternetCanonicalizeUrl Lib "wininet.dll" Alias "InternetCanonicalizeUrlA" (ByVal lpszUrl As String, ByVal lpszBuffer As Long, lpdwBufferLength As Long, dwFlags As Long) As BooleanPublic Const ICU_BROWSER_MODE = &H2000000Public Const ICU_ENCODE_SPACES_ONLY = &H4000000Public Const ICU_NO_META = &H8000000Public Const ICU_DECODE = &H10000000Public Const ICU_NO_ENCODE = &H20000000'文件APIPublic Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As LongPublic Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As LongPublic Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As LongPublic Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As LongPublic Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPublic Const FILE_BEGIN = 0Public Const CREATE_ALWAYS = 2Public Const FILE_ATTRIBUTE_NORMAL = &H80Public Const FILE_ATTRIBUTE_TEMPORARY = &H100Public Const GENERIC_READ = &H80000000Public Const GENERIC_WRITE = &H40000000'系统APIPublic Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As LongPublic Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As LongPublic Function GetResponse(ByVal Url As String, Optional ByVal strFileName As String = "") As String Dim bytesBuffer() As Byte Dim hInternet As Long, hUrl As Long, hFile As Long Dim lpdwNumberOfBytesRead As Long, dwTotalBytes As Long, dwWritten As Long Dim strPath As String, strFile As String, strBuffer As String * 255 hInternet = InternetOpen("Open URL Application", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, INTERNET_FLAG_NO_CACHE_WRITE) hUrl = InternetOpenUrl(hInternet, Url, vbNullString, 0, INTERNET_FLAG_RELOAD, 0) If hUrl <> 0 Then ReDim bytesBuffer(4095) If Len(strFileName) = 0 Then GetTempPath Len(strBuffer), strBuffer strPath = Left(strBuffer, InStr(strBuffer, Chr(0)) - 1) strFile = strPath & "/Cache" & CStr(App.ThreadID) & ".dat" Else strFile = strFileName End If hFile = CreateFile(strFile, GENERIC_READ Or GENERIC_WRITE, 0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL Or FILE_ATTRIBUTE_TEMPORARY, 0) Do Call InternetReadFile(hUrl, VarPtr(bytesBuffer(0)), 4096, lpdwNumberOfBytesRead) If lpdwNumberOfBytesRead > 0 Then WriteFile hFile, VarPtr(bytesBuffer(0)), lpdwNumberOfBytesRead, dwWritten, 0 dwTotalBytes = dwTotalBytes + lpdwNumberOfBytesRead Else Exit Do End If Loop If Len(strFileName) = 0 And dwTotalBytes > 0 Then ReDim bytesBuffer(dwTotalBytes - 1) SetFilePointer hFile, 0, ByVal 0, FILE_BEGIN ReadFile hFile, VarPtr(bytesBuffer(0)), dwTotalBytes, dwWritten, 0 GetResponse = StrConv(bytesBuffer, vbUnicode) End If CloseHandle hFile Erase bytesBuffer Else GetResponse = "Inner_Error" End If Call InternetCloseHandle(hUrl) Call InternetCloseHandle(hInternet)End Function