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

[vb] view plaincopy

1. Option Explicit  
2. '* ************************************************************** *  
3. '*    程序名称：wininetSample.bas  
4. '*    程序功能：使用Wininet下载WEB页面  
5. '*    作者：lyserver  
6. '*    联系方式：http://blog.csdn.net/lyserver  
7. '* ************************************************************** *  
8.   
9. 'WININET API  
10. Public 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 Long  
11. Public 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 Long  
12. Public Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal dwNumberOfBytesToRead As Long, lpdwNumberOfBytesRead As Long) As Boolean  
13. Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInternet As Long) As Boolean  
14. Public Const INTERNET_OPEN_TYPE_PRECONFIG As Long = &H0  
15. Public Const INTERNET_FLAG_NO_CACHE_WRITE As Long = &H4000000  
16. Public Const INTERNET_FLAG_RELOAD As Long = &H80000000  
17. Public Declare Function InternetCanonicalizeUrl Lib "wininet.dll" Alias "InternetCanonicalizeUrlA" (ByVal lpszUrl As String, ByVal lpszBuffer As Long, lpdwBufferLength As Long, dwFlags As Long) As Boolean  
18. Public Const ICU_BROWSER_MODE = &H2000000  
19. Public Const ICU_ENCODE_SPACES_ONLY = &H4000000  
20. Public Const ICU_NO_META = &H8000000  
21. Public Const ICU_DECODE = &H10000000  
22. Public Const ICU_NO_ENCODE = &H20000000  
23.   
24. '文件API  
25. Public 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 Long  
26. Public 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 Long  
27. Public 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 Long  
28. Public Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long  
29. Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long  
30. Public Const FILE_BEGIN = 0  
31. Public Const CREATE_ALWAYS = 2  
32. Public Const FILE_ATTRIBUTE_NORMAL = &H80  
33. Public Const FILE_ATTRIBUTE_TEMPORARY = &H100  
34. Public Const GENERIC_READ = &H80000000  
35. Public Const GENERIC_WRITE = &H40000000  
36.   
37. '系统API  
38. Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long  
39. Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long  
40.   
41.   
42. Public Function GetResponse(ByVal Url As String, Optional ByVal strFileName As String = "") As String  
43.     Dim bytesBuffer() As Byte  
44.     Dim hInternet As Long, hUrl As Long, hFile As Long  
45.     Dim lpdwNumberOfBytesRead As Long, dwTotalBytes As Long, dwWritten As Long  
46.     Dim strPath As String, strFile As String, strBuffer As String * 255  
47.       
48.     hInternet = InternetOpen("Open URL Application", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, INTERNET_FLAG_NO_CACHE_WRITE)  
49.     hUrl = InternetOpenUrl(hInternet, Url, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)  
50.     If hUrl <> 0 Then  
51.         ReDim bytesBuffer(4095)  
52.         If Len(strFileName) = 0 Then  
53.             GetTempPath Len(strBuffer), strBuffer  
54.             strPath = Left(strBuffer, InStr(strBuffer, Chr(0)) - 1)  
55.             strFile = strPath & "/Cache" & CStr(App.ThreadID) & ".dat"  
56.         Else  
57.             strFile = strFileName  
58.         End If  
59.       
60.         hFile = CreateFile(strFile, GENERIC_READ Or GENERIC_WRITE, 0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL Or FILE_ATTRIBUTE_TEMPORARY, 0)  
61.         Do  
62.             Call InternetReadFile(hUrl, VarPtr(bytesBuffer(0)), 4096, lpdwNumberOfBytesRead)  
63.             If lpdwNumberOfBytesRead > 0 Then  
64.                 WriteFile hFile, VarPtr(bytesBuffer(0)), lpdwNumberOfBytesRead, dwWritten, 0  
65.                 dwTotalBytes = dwTotalBytes + lpdwNumberOfBytesRead  
66.             Else  
67.                 Exit Do  
68.             End If  
69.         Loop  
70.       
71.         If Len(strFileName) = 0 And dwTotalBytes > 0 Then  
72.             ReDim bytesBuffer(dwTotalBytes - 1)  
73.             SetFilePointer hFile, 0, ByVal 0, FILE_BEGIN  
74.             ReadFile hFile, VarPtr(bytesBuffer(0)), dwTotalBytes, dwWritten, 0  
75.             GetResponse = StrConv(bytesBuffer, vbUnicode)  
76.         End If  
77.       
78.         CloseHandle hFile  
79.         Erase bytesBuffer  
80.     Else  
81.         GetResponse = "Inner_Error"  
82.     End If  
83.     Call InternetCloseHandle(hUrl)  
84.     Call InternetCloseHandle(hInternet)  
85. End Function