『vb调用winInet API接口post数据到指定的url』 'This module is called modWinInet.bas. Use the SplitAddr() function to get the address in the correct format for PostInfo.Option Explicit'Author: Sam Huggill'Email: sam@vbsquare.comPrivate Declare Function InternetOpen Lib "wininet.dll" _ Alias "InternetOpenA" _ (ByVal lpszCallerName As String, _ ByVal dwAccessType As Long, _ ByVal lpszProxyName As String, _ ByVal lpszProxyBypass As String, _ ByVal dwFlags As Long) As Long Private Declare Function InternetConnect Lib "wininet.dll" _ Alias "InternetConnectA" _ (ByVal hInternetSession As Long, _ ByVal lpszServerName As String, _ ByVal nProxyPort As Integer, _ ByVal lpszUsername As String, _ ByVal lpszPassword As String, _ ByVal dwService As Long, _ ByVal dwFlags As Long, _ ByVal dwContext As Long) As Long Private Declare Function InternetReadFile Lib "wininet.dll" _ (ByVal hFile As Long, _ ByVal sBuffer As String, _ ByVal lNumBytesToRead As Long, _ lNumberOfBytesRead As Long) As Integer Private Declare Function HttpOpenRequest Lib "wininet.dll" _ Alias "HttpOpenRequestA" _ (ByVal hInternetSession As Long, _ ByVal lpszVerb As String, _ ByVal lpszObjectName As String, _ ByVal lpszVersion As String, _ ByVal lpszReferer As String, _ ByVal lpszAcceptTypes As Long, _ ByVal dwFlags As Long, _ ByVal dwContext As Long) As Long Private Declare Function HttpSendRequest Lib "wininet.dll" _ Alias "HttpSendRequestA" _ (ByVal hHttpRequest As Long, _ ByVal sHeaders As String, _ ByVal lHeadersLength As Long, _ ByVal sOptional As String, _ ByVal lOptionalLength As Long) As Boolean Private Declare Function InternetCloseHandle Lib "wininet.dll" _ (ByVal hInternetHandle As Long) As Boolean Private Declare Function HttpAddRequestHeaders Lib "wininet.dll" _ Alias "HttpAddRequestHeadersA" _ (ByVal hHttpRequest As Long, _ ByVal sHeaders As String, _ ByVal lHeadersLength As Long, _ ByVal lModifiers As Long) As IntegerPublic Function PostInfo$(srv$, port$, script$, postdat$) Dim hInternetOpen As Long Dim hInternetConnect As Long Dim hHttpOpenRequest As Long Dim bRet As Boolean hInternetOpen = 0 hInternetConnect = 0 hHttpOpenRequest = 0 'Use registry access settings. Const INTERNET_OPEN_TYPE_PRECONFIG = 0 hInternetOpen = InternetOpen("http generic", _ INTERNET_OPEN_TYPE_PRECONFIG, _ vbNullString, _ vbNullString, _ 0) If hInternetOpen <> 0 Then 'Type of service to access. Const INTERNET_SERVICE_HTTP = 3 Const INTERNET_DEFAULT_HTTP_PORT = 80 'Change the server to your server name hInternetConnect = InternetConnect(hInternetOpen, _ srv$, _ port$, _ vbNullString, _ "HTTP/1.0", _ INTERNET_SERVICE_HTTP, _ 0, _ 0) If hInternetConnect <> 0 Then 'Brings the data across the wire even if it locally cached. Const INTERNET_FLAG_RELOAD = &H80000000 hHttpOpenRequest = HttpOpenRequest(hInternetConnect, _ "POST", _ script$, _ "HTTP/1.0", _ vbNullString, _ 0, _ INTERNET_FLAG_RELOAD, _ 0) If hHttpOpenRequest <> 0 Then Dim sHeader As String Const HTTP_ADDREQ_FLAG_ADD = &H20000000 Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000 sHeader = "Content-Type: application/x-www-form-urlencoded" _ & vbCrLf bRet = HttpAddRequestHeaders(hHttpOpenRequest, _ sHeader, Len(sHeader), HTTP_ADDREQ_FLAG_REPLACE _ Or HTTP_ADDREQ_FLAG_ADD) Dim lpszPostData As String Dim lPostDataLen As Long lpszPostData = postdat$ lPostDataLen = Len(lpszPostData) bRet = HttpSendRequest(hHttpOpenRequest, _ vbNullString, _ 0, _ lpszPostData, _ lPostDataLen) Dim bDoLoop As Boolean Dim sReadBuffer As String * 2048 Dim lNumberOfBytesRead As Long Dim sBuffer As String bDoLoop = True While bDoLoop sReadBuffer = vbNullString bDoLoop = InternetReadFile(hHttpOpenRequest, _ sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead) sBuffer = sBuffer & _ Left(sReadBuffer, lNumberOfBytesRead) If Not CBool(lNumberOfBytesRead) Then bDoLoop = False Wend PostInfo = sBuffer bRet = InternetCloseHandle(hHttpOpenRequest) End If bRet = InternetCloseHandle(hInternetConnect) End If bRet = InternetCloseHandle(hInternetOpen) End IfEnd FunctionPublic Sub SplitAddr(ByVal addr$, srv$, script$)'Inputs: The full url including http://' Two variables that will be changed''Returns: Splits the addr$ var into the server name' and the script path Dim i% i = InStr(addr$, "/") srv$ = Mid(addr$, i + 2, Len(addr$) - (i + 1)) i = InStr(srv$, "/") script$ = Mid(srv$, i, Len(srv$) + 1 - i) srv$ = Left$(srv$, i - 1)End Sub
