• 新浪微博:
  • 微信 :
按键精灵电脑版
立即下载

软件版本:2014.05
软件大小:21.6M
更新时间:07-04

按键精灵安卓版
立即下载

软件版本:3.3.1
软件大小:62.5M
更新时间:5-24

按键精灵iOS版
立即下载

软件版本:1.3.5
软件大小:29.2M
更新时间:06-14

最新企业版UiBot
立即下载

软件版本:2.5
软件大小:181M
更新时间:05-20

快捷导航

登录 后使用快捷导航
没有帐号? 注册

登录 注册
发新话题 回复该主题

[心得分享] 【分享】带进度条自动更新小精灵程序!!! [复制链接]

1#

更新程序是我用按键精灵生成的独立程序(Update.exe)


我的后台演示:http://blxw.cn3v.net/




第一步:注册免费虚拟空间
①注册地址:smwh.3v.do
②记下 FTP地址FTP帐号FTP密码
③下载FTP上传软件:8uFTP
④通过 8uFTP 把附件里的文件上传到FTP空间根目录,就可以打开你注册的网址了!
网页如果显示乱码的话,右键,选择编码UTF-8
附件:ASP+Access后台源码.zip


第二步:放入检测更新代码到脚本里 注:服务器网址 一定要改成你自己注册的
  1. '注意!!!请生成小精灵在测试,用按键精灵调试的后果自负
  2. Call 小精灵外置更新(Form1.Hwnd, 14, 1.2)
