(转)vb与网站进行交互，从应用程序提交数据到网站

程序思路：利用ASP的GET方法提交数据，并用INI文件方式获取数据和提交状态
实现方法：利用相关函数获取特定html源代码，从而也调用了此页面
利用获取http://123.com/123.asp?id=123
这样既获取了 http://123.com/123.asp?id=123的代码又在内存中打开了http://123.com/123.asp?id=123这个网页从而现实了GET方式提交数据

在窗体上添加一个按钮和2个textbox
代码:
Option Explicit
‘强制声明变量

Private Declare Function GetPrivateProfileString Lib "kernel32" _
    Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
    ByVal lpKeyName As Any, ByVal lpDefault As String, _
    ByVal lpReturnedString As String, ByVal nSize As Long, _
    ByVal lpFileName As String) As Long
    ‘读取INI文件函数，作用：获取数据提交结果

    Dim httpurl As String ‘用来存放提交地址
    Dim htmlcode As String ‘用来存放提交结果与获取HTML代码

Private Sub Command1_Click()
Dim urlstr As String

If Trim(Text1.Text) = "" Then MsgBox "数据1不能为空": Exit Sub
If Trim(Text2.Text) = "" Then MsgBox "数据2不能为空": Exit Sub
‘判断数据是否为空

urlstr = httpurl & "?date1=" & Text1.Text & "&date2=" & Text2.Text & "&md5=" & _
           MD5.MD5(Text1.Text & "_" & Text2.Text)
‘MD5是为了验证数据，防止非应用软件来源数据可以改成    MD5.MD5("111111111" & Text1.Text & "_" & Text2.Text) 格式从而不可破解
‘用ASP   GET 方式提交表单

htmlcode = gethtm.getHTTPPage(urlstr)
htmlcode = Trim(htmlcode)

If Left(htmlcode, 7) = "连接服务器失败" Then MsgBox htmlcode, 16, "数据提交程序": Exit Sub
‘当无法连接服务器时，程序给出处理

Dim savName As String, savText As String, filename As String
savName = App.Path & "/temp.ini"
   Open savName For Output As #1
     savText = htmlcode
     ‘如果用write写文件，文本的内容会有双引号
     Print #1, savText
Close #1
‘将获取的网页HTMK文件（含提交状态）写入临时文件

Dim ret As Long
Dim buff As String
‘——————————
buff = String(255, 0)
ret = GetPrivateProfileString("数据提交程序", "state", "发生未知错误，或无法连接到指定地址！", buff, 256, App.Path & "/temp.ini")
buff = del34(buff)
MsgBox buff, vbInformation, "『数据提交程序』数据提交程序"
‘提示提交状态

Kill App.Path & "/temp.ini"
‘删除临时文件

If buff = "数据提交成功！" Or buff = "数据提交成功!" Then
Text1.Text = ""
Text2.Text = ""
End If
‘如果提交成功，则清空textbox中的数据

End Sub

Private Sub Form_Load()
httpurl = "http://127.0.0.1/123.asp" ‘指定提交地址
End Sub
Function del34(a As String) As String ‘函数作用：去除INI获取的无效字符
Dim i As Integer
del34 = ""
For i = 1 To Len(a)
If Asc(Mid(a, i, 1)) <> 0 Then del34 = del34 & Mid(a, i, 1)
Next

End Function

gethtm模块函数代码：
Function getHTTPPage(url)
On Error GoTo e:
   Dim Http
   Set Http = CreateObject("MSXML2.XMLHTTP")
   Http.Open "GET", url, False
   Http.send
   If Http.ReadyState <> 4 Then
   Exit Function
   End If
   getHTTPPage = BytesToBstr(Http.responseBody, "GB2312")
   Set Http = Nothing
   If Err.Number <> 0 Then Err.Clear

   Exit Function
e:
If Err.Number = -2146697211 Then
     getHTTPPage = "连接服务器失败，请检查网络连接！"
Else
     getHTTPPage = "未预期的错误！"
End If
   End Function

   Function BytesToBstr(body, Cset)
   Dim objstream
   Set objstream = CreateObject("adodb.stream")
   objstream.Type = 1
   objstream.Mode = 3
   objstream.Open
   objstream.Write body
   objstream.Position = 0
   objstream.Type = 2
   objstream.Charset = Cset
   BytesToBstr = objstream.ReadText
   objstream.Close
   Set objstream = Nothing
   End Function
MD5模块代码和ASP代码请自主下载