回 帖 发 新 帖 刷新版面

主题:[原创]vb与网站进行交互,从应用程序提交数据到网站(附代码)

[color=FF0000][b]本人在第9楼发布新代码了(此句2007年7月10日新加)[/b]
程序中大多用了配置文件用INI方式,建议现在用XML方式
[/color]

程序思路:利用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代码请自主下载

回复列表 (共19个回复)

沙发

ASP部分的代码思路:
首先获取GET提交的各个参数值。(即程序中的data1、data2和md5)
然后判断是否出现空值 如果有则让应用程序提示“参数错误”
然后验证数据的完整性即判断提交的MD5和重新加密的MD5是否完全一致。否则提示“验证失败”asp_md5.asp文件就是存放md5函数的
conn.asp则是数据库连接文件
在确认数据无误后将数据提交的并增加到数据表中
并提示用户“数据提交成功”
-----------------------------------
关于本程序(ASP、VB两部分)不明白的地方可以咨询我:QQ409437 E sunfeng21@126.com

板凳

好贴

3 楼

[quote] 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[/quote]
这段冗长、低效和令人费解的代码可以简化为:
[color=0000FF]Private Function GetHttpPage(ByVal sURL As String) As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", sURL, False
        .send
        GetHttpPage = StrConv(.responseBody, vbUnicode)
    End With
End Function[/color]

其它的就不多说了,没心情呀,唉,好好的一担生意就这样被毁了,连找份工作都被人嫌太老,明天都不知道有没有钱买米开饭了!

[color=FF00FF]冷雨夜我不想归家,怕老婆骂,骂我没钱呀!  -  Beyond 《冷雨夜》[/color]

4 楼

谢谢 副斑竹指点~~!小弟受教了~!



其实本来我并没有用这些函数
只用了浏览器控件
后来发现这样很难看,也不能用msgbox函数来提示
想了很久才想到获取网页源代码有这么多好处~!

当然获取代码的这个函数我也是网上找的经过我略加修改的。其实这个函数我也不是读得很懂。

5 楼

过来学习,好帖

6 楼

如何服务器那边没有可执行权限呢?

7 楼

[quote]如何服务器那边没有可执行权限呢?[/quote]
第6楼:你好我并不是很明白你所说的意思。
我想是这样的在NTFS下的guest权限是吧。你可以自己设置任何人可访问数据库呀

8 楼

好,学习ing

9 楼

经过本人修改:新程序请下载
[url=http://upload.programfan.com/upfile/200707101104329.rar]http://upload.programfan.com/upfile/200707101104329.rar[/url]
本人利用原来的思路,现实了更强的互交功能。
实现了注册、登陆、修改资料、查看资料
等等
这一切的数据都只要存放在网站上,只需要一个空间,无须特定配置服务器端软件、SQL server 

思路:
开放ASP接口利用GET获取数据。。
而软件则向网页传输数据!
软件中代码有详细的注释,不懂的请CALL本人。
ASP需要IIS的支持,没有安装IIS的可以
[url=http://www.z120.net/Soft/ShowSoftDown.asp?UrlID=1&SoftID=25]下载ASP小旋风[/url]

10 楼

很有用的东西

我来回复

您尚未登录,请登录后再回复。点此登录或注册