dim xh set xh=CreateObject("Microsoft.XMLHTTP") xh.Open("POST","http://host/form.asp",false) xh.AddRequestHeader("Content-Type","www-url-encoded") xh.Send("aa=33&bb=44") MsgBox xh.responseText
『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: [email protected] 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 Integer Public Function PostInfo$(srv$, port$, script$, postdat$) Dim hInternetOpen As Long Dim hInternetConnect As Long Dim hHttpOpenRequest As Long Dim bRet As Boolean
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
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 If End 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
set xh=CreateObject("Microsoft.XMLHTTP")
xh.Open("POST","http://host/form.asp",false)
xh.AddRequestHeader("Content-Type","www-url-encoded")
xh.Send("aa=33&bb=44")
MsgBox xh.responseText
'Email: [email protected] 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 Integer
Public 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 If
End 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