『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:    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 lpszPostData As String
          Dim lPostDataLen As Long
 
          lpszPostData = postdat$
          lPostDataLen = Len(lpszPostData)
          bRet = HttpSendRequest(hHttpOpenRequest, _
                  vbNullString, _
                  0, _
                  lpszPostData, _
                  lPostDataLen)
 
          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