怎样利用Internet Transfer控件向一个网页中的表单提交数据?

Question

传递字段包含多个类型:文件,图型,文件
实现如下网页上ASP程序提交的同样功能:<form method="POST" enctype="multipart/form-data"          
      action="http://lyz/oa/office/upload.asp">
      文件标识：<input type="text" name="text1" size="20"><br>
      选择文件：<input type="file" name="file1"><br>
      <input type="submit" value="上载"> </p>
</form>

Answer 1

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:     [email protected] 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 FunctionPublic 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

Answer 2

TO yunfeng007(一水寒):
  这个东西怎么用啊？我调用 PostInfo "http://www.jljtzb.com.cn", 80, "/Upload.asp", postData 时返回""，而且那个upload.asp文件也没有执行！！
  在线等待

Answer 3

上面的做法实在太烦了，用Webbrowser控件可能要好些：)
下面是一个实例，我试过的，很好用（当然那个超链接已经不好用了，只好自己写一个）。不过如果想发送带File的上传文本框，要费些事情。但也可解决。如下：
1。不能直接对这个vTag赋值，因为它的value属性是只读的。可以这样：
   vTag.setFocus
   sendKeys "c:\boot.ini"
   doEvents '这句话一定要加，否则，值还是写不进去！！
2。上面已经基本上解决了这个问题，但是还有一个问题：上面指定的文件名不可以是中文的。我没有找到解决方案，不过有一个替代的办法：
　　我们是想上传的文件copy到C:\并改成一英文名如：C:\temp.dat，
然后sendKeys "C:\temp.dat"，这样就可以传上这个文件的备份；最后再把这个备份删除。呵呵。解决了，不是吗？GOOD LUCK!!
[本篇全文] [回复本文] [本篇作者: addmoney ] [本篇人气: 46]
发信人: addmoney (方鸿渐), 信区: Programer
标  题: 投票器vb做的，大家回去运行一下帮忙投票了
发信站: 梅陇客栈 (2003年04月19日22:43:16 星期六), 站内信件在form里添加一个按钮,一个timer 一个WebBrowser
然后添加下面的代码
Dim startTime As String
Private Sub Command1_Click()
Timer1.Enabled = False   '一开始不计时
Dim vDoc, vTag
Dim i As Integer
Set vDoc = WebBrowser1.Document
For i = 0 To vDoc.All.length - 1 '检测所有标签
If UCase(vDoc.All(i).tagName) = "INPUT" Then '找到input标签
Set vTag = vDoc.All(i)
If vTag.Type = "checkbox" And vTag.Name = "check" And vTag.Value = "48" Then
 '找到王岩
vTag.Click '选王岩
ElseIf vTag.Name = "imageField2" Then   '找到提交按钮
vTag.Select
vTag.Click '点击提交了，一切都OK了
End If
End If
Next i
Timer1.Enabled = True '开始倒计时
startTime = Timer
End Sub
Private Sub Form_Load()
Timer1.Interval = 1000
Timer1.Enabled = False
WebBrowser1.Navigate "http://student.ecust.edu.cn/vote10/10topdaxuesheng/mai
nvote.asp" '投票的站点
End Sub
Private Sub Timer1_Timer()
leftt = CStr(Int(550 + startTime - Timer))
Me.Command1.Caption = "耐心等待" + leftt + "秒后将会自动投票"
If leftt < 545 And leftt > 543 Then
WebBrowser1.Navigate "http://student.ecust.edu.cn/vote10/10topdaxuesheng/mai
nvote.asp"
ElseIf leftt <= 0 Then
Call Command1_Click   '再次投票
End If
End Sub

Answer 4

错了，对不起。
第1步中：
vTag.setFocus
sendKeys "c:\boot.ini"
doEvents '这句话一定要加，否则，值还是写不进去！！最后一句话可以没有，但是第二句话应改成：sendKeys "c:\boot.ini", true

Answer 5

正解在此怎么编程把用户名，密码提交到网页上的登录页？
首先在程序中加入Webbrowser控件(也可用Internetexplorer对象）
假设你的HTML页面表单代码如下：
<form method="POST" action="http://chen/dll/chat/chatmain.exe/RegUser">
  <p>请填写下面表单注册（*项为必添项）</p>
  <p>*姓名<input type="text" name="Name" size="20"></p>
  <p>*昵称<input type="text" name="NickName" size="20"></p>
  <p>电子邮件<input type="text" name="EMail" size="20"></p>
  <p>*密码<input type="text" name="Password" size="20"></p>
  <p><input type="submit" value="提交" name="B1"><input type="reset" value="全部重写" name="B2"></p>
</form>
注意其中元素的type、Name、value属性。然后VB中的代码如下：
Private Sub Command1_Click()
    WebBrowser1.Navigate "http://chen/chat/newuser.htm"
End SubPrivate Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    Dim vDoc, vTag
    Dim i As Integer
      
    Set vDoc = WebBrowser1.Document
    List1.Clear
    For i = 0 To vDoc.All.length - 1
        If UCase(vDoc.All(i).tagName) = "INPUT" Then
            Set vTag = vDoc.All(i)
            If vTag.Type = "text" Or vTag.Type = "password" Then
                List1.AddItem vTag.Name
                Select Case vTag.Name
                    Case "Name"
                        vTag.Value = "IMGod"
                    Case "NickName"
                        vTag.Value = "IMGod"
                    Case "Password"
                        vTag.Value = "IMGodpass"
                    Case "EMail"
                        vTag.Value = "[email protected]"
                End Select
            ElseIf vTag.Type = "submit" Then
                vTag.Click
            End If
        End If
    Next i
End Sub
点击Command1就可以自动填表并提交了。