使用来自 msdnwininet 的帮助。发送文件和参数。
Private Sub btSend_Click()
Dim iRetVal As Integer
Dim sbuffer As String * 1024
Dim lBufferLen As Long
Dim sStatus As String
Dim postVariable As String
Dim LengthOFPostVariable As Long
Dim SecFlag As Long
Dim dwSecFlag As Long
Dim dwPort As Long
Screen.MousePointer = vbHourglass
btSend.Enabled = True
lBufferLen = Len(sbuffer)
If CBool(hInternetSession) Then
SetStatus "InternetQueryOption"
InternetQueryOption hInternetSession, INTERNET_OPTION_VERSION, vDllVersion, Len(vDllVersion)
lblMajor = vDllVersion.lMajorVersion
lblMinor = vDllVersion.lMinorVersion
SetStatus "InternetConnect"
If checkSecure.Value = 1 Then
Debug.Print "Establishing secure connection" & " "
dwPort = INTERNET_DEFAULT_HTTPS_PORT
Debug.Print "Setting security flags" & " "
SecFlag = INTERNET_FLAG_SECURE Or INTERNET_FLAG_IGNORE_CERT_CN_INVALID Or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
Else
dwPort = INTERNET_DEFAULT_HTTP_PORT
SecFlag = 0
End If
hInternetConnect = InternetConnect(hInternetSession, CheckUrl, dwPort, txtUsername.Text, txtPassword.Text, INTERNET_SERVICE_HTTP, 0, 0)
If hInternetConnect > 0 Then
SetStatus "HttpOpenRequest"
If optGet.Value = True Then
postVariable = vbNullString
LengthOFPostVariable = 0
hHttpOpenRequest = HttpOpenRequest(hInternetConnect, "GET", GetUrlObject, "HTTP/1.0", vbNullString, 0, INTERNET_FLAG_RELOAD Or INTERNET_FLAG_KEEP_CONNECTION Or SecFlag, 0)
Else
hHttpOpenRequest = HttpOpenRequest(hInternetConnect, "POST", GetUrlObject, "HTTP/1.0", vbNullString, 0, INTERNET_FLAG_RELOAD Or SecFlag, 0)
End If
If CBool(hHttpOpenRequest) Then
SetStatus "HttpSendRequest"
Dim strPostData As String, strBoundary As String, strHttp As String, strbody As String
strBoundary = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
Dim sHeader As String
sHeader = "Content-Type: multipart/form-data, boundary=" & strBoundary & vbCrLf
iRetVal = HttpAddRequestHeaders(hHttpOpenRequest, sHeader, Len(sHeader), HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD)
Dim dwTimeOut As Long, lngLength As Long
strPostData = GetFileContents("c:\1.pdf")
strbody = "--" & strBoundary & vbCrLf
strbody = strbody & "Content-Disposition: form-data; name=""id""" & vbCrLf & vbCrLf & "1" & vbCrLf
strbody = strbody & "--" & strBoundary & vbCrLf
strbody = strbody & "Content-Disposition: form-data; name=""name""" & vbCrLf & vbCrLf & "ABCD" & vbCrLf
strbody = strbody & "--" & strBoundary & vbCrLf
strbody = strbody & "Content-Disposition: form-data; name=""age""" & vbCrLf & vbCrLf & "26" & vbCrLf
strbody = strbody & "--" & strBoundary & vbCrLf
strbody = strbody & "Content-Disposition: form-data; name=""height""" & vbCrLf & vbCrLf & "155" & vbCrLf
strbody = strbody & "--" & strBoundary & vbCrLf
strbody = strbody & "Content-Disposition: form-data; name=""weight""" & vbCrLf & vbCrLf & "56" & vbCrLf
strbody = strbody & "--" & strBoundary & vbCrLf
strbody = strbody & "Content-Disposition: form-data; name=""" & "file" & """; filename=""" & "1.pdf" & """" & vbCrLf
strbody = strbody & "Content-Type: application/octet-stream" & vbCrLf
strbody = strbody & vbCrLf & strPostData
strbody = strbody & vbCrLf & "--" & strBoundary & vbCrLf & "--"
lngLength = Len(strbody)
dwTimeOut = 420000 ' time out is set to 7 minutes
iRetVal = InternetSetOption(hHttpOpenRequest, INTERNET_OPTION_CONNECT_TIMEOUT, dwTimeOut, 4)
iRetVal = InternetSetOption(hHttpOpenRequest, INTERNET_OPTION_RECEIVE_TIMEOUT, dwTimeOut, 4)
iRetVal = InternetSetOption(hHttpOpenRequest, INTERNET_OPTION_SEND_TIMEOUT, dwTimeOut, 4)
Resend:
iRetVal = HttpSendRequest(hHttpOpenRequest, vbNullString, 0, strbody, lngLength)
If (iRetVal <> 1) And (Err.LastDllError = 12045) Then
MsgBox "Invalid CA"
'Certificate Authority is invalid.
Debug.Print "Invalid Cert Auth, resending" & " "
dwSecFlag = SECURITY_FLAG_IGNORE_UNKNOWN_CA
iRetVal = InternetSetOption(hHttpOpenRequest, INTERNET_OPTION_SECURITY_FLAGS, dwSecFlag, 4)
Debug.Print iRetVal & " " & Err.LastDllError & " " & "INTERNET_OPTION_SECURITY_FLAGS"
GoTo Resend
End If
If iRetVal Then
Dim dwStatus As Long, dwStatusSize As Long
dwStatusSize = Len(dwStatus)
HttpQueryInfo hHttpOpenRequest, HTTP_QUERY_FLAG_NUMBER Or HTTP_QUERY_STATUS_CODE, dwStatus, dwStatusSize, 0
Select Case dwStatus
Case HTTP_STATUS_PROXY_AUTH_REQ
iRetVal = InternetSetOptionStr(hHttpOpenRequest, INTERNET_OPTION_PROXY_USERNAME, "IUSR_WEIHUA1", Len("IUSR_WEIHUA1") + 1)
iRetVal = InternetSetOptionStr(hHttpOpenRequest, INTERNET_OPTION_PROXY_PASSWORD, "IUSR_WEIHUA1", Len("IUSR_WEIHUA1") + 1)
GoTo Resend
Case HTTP_STATUS_DENIED
iRetVal = InternetSetOptionStr(hHttpOpenRequest, INTERNET_OPTION_USERNAME, "IUSR_WEIHUA1", Len("IUSR_WEIHUA1") + 1)
iRetVal = InternetSetOptionStr(hHttpOpenRequest, INTERNET_OPTION_PASSWORD, "IUSR_WEIHUA1", Len("IUSR_WEIHUA1") + 1)
GoTo Resend
End Select
SetStatus "HttpQueryInfo"
'response headers
GetQueryInfo hHttpOpenRequest, lblContentType, HTTP_QUERY_CONTENT_TYPE
GetQueryInfo hHttpOpenRequest, lblContentLength, HTTP_QUERY_CONTENT_LENGTH
GetQueryInfo hHttpOpenRequest, lblLastModified, HTTP_QUERY_LAST_MODIFIED
GetQueryInfo hHttpOpenRequest, lblVersion, HTTP_QUERY_VERSION
GetQueryInfo hHttpOpenRequest, lblStatusCode, HTTP_QUERY_STATUS_CODE
GetQueryInfo hHttpOpenRequest, lblStatusText, HTTP_QUERY_STATUS_TEXT
GetQueryInfo hHttpOpenRequest, lblRawHeaders, HTTP_QUERY_RAW_HEADERS
GetQueryInfo hHttpOpenRequest, txtResponseHeaders, HTTP_QUERY_RAW_HEADERS_CRLF
GetQueryInfo hHttpOpenRequest, lblForwarded, HTTP_QUERY_FORWARDED
GetQueryInfo hHttpOpenRequest, lblServer, HTTP_QUERY_SERVER
GetQueryInfo hHttpOpenRequest, lblRequestMethod, HTTP_QUERY_REQUEST_METHOD
GetQueryInfo hHttpOpenRequest, lblPragma, HTTP_QUERY_FLAG_REQUEST_HEADERS + HTTP_QUERY_PRAGMA
GetQueryInfo hHttpOpenRequest, txtRequestHeaders, HTTP_QUERY_FLAG_REQUEST_HEADERS + HTTP_QUERY_RAW_HEADERS_CRLF
GetQueryInfo hHttpOpenRequest, lblUserAgent, HTTP_QUERY_FLAG_REQUEST_HEADERS + HTTP_QUERY_USER_AGENT
GetQueryInfo hHttpOpenRequest, lblRequestMethod2, HTTP_QUERY_FLAG_REQUEST_HEADERS + HTTP_QUERY_REQUEST_METHOD
sStatus = "Ready"
btSend.Enabled = False
btGet.Enabled = True
Else
' HttpSendRequest failed
sStatus = "HttpSendRequest call failed; Error code: " & Err.LastDllError & "."
End If
Else
' HttpOpenRequest failed
sStatus = "HttpOpenRequest call failed; Error code: " & Err.LastDllError & "."
End If
Else
' InternetConnect failed
sStatus = "InternetConnect call failed; Error code: " & Err.LastDllError & "."
End If
Else
' hInternetSession handle not allocated
sStatus = "InternetOpen call failed: Error code: " & Err.LastDllError & "."
End If
SetStatus sStatus
If optPost.Value Then
GetServerFileContent
End If
Screen.MousePointer = vbDefault
End `
Public Sub GetServerFileContent()
Dim bdoLoop As Boolean
Dim sReadBuffer As String * 2048
Dim lNumberOfBytesRead As Long
Dim sbuffer As String
SetStatus "InternetReadFile"
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
Debug.Print sbuffer
End Sub