vb呼叫winInet API介面post資料到指定的url (轉)

vb呼叫winInet API介面post資料到指定的url (轉)[@more@]『vbwin 介面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
'E: sam@vbsquare.com

Private Declare Function InternetOpen Lib "wininet.dll" _
 Alias "InternetOpenA" _
 (ByVal lpszCallerName As String, _
 ByVal dwAccessType As Long, _
 ByVal lpszName 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 lpszPass 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 lpszName 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 bDoL As Boolean
 Dim sReauffer 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