<script type="text/javascript">
</script> <script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>
'This module is called mod winInet.bas. Use the SplitAddr() function to get the address in the correct format for postInfo.
Option Explicit
'Author: Sam Huggill
'Email: sam@ vbsquare.com
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 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 lpsz postData As String
Dim l postDataLen As Long
lpsz postData = postdat$
l postDataLen = Len(lpsz postData)
bRet = HttpSendRequest(hHttpOpenRequest, _
vbNullString, _
0, _
lpsz postData, _
l postDataLen)
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 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 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
<script type="text/javascript"> </script> <script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>
<script type="text/javascript">
</script><script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>
『
vb调用
winInet
API
接口
post
数据到指定的
url』
'This module is called mod winInet.bas. Use the SplitAddr() function to get the address in the correct format for postInfo.
Option Explicit
'Author: Sam Huggill
'Email: sam@ vbsquare.com
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 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 lpsz postData As String
Dim l postDataLen As Long
lpsz postData = postdat$
l postDataLen = Len(lpsz postData)
bRet = HttpSendRequest(hHttpOpenRequest, _
vbNullString, _
0, _
lpsz postData, _
l postDataLen)
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 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 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
<script type="text/javascript"> </script> <script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>
<script type="text/javascript">
</script><script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>