132.htm

vb功能实例介绍。详细、很好的实例说明。

<p>vb调用winInet API接口post数据到指定的url</p>
<p></p>
<p> </p>
<p>『vb调用wininet api接口post数据到指定的url』</p>
<p></p>
<p>注释：this module is called modwininet.bas. use the splitaddr() function to get the address in the correct format for postinfo.</p>
<p></p>
<p>option explicit</p>
<p></p>
<p>注释：author:    sam huggill</p>
<p>注释：email:     [e-mail]</p>
<p></p>
<p>private declare function internetopen lib "wininet.dll" _</p>
<p>         alias "internetopena" _</p>
<p>            (byval lpszcallername as string, _</p>
<p>             byval dwaccesstype as long, _</p>
<p>             byval lpszproxyname as string, _</p>
<p>             byval lpszproxybypass as string, _</p>
<p>             byval dwflags as long) as long</p>
<p></p>
<p>      private declare function internetconnect lib "wininet.dll" _</p>
<p>            alias "internetconnecta" _</p>
<p>            (byval hinternetsession as long, _</p>
<p>             byval lpszservername as string, _</p>
<p>             byval nproxyport as integer, _</p>
<p>             byval lpszusername as string, _</p>
<p>             byval lpszpassword as string, _</p>
<p>             byval dwservice as long, _</p>
<p>             byval dwflags as long, _</p>
<p>             byval dwcontext as long) as long</p>
<p></p>
<p>   private declare function internetreadfile lib "wininet.dll" _</p>
<p>            (byval hfile as long, _</p>
<p>             byval sbuffer as string, _</p>
<p>             byval lnumbytestoread as long, _</p>
<p>             lnumberofbytesread as long) as integer</p>
<p></p>
<p>   private declare function httpopenrequest lib "wininet.dll" _</p>
<p>            alias "httpopenrequesta" _</p>
<p>            (byval hinternetsession as long, _</p>
<p>             byval lpszverb as string, _</p>
<p>             byval lpszobjectname as string, _</p>
<p>             byval lpszversion as string, _</p>
<p>             byval lpszreferer as string, _</p>
<p>             byval lpszaccepttypes as long, _</p>
<p>             byval dwflags as long, _</p>
<p>             byval dwcontext as long) as long</p>
<p></p>
<p>   private declare function httpsendrequest lib "wininet.dll" _</p>
<p>            alias "httpsendrequesta" _</p>
<p>            (byval hhttprequest as long, _</p>
<p>             byval sheaders as string, _</p>
<p>             byval lheaderslength as long, _</p>
<p>             byval soptional as string, _</p>
<p>             byval loptionallength as long) as boolean</p>
<p></p>
<p>   private declare function internetclosehandle lib "wininet.dll" _</p>
<p>            (byval hinternethandle as long) as boolean</p>
<p></p>
<p>   private declare function httpaddrequestheaders lib "wininet.dll" _</p>
<p>             alias "httpaddrequestheadersa" _</p>
<p>             (byval hhttprequest as long, _</p>
<p>             byval sheaders as string, _</p>
<p>             byval lheaderslength as long, _</p>
<p>             byval lmodifiers as long) as integer</p>
<p></p>
<p></p>
<p>public function postinfo$(srv$, port$, script$, postdat$)</p>
<p></p>
<p>  dim hinternetopen as long</p>
<p>  dim hinternetconnect as long</p>
<p>  dim hhttpopenrequest as long</p>
<p>  dim bret as boolean</p>
<p>  </p>
<p>  hinternetopen = 0</p>
<p>  hinternetconnect = 0</p>
<p>  hhttpopenrequest = 0</p>
<p>  </p>
<p>  注释：use registry access settings.</p>
<p>  const internet_open_type_preconfig = 0</p>
<p>  hinternetopen = internetopen("http generic", _</p>
<p>                  internet_open_type_preconfig, _</p>
<p>                  vbnullstring, _</p>
<p>                  vbnullstring, _</p>
<p>                  0)</p>
<p>  </p>
<p>  if hinternetopen <> 0 then</p>
<p>     注释：type of service to access.</p>
<p>     const internet_service_http = 3</p>
<p>     const internet_default_http_port = 80</p>
<p>     注释：change the server to your server name</p>
<p>     hinternetconnect = internetconnect(hinternetopen, _</p>
<p>                        srv$, _</p>
<p>                        port$, _</p>
<p>                        vbnullstring, _</p>
<p>                        "http/1.0", _</p>
<p>                        internet_service_http, _</p>
<p>                        0, _</p>
<p>                        0)</p>
<p>  </p>
<p>     if hinternetconnect <> 0 then</p>
<p>      注释：brings the data across the wire even if it locally cached.</p>
<p>       const internet_flag_reload = &h80000000</p>
<p>       hhttpopenrequest = httpopenrequest(hinternetconnect, _</p>
<p>                           "post", _</p>
<p>                           script$, _</p>
<p>                           "http/1.0", _</p>
<p>                           vbnullstring, _</p>
<p>                           0, _</p>
<p>                           internet_flag_reload, _</p>
<p>                           0)</p>
<p>  </p>
<p>        if hhttpopenrequest <> 0 then</p>
<p>           dim sheader as string</p>
<p>           const http_addreq_flag_add = &h20000000</p>
<p>           const http_addreq_flag_replace = &h80000000</p>
<p>  sheader = "content-type: application/x-www-form-urlencoded" _</p>
<p>             & vbcrlf</p>
<p>           bret = httpaddrequestheaders(hhttpopenrequest, _</p>
<p>             sheader, len(sheader), http_addreq_flag_replace _</p>
<p>             or http_addreq_flag_add)</p>
<p>  </p>
<p>           dim lpszpostdata as string</p>
<p>           dim lpostdatalen as long</p>
<p>  </p>
<p>           lpszpostdata = postdat$</p>
<p>           lpostdatalen = len(lpszpostdata)</p>
<p>           bret = httpsendrequest(hhttpopenrequest, _</p>
<p>                  vbnullstring, _</p>
<p>                  0, _</p>
<p>                  lpszpostdata, _</p>
<p>                  lpostdatalen)</p>
<p>  </p>
<p>           dim bdoloop             as boolean</p>
<p>           dim sreadbuffer         as string * 2048</p>
<p>           dim lnumberofbytesread  as long</p>
<p>           dim sbuffer             as string</p>
<p>           bdoloop = true</p>
<p>           while bdoloop</p>
<p>            sreadbuffer = vbnullstring</p>
<p>            bdoloop = internetreadfile(hhttpopenrequest, _</p>
<p>               sreadbuffer, len(sreadbuffer), lnumberofbytesread)</p>
<p>            sbuffer = sbuffer & _</p>
<p>                 left(sreadbuffer, lnumberofbytesread)</p>
<p>            if not cbool(lnumberofbytesread) then bdoloop = false</p>
<p>           wend</p>
<p>           postinfo = sbuffer</p>
<p>           bret = internetclosehandle(hhttpopenrequest)</p>
<p>        end if</p>
<p>        bret = internetclosehandle(hinternetconnect)</p>
<p>     end if</p>
<p>     bret = internetclosehandle(hinternetopen)</p>
<p>  end if</p>
<p>end function</p>
<p></p>
<p>public sub splitaddr(byval addr$, srv$, script$)</p>
<p>注释：inputs: the full url including http://</p>
<p>注释： two variables that will be changed</p>
<p>注释：</p>
<p>注释：returns: splits the addr$ var into the server name</p>
<p>注释： and the script path</p>
<p></p>
<p>  dim i%</p>
<p></p>
<p>  i = instr(addr$, "/")</p>
<p>  srv$ = mid(addr$, i + 2, len(addr$) - (i + 1))</p>
<p>  i = instr(srv$, "/")</p>
<p>  script$ = mid(srv$, i, len(srv$) + 1 - i)</p>
<p>  srv$ = left$(srv$, i - 1)</p>
<p></p>
<p>end sub</p>
<p> </p>