Question

如何使用winsock for https来获取和发布请求。它可以正常使用http.but当我使用https时，我收到了这个回复..

您的浏览器发送了此服务器无法理解的请求原因：您正在向支持SSL的服务器端口说明HTTP 请使用HTTPS方案访问此URL

Answer 1

使用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

如何在vb6.0中使用https使用winsock

1 个答案: