『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]
Private 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 lMod
iers 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
tings.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
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 bDoLoopAs Boolean
Dim sReadBufferAs String * 2048
Dim lNumberOfBytesReadAs Long
Dim sBufferAs 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 Function
Public Sub SplitAddr(ByVal addr$, srv$, script$)
´Inputs: The full url including http://
´ Two variables that will be changed
´
´Returns: Splits the addr$ var
o 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
最新评论