VB 检测更新的程序

刚好在看这文章！ 我转发给你吧！里面也有源码的下载地址=========================================================================== 很多朋友问这个关于网络更新的问题。其实很简单，一点都不难。我这里给大家做了个演示文件。由于是演示，所我把很多常量都做成了变量，本应该放Private Sub Form_Load()End Sub里的首凳过程，放在了 按钮里！说明下！原理：1.在服务器上用一个txt文件存放版本信息，检查更新的时候先把那个txt文件下载下来，打开，对比你 提前预设本程序的版本信息。我这里预设了两个，以个是1.0.0另个是1.0.1按钮1 对比1.0.0和服务器上的1.0.1当然不一致了核清，这就问你是不是更新。按钮2对比的是1.0.1 和服务器一致就不更新了。2.更新是时候会自动更名，我我 服务器是免费的5944垃圾，他不 允许下载exe所以我改了下扩展名为txt 这样就允许下载了，到本地我再改回来，气死它！3.要先运行新程序，再关闭老程序。代码如下：Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Private Sub Command1_Click()

R = URLDownloadToFile(0, Text1.Text, "Version.txt", 0, 0)

If R = 0 Then

'下载成功，则打开文件对比版本：把最新版本信息放第一行

Set fso1 = CreateObject("scripting.filesystemobject")

Set file0 = fso1.OpenTextFile("Version.txt", 1, 1)

d = file0.Readline

d = Trim(d)

If d = Trim(Text3.Text) Then

MsgBox "你的程序已经是最新版本，不需要更新！当前版本为：" &Text3.Text, 48, "恭喜你！"

Else

ifdl = MsgBox("你的程序不只最新版本，是否更新到最新版本？服务器版本为:" &d, vbYesNo, "出新版本了，你Y的 更新不？")

If ifdl = 6 Then

r1 = URLDownloadToFile(0, Text2.Text, "new.exe", 0, 0)

If r1 = 0 Then

MsgBox "更新完成，点击确定运行新版本"

Shell "new.exe", vbNormalFocus

End

End If

Else

MsgBox "下载失败，请检测网络连接是否正常，或者，服务器正常。", 16, "错误！灵魂口袋6921833"

End If

End If

file0.Close

Else

MsgBox "错误" &R &vbCrLf &"改芹前检测更新失败，请确定你的网络连接正常！", 16, "抱歉！有问题联系6921833"

End If

End SubPrivate Sub Command2_Click()

r1 = URLDownloadToFile(0, Text2.Text, "new.exe", 0, 0)

If r1 = 0 Then

MsgBox "更新完成，点击确定运行新版本"

Shell "new.exe", vbNormalFocus

End

Else

MsgBox "下载失败，请检测网络连接是否正常，或者，服务器正常。", 16, "错误！灵魂口袋6921833"

End If

End SubPrivate Sub Command3_Click()

End

End SubPrivate Sub Command4_Click()

R = URLDownloadToFile(0, Text1.Text, "Version.txt", 0, 0)

If R = 0 Then

'下载成功，则打开文件对比版本：把最新版本信息放第一行

Set fso1 = CreateObject("scripting.filesystemobject")

Set file0 = fso1.OpenTextFile("Version.txt", 1, 1)

d = file0.Readline

d = Trim(d)

If d = Trim(Text4.Text) Then

MsgBox "你的程序已经是最新版本，不需要更新！", 48, "恭喜你！"

Else

ifdl = MsgBox("你的程序不只最新版本，是否更新到最新版本？服务器版本为:" &d, vbYesNo, "出新版本了，你Y的 更新不？")

If ifdl = 6 Then

r1 = URLDownloadToFile(0, Text2.Text, "new.exe", 0, 0)

If r1 = 0 Then

MsgBox "更新完成，点击确定运行新版本"

Shell "new.exe", vbNormalFocus

End

End If

Else

MsgBox "下载失败，请检测网络连接是否正常，或者，服务器正常。", 16, "错误！灵魂口袋6921833"

End If

End If

file0.Close

Else

MsgBox "错误" &R &vbCrLf &"检测更新失败，请确定你的网络连接正常！", 16, "抱歉！有问题联系6921833"

End If

End Sub

首没耐先【工程】——>【饥郑引烂察颂用】，勾选Microsoft Scripting Runtime

然后

Dim fso, f

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder("d:\Downloads\software")

If App.Path <>f.Path Then

MsgBox "请把程序放在***文件夹里再运行", vbExclamation

Exit Sub

End If

If f.Files.Count >= 10 Then

MsgBox "文件夹完整", vbInformation

Else

MsgBox "缺少文件" &(10 - f.Files.Count) &"个"

End If

---