VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - vb调用winInet API接口post数据到指定的url
发表评论(0)作者:不详, 平台:VB6.0+Win98, 阅读:13148, 日期:2000-12-29
『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