复制代码
  1. Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
  2. Declare Function GetAncestor Lib "user32.dll" (ByVal hwnd As Long, ByVal GetAncestorFlags As Long) As Long
  3. Function 小精灵外置更新(句柄, 软件ID, 当前版本号)
  4. Dim Hwnd,res,t1,t2,fso,fs,TXT,返回值,服务器网址,当前全路径,当前软件名
  5. '=====================【配置区域】=================
  6. 服务器网址 = "blxw.cn3v.net" '这里填上你自己申请的网址
  7. '==================================================
  8. Hwnd = GetAncestor(0 + 句柄, 3)
  9. 当前全路径 = Plugin.Window.GetExePath(Hwnd)
  10. 当前软件名= CreateObject("Scripting.FileSystemObject").GetFile(当前全路径).name
  11. Plugin.Msg.Tips "正在检查更新。。。"
  12. Delay 500
  13. '下载更新程序
  14. If Not Plugin.File.IsFileExist("Update.exe") Then
  15. Set fso = CreateObject("Scripting.Filesystemobject")
  16. Set fs = fso.CreateTextFile("tool.vbs", True)
  17. TXT = _
  18. "on error resume next" & vbCrLf &_
  19. "Set fso = CreateObject(""Scripting.Filesystemobject"")" & vbCrLf &_
  20. "fso.DeleteFile(WScript.ScriptFullName)" & vbCrLf &_
  21. "set xPost=CreateObject(""WinHttp.WinHttpRequest.5.1"")" & vbCrLf &_
  22. "xPost.Open ""GET"",""http://zhezhan.cc/Download/Update.exe"", 0" & vbCrLf &_
  23. "xPost.Send()" & vbCrLf &_
  24. "set sGet=CreateObject(""ADODB.Stream"")" & vbCrLf &_
  25. "sGet.Mode=3" & vbCrLf &_
  26. "sGet.Type=1" & vbCrLf &_
  27. "sGet.Open()" & vbCrLf &_
  28. "sGet.Write xPost.ResponseBody" & vbCrLf &_
  29. "sGet.SaveToFile ""Update.exe"",2"
  30. fs.Write TXT
  31. fs.Close
  32. Set fs = Nothing
  33. Set fso = Nothing
  34. RunApp "tool.vbs"
  35. End If
  36. 返回值 = Split(获得网页源文件("http://" & 服务器网址 & "/var.asp?ID="& 软件ID &"&bm=utf-8"), "|")
  37. If 0 + ("0" & 返回值(0)) < 1 Then
  38. MsgBox "网络连接超时!请重试。。。", 16, "提示!"
  39. Delay 500
  40. PostMessage Hwnd, 16, 0, 0
  41. ElseIf 0+("0"&返回值(0)) > 0+当前版本号 Then
  42. 小精灵外置更新 = True
  43. Plugin.Msg.Tips "发现新版本!"
  44. Delay 500
  45. 更新版本 = 返回值(0)
  46. If InStr(1, 返回值(1), "3v", 1) > 0 Then
  47. 更新地址 = Split(正则匹配(获得网页源文件(返回值(1) & "?bm=GBK"), "[a-zA-z]+://[^\s^""]*", "|", True, 3), "|")(0)
  48. Else
  49. 更新地址 = 返回值(1)
  50. End If
  51. 更新内容 = "【"&返回值(3) &"v" & 返回值(0) & "】" & vbCrLf & "【更新内容】:" & vbCrLf & 返回值(2)
  52. 新软件名 = 返回值(3)
  53. Call Plugin.Window.Hide(Hwnd)
  54. Call Plugin.File.WriteINI("更新记录", "更新地址", 更新地址, "C:\Update.ini")
  55. Call Plugin.File.WriteINI("更新记录", "新软件名", 新软件名, "C:\Update.ini")
  56. Call Plugin.File.WriteINI("更新记录", "更新版本", 更新版本, "C:\Update.ini")
  57. Call Plugin.File.WriteINI("更新记录", "旧版路径", 当前全路径, "C:\Update.ini")
  58. Call Plugin.File.WriteINI("更新记录", "更新内容", Replace(更新内容, vbCrLf, "|"), "C:\Update.ini")
  59. If InStr(Plugin.Window.GetText(Hwnd), "按键精灵") = 0 Then
  60. Set fso = CreateObject("Scripting.Filesystemobject")
  61. Set fs = fso.CreateTextFile("Update.vbs", True)
  62. TXT = _
  63. "WScript.sleep 5000" & vbCrLf &_
  64. "Set ws = CreateObject(""WScript.Shell"")"& vbCrLf &_
  65. "ws.Run """& Split(当前全路径, "\"&当前软件名)(0) &"\Update.exe""" & vbCrLf &_
  66. "Set ws = Nothing "& vbCrLf &_
  67. "Set fso = CreateObject(""Scripting.Filesystemobject"")"& vbCrLf &_
  68. "fso.DeleteFile(WScript.ScriptFullName)"& vbCrLf &_
  69. "Set fso = Nothing"
  70. fs.Write TXT
  71. fs.Close
  72. Set fs = Nothing
  73. Set fso = Nothing
  74. RunApp "Update.vbs"
  75. PostMessage Hwnd, 16, 0, 0
  76. Else
  77. Call Plugin.Window.Show(Hwnd)
  78. MsgBox "危险!调试状态不能进行更新操作!", 16, "警告!"
  79. End If
  80. Else
  81. 小精灵外置更新 = False
  82. Plugin.Msg.Tips "已是最新版本!"
  83. Delay 500
  84. End If
  85. End Function
  86. Function 获得网页源文件(网页地址)
  87. //说明:支持远程获取文本内容,如:
  88. '自动识别编码:
  89. ' MsgBox Lib.网络.获得网页源文件("http://www.anjian.com")
  90. '自定义编码:
  91. ' 参数格式:BM=编码类型
  92. ' 编码类型:GB2312、GBK、GB18030、UTF-8、ANSI、Unicode ……
  93. ' MsgBox Lib.网络.获得网页源文件("http://www.anjian.com/test.txt?BM=UTF-8")
  94. '除去HTML标签代码:
  95. ' 参数格式:TQ=1
  96. ' MsgBox Lib.网络.获得网页源文件("http://www.anjian.com/?TQ=1")
  97. ' MsgBox Lib.网络.获得网页源文件("http://www.anjian.com/test.txt?BM=UTF-8&TQ=1")
  98. Dim xmlHttp, xmlBody, xmlUrl, URL头, 网页编码, 分割编码
  99. Dim ThisCharCode, NextCharCode, BytesToBstr
  100. Dim rep, MatchEs
  101. URL头 = Left(网页地址, 7)
  102. Select Case URL头
  103. Case "https:/", "http://"
  104. xmlUrl = 网页地址
  105. Case Else
  106. xmlUrl = "http://" & 网页地址
  107. End Select
  108. Set xmlHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
  109. xmlHttp.Open "Get", xmlUrl, False
  110. xmlHttp.Send
  111. 获得网页源文件 = ""
  112. Set rep = New RegExp
  113. rep.IgnoreCase = True
  114. rep.[Global] = True
  115. Do
  116. If InStr(1, xmlUrl, "BM=", 1) = 0 Then
  117. If Len(XmlHttp.ResponseText) = 0 Then Set xmlHttp = Nothing : Exit Function
  118. If InStr(1, XmlHttp.ResponseText, "charset", 1) > 0 Then
  119. rep.Pattern = "content=""text/html;[\s]charset=([^<>""]+)""|[\s]charset=([^<>""]+)"""
  120. Set MatchEs = rep.Execute(XmlHttp.ResponseText)
  121. If rep.test(XmlHttp.ResponseText) Then
  122. 网页编码 = MatchEs(0).SubMatches.Item(0)
  123. Else
  124. 网页编码 = "GBK"
  125. End If
  126. Else
  127. 网页编码 = "GBK"
  128. End If
  129. Else
  130. rep.Pattern = "(?:\?|&)BM=([^\&]+)"
  131. Set MatchEs = rep.Execute(xmlUrl)
  132. 网页编码 = MatchEs(0).SubMatches.Item(0)
  133. Goto 直接获取源码
  134. End If
  135. Rem 直接获取源码
  136. xmlBody = xmlHttp.ResponseBody
  137. Set xmlHttp = Nothing
  138. If Len(xmlBody) = 0 Then Exit Function
  139. Set ObjStream = CreateObject("Adodb.Stream")
  140. With ObjStream
  141. .Type = 1
  142. .Mode = 3
  143. .Open
  144. .Write xmlBody
  145. .Position = 0
  146. .Type = 2
  147. .Charset = 网页编码
  148. BytesToBstr = .ReadText
  149. .Close
  150. End With
  151. Set ObjStream = Nothing
  152. Exit Do
  153. Loop
  154. Rem 获取完毕
  155. If InStr(1, xmlUrl, "TQ=1", 1) > 0 Then
  156. rep.Pattern = "(<[^>]*?>)|(&nbsp;)"
  157. Set MatchEs = rep.Execute(BytesToBstr)
  158. BytesToBstr = rep.Replace(BytesToBstr, "")
  159. End If
  160. 获得网页源文件 = BytesToBstr
  161. End Function
  162. Function 正则匹配(字串符, 表达式, 分隔符, 忽略大小写, 获取类型)
  163. Dim rep, i, tmp, MatchEs, Match, shuliang, SubMatches, 子匹配数量, 子匹配
  164. Set rep = New RegExp
  165. rep.IgnoreCase = 忽略大小写
  166. rep.[Global] = True
  167. rep.Pattern = 表达式
  168. Set MatchEs = rep.Execute(字串符)
  169. shuliang = Matches.count
  170. For Each Match In MatchEs
  171. tmp = tmp & Match.Value & 分隔符
  172. If 获取类型 = 1 Or 获取类型 = 2 Then
  173. Set SubMatches = Match.SubMatches '创建子匹配对象
  174. 子匹配数量 = SubMatches.Count
  175. For i = 0 To 子匹配数量-1
  176. 子匹配 = 子匹配 & SubMatches.Item(i) & 分隔符
  177. Next
  178. End If
  179. 'TracePrint "位置:" & Match.FirstIndex + 1 '获取匹配字符所在位置
  180. Next
  181. Select Case 获取类型
  182. Case 0,"数量"
  183. 正则匹配 = shuliang
  184. Case 1, "子数量"
  185. 正则匹配 = 子匹配数量
  186. Case 2, "子匹配"
  187. 正则匹配 = 子匹配
  188. Case Else
  189. 正则匹配 = tmp
  190. End Select
  191. Set rep = Nothing
  192. Set MatchEs = Nothing
  193. End Function
复制代码



最后放上测试用的小精灵:
Update.exe下载http://zhezhan.cc/Download/Update.exe
测试小精灵http://zhezhan.cc/Download/456.zip

最后编辑神梦科技 最后编辑于 2016-05-12 01:38:55
2#

66666666
我来看隐藏~

WWW.92AJ.CN
承接中小型 游戏/办公/投票/自动发货类 脚本
如果回答对你有所帮助请不要吝啬手中的鲜花
3#

感谢分享。

承接各类脚本开发

有偿解决按键基础问题(可远程讲解)

寻6级作者分摊单子,无需任何押金,开发全程不经我手!


QQ:517216542

《征途2S》和《千军》全部功能完全免费的脚本 ↓


正式版》》
经典版》》
4#

Win10的也支持更新了

5#

1111111111111111111111111

6#

3333333333333

7#

厉害 昂昂

8#

感谢分享,学习

9#

学习一下 支持!

10#

看看这个怎么样。不错

11#

谢谢,学习一下

12#

朝秦暮楚魂牵梦萦fa

13#

看看什么好东西。

14#

厉害了666

[color=Red]按键精灵交流群(228565589)解答新手问题,欢迎各位朋友[/color][url=https://jq.qq.com/?_wv=1027&k=5UYAC0p]点击此处加群[/url]
15#

电脑还是手机的

16#

&激光焊接

17#

测试

18#

看一下。。。。。。。。。

19#

看一下,感谢分享

20#

谢谢分享....

发新话题 回复该主题