用vb写升级程序怎么写.
大家.我想问一下用vb写升级程序怎么写.最简单的就行了...
想写一个exe来取得服务器的版本数据.来提示要不要exe升级.
问题点数：100、回复次数：18Top
1 楼mydo（侯佩|hopy|ks）回复于 2006-02-02 13:24:33 得分 0
主要看你想实现的升级要包括哪些功能？文件补丁？替换相应 dll?还是其他，
无论如何用 vb 应该木问题的。Top
2 楼tommyfan（）回复于 2006-02-02 13:34:13 得分 0
我想把服务器上的ini文件下载下来.
然后根据ini里的版本信息判断.
现在就是不知道把ini下载下来的过程要怎么写.Top
3 楼province_（雍昊）回复于 2006-02-02 18:26:45 得分 0
DOFILEDOWNLOAD可以下载HTTP或FTP空间里的文件Top
4 楼faysky2（出来混，迟早是要还嘀）回复于 2006-02-05 22:24:30 得分 0
把ini文件放到Http或Ftp空间里，为客户端提供下载Top
5 楼yugui（天锋）回复于 2006-02-06 09:42:24 得分 0
直接用INI或是文本文件，本地放一个同样的INI文件，客户端读取网络上的INI文件把内容如“20060120”与本地比较，如果相同则提示不用升级，如果不相同就开始下载。
我就是这么做的。Top
6 楼HotUs（）回复于 2006-02-07 13:17:55 得分 0
类模块 DownLoad.cls
Option Explicit
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByRef hInet As Long) As Long
Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, sBuffer As Byte, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByVal sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const scUserAgent = "Tgwang"
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private mvarUrl As String
Private mvarSaveFile As String
Private mvarConnect As Boolean
Private hOpen As Long, hFile As Long
Private Buffer As String, BufLen As Long
Private RetQueryInfo As Boolean
Public Event GetData(Progress As Long) '下载进度
Public Event ErrMassage(Description As String) '错误信息
Public Event DownLoadOver()
Public Sub Execute()
mvarConnect = True
hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If mvarConnect = False Then
Cancel
Exit Sub
End If
If hOpen = 0 Then
Cancel
RaiseEvent ErrMassage("无法创建连接")
mvarConnect = False
Else
hFile = InternetOpenUrl(hOpen, mvarUrl, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
If mvarConnect = False Then
Cancel
Exit Sub
End If
If hFile = 0 Then
Cancel
RaiseEvent ErrMassage("无法连接服务器")
mvarConnect = False
Else
Buffer = Space$(1024)
BufLen = 1024
RetQueryInfo = HttpQueryInfo(hFile, 21, Buffer, BufLen, 0)
If RetQueryInfo Then
Buffer = Mid$(Buffer, 1, BufLen)
Else
Buffer = ""
End If
End If
End If
End Sub
'Public Function FileSize() As Long
' FileSize = GetHeader("Content-Length")
'End Function
Public Function StartDownLoad() As Boolean
Dim sBuffer(1 To 1024) As Byte, Ret As Long
Dim intfile As Long, LBR As Long
Dim i As Long
If mvarConnect = False Then
Cancel
StartDownLoad = False
Exit Function
End If
On Error GoTo OutErr
Err.Clear
'If Dir$(mvarSaveFile) > " " Then
' Name mvarSaveFile As mvarSaveFile & ".bak"
'End If
If Len(Dir$(mvarSaveFile)) > 0 Then
If MsgBox("目标文件以存在是否覆盖!", vbInformation + vbYesNo, "提示") = vbNo Then
Cancel
StartDownLoad = False
Exit Function
End If
End If
intfile = FreeFile()
Open mvarSaveFile For Binary Access Write As #intfile
Do
InternetReadFile hFile, sBuffer(1), 1024, Ret
DoEvents
If Ret = 1024 Then
If mvarConnect = False Then
StartDownLoad = False
GoTo Quit
End If
Put #1, , sBuffer
Else
For i = 1 To Ret
Put #1, , sBuffer(i)
DoEvents
Next i
End If
LBR = LBR + Ret
RaiseEvent GetData(LBR)
DoEvents
Loop Until Ret < 1024
RaiseEvent DownLoadOver
Quit:
Close #intfile
'if Dir$(mvarSaveFile & ".bak") > " " Then
' Kill mvarSaveFile
' Name mvarSaveFile & ".bak" As mvarSaveFile
'End If
Cancel
Exit Function
OutErr:
Err.Clear
Cancel
Close #intfile
RaiseEvent ErrMassage("文件" & mvarSaveFile & "正在使用,无法进行操作")
On Error GoTo 0
End Function
Public Sub Cancel()
mvarConnect = False
InternetCloseHandle hOpen
InternetCloseHandle hFile
End Sub
Public Property Let SaveFile(ByVal FileName As String)
mvarSaveFile = FileName
End Property
Public Property Let URL(ByVal URL As String)
mvarUrl = URL
End Property
Public Function GetHeader(Optional hdrName As String) As String
Dim tmp As Long
Dim tmp2 As String
If mvarConnect = False Then
GetHeader = "0"
Cancel
Exit Function
End If
If Buffer <> "" Then
Select Case UCase$(hdrName)
Case "CONTENT-LENGTH"
tmp = InStr(Buffer, "Content-Length")
tmp2 = Mid$(Buffer, tmp + 16, Len(Buffer))
tmp = InStr(tmp2, Chr$(0))
GetHeader = CStr(Mid$(tmp2, 1, tmp - 1))
Case "CONTENT-TYPE"
tmp = InStr(Buffer, "Content-Type")
tmp2 = Mid$(Buffer, tmp + 14, Len(Buffer))
tmp = InStr(tmp2, Chr$(0))
GetHeader = CStr(Mid$(tmp2, 1, tmp - 1))
Case "DATE"
tmp = InStr(Buffer, "Date")
tmp2 = Mid$(Buffer, tmp + 6, Len(Buffer))
tmp = InStr(tmp2, Chr$(0))
GetHeader = CStr(Mid$(tmp2, 1, tmp - 1))
Case "LAST-MODIFIED"
tmp = InStr(Buffer, "Last-Modified")
tmp2 = Mid$(Buffer, tmp + 15, Len(Buffer))
tmp = InStr(tmp2, Chr$(0))
GetHeader = CStr(Mid$(tmp2, 1, tmp - 1))
Case "SERVER"
tmp = InStr(Buffer, "Server")
tmp2 = Mid$(Buffer, tmp + 8, Len(Buffer))
tmp = InStr(tmp2, Chr$(0))
GetHeader = CStr(Mid$(tmp2, 1, tmp - 1))
Case vbNullString
GetHeader = Buffer
Case Else
GetHeader = "0"
End Select
Else
GetHeader = "0"
End If
End Function
Form1
Option Explicit
Dim WithEvents tg As DownLoad
Dim tmp As Long
Private Sub Form_Load()
Set tg = New DownLoad
T1 = "http://www.test.net/123.ini"
T2 = App.Path & "\123.ini"
Command1.Caption = "下载1"
Command3.Caption = "停止1"
End Sub
Private Sub tg_DownLoadOver()
MsgBox "下载成功！", vbInformation, "提示"
End Sub
Private Sub tg_ErrMassage(Description As String)
'错误信息
MsgBox Description, vbCritical, "错误"
End Sub
Private Sub tg_GetData(Progress As Long)
'Progress返回的是已下载的数据大小
L = Format$(Progress, "###,###") & "/" & Format$(tmp, "###,###")
End Sub
Private Sub Command3_Click()
tg.Cancel
End Sub
Private Sub Command1_Click()
Command1.Enabled = False
tg.URL = T1 '设置下载地址
tg.SaveFile = T2 '下载后的文件存放位置
tg.Execute '连接网络
tmp = CLng(tg.GetHeader("Content-Length")) '获取下载文件大小
tg.StartDownLoad '开始下载
Command1.Enabled = True
End Sub
Top
7 楼43720938（烦烦烦烦）回复于 2006-02-08 17:03:12 得分 0
我有VB.NET版本的,想要联系我 mksoft@126.comTop
8 楼6742（^_^）回复于 2006-02-08 17:37:28 得分 0
我是这样做的：
1、读取本地文件的版本号
2、读取服务器上文件版本号(其实存放在TXT或INI文件中)
3、进行判断是不是进行升级
4、如需要升级，则下载指定的文件到临时目录
5、关闭主程序，在关闭前起动一临时程序，以便将下载到临时文件夹中的文件更换到位(包括注册)
6、关闭临时程序，关闭前起动主程序
相关的原程序就不贴出来了。如果需要CSDN中可以找到，当然我也可贴出共享。
Top
9 楼dnvodcwan（jc.franck）回复于 2006-02-09 15:51:54 得分 0
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
Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
End Function
Private Sub Form_Load()
'example by Matthew Gates (Puff0rz@hotmail.com)
DownloadFile "http://www.aaa.com/aa.ini", "c:\aa.ini"
End Sub
Top
10 楼ZOU_SEAFARER（颓废程序员^_^）回复于 2006-02-09 17:02:00 得分 0
如果我做的话，我就主程序定时理解服务器，判断是否服务器上的版本比本地的新，如果新的话，下载重命名，生成bat文件。
结束自己，给电脑增加计划任务，运行bat。
在bat文件中，删除本地的老版本文件，copy下载的文件，换名字保存到适当目录！运行新文件，删除本身bat文件，okTop
11 楼ZOU_SEAFARER（颓废程序员^_^）回复于 2006-02-09 17:02:47 得分 0
理解该连接，呵呵，打字错了Top
12 楼jpzLove（云步天）回复于 2006-03-10 00:37:57 得分 0
我说一种初学者通用的吧。我经常用的，呵呵
1，写一个主程序，主程序里放一个Webbrowser控件，启动软件后自动连接一个网页，该网页就是软件和版本号。
2，主程序中会自动将Webbrowser控件里的内容转为Text，从text文本中可以得到该服务器软件版本是否与在用的一致了。
3，主程序自动退出时会自动写入版本号，写入ini文件，也就是记入当前软件版本号。
4,如果查是软件版本号不一样的，那就启动一个升级程序，就叫update，中文意思：更新。
5,更新程序就是下载程序了，首先，关闭当前运行的软件，然后下载服务器上的一些更新补丁。下载完后启动新版本，同时删除旧版本的软件。
这就完成了软件自动更新，呼呼，代码太简单，要的随时可以来拿的，我的主页：
http://www.fuyunsoft.com
如果你认为上面的对你有一点的帮助，还请你经常来我主页哦。
如果你支持网址之家，那么就支持我这个吧，不错的：http://www.hao324.com
这可是中华网址门户网站哦，可是又有几个人知道呢？哈哈，呼呼Top
13 楼mndsoft（枕善居(http://www.mndsoft.com/）回复于 2006-03-10 08:26:54 得分 0
http://www.mndsoft.com/blog/blogview.asp?logID=76
http://www.mndsoft.com/blog/blogview.asp?logID=103Top
14 楼jackcaixia（风）回复于 2006-03-10 08:51:52 得分 0
写两个程序，一个是主程序；一个是升级程序（升级程序放在服务器上）；
说明：所有升级任务都由升级程序完成。
1.启动升级程序，升级程序连接到网站，下载新的主程序（当然还包括支持的库文件等）到临时文件夹；
2.升级程序检测旧的主程序是否活动，若活动则关闭旧的主程序（同时记下主程序的状态）；
3.删除旧的主程序，拷贝临时文件夹中的文件到相应的位置，同时注册相应的文件；
4.检查主程序的状态，若状态为活动的，则启动新的主程序；
5.关闭升级程序。
6.祝贺你，升级完成。
下面进行具体的程序编写，需建立三个工程，然后把它们编辑成一个组，三个工程需共用一个模块。
建立工程步骤：
1. 建立工程proMain：打开vb,“新建工程”，选择“标准EXE”, 再给工程中添加模块，并且命名为modCommon，修改
窗体名为frmMain，同时修改工程名为projMain，然后保存到某个文件夹（譬如在桌面建立个文件夹Update），窗体、模
块和工程分别保存为frmMain.frm、modCommon.bas、projMain.vbp；
2. 建立工程projNewMain：点击菜单“文件|新建工程” ，选择“标准EXE”，点击菜单“工程|添加模块”，在弹出的对话框
中选择“现存”标签，定位到Update文件夹，选中modCommon.bas模块。修改窗体名为frmNewMain，同时修改工程名为projNewMain，然后保存到Update文件夹，窗体和工程分别保存为frmNewMain.frm、projNewMain.vbp；
3. 建立工程projUpdate：点击菜单“文件|新建工程” ，选择“标准EXE”，点击菜单“工程|添加模块”，在弹出的对话框中选择“现存”标签，定位到Update文件夹，选中modCommon.bas模块。修改窗体名为frmUpdate，同时修改工程名为projUpdate，然后保存到Update文件夹，窗体和工程分别保存为frmUpdate.frm、projUpdate.vbp；
4. 建立组：在工程projUpdate中，点击菜单“文件|添加工程…”在弹出的对话框中选择“现存”标签，定位到Update文件夹，选择projMain.vbp；重复该动作，选择projNewMain.vbp；保存该组即可；
5. 关闭工程，定位到Update文件夹，然后执行下面的步骤。
各个工程文件中的文件源码：
一、 projMain.vbp工程:
说明：这个是旧的主程序，从来没有进行过升级前的程序。
用记事本打开frmMain.frm文件，copy以下内容到其中：
VERSION 5.00
Begin VB.Form frmMain
Caption = "请点击升级进行程序"
ClientHeight = 1140
ClientLeft = 60
ClientTop = 345
ClientWidth = 4500
LinkTopic = "Form1"
ScaleHeight = 1140
ScaleWidth = 4500
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command1
Caption = "升级"
Height = 525
Left = 1380
TabIndex = 0
Top = 570
Width = 1245
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
option Explicit
' ------------------------------------------
' 升级程序的例子
' 作者: 谢家峰
' 日期: 2003/12/19
'
' 这里是没有升级时的主程序
'
' ------------------------------------------
Private Sub Command1_Click()
Command1.Enabled = False
' 运行更新程序
Shell App.Path & "\update.exe", vbNormalFocus
End Sub
Private Sub Form_Load()
If App.PrevInstance Then End
UpdateIniPath = App.Path & "\Update.ini"
' 记录主程序的名字
WritePrivateProfileString "Main", "Name", App.EXEName, UpdateIniPath
' 记录运行状态
WritePrivateProfileString "Main", "Active", "-1", UpdateIniPath
' 记录更新次数
WritePrivateProfileString "Update", "Num", "0", UpdateIniPath
Me.Caption = App.EXEName
End Sub
Private Sub Form_Unload(Cancel As Integer)
' 记录运行状态
WritePrivateProfileString "Main", "Active", "0", UpdateIniPath
End Sub
用记事本打开modCommon.bas文件，copy以下内容到其中：
Attribute VB_Name = "modCommon"
Option Explicit
' ------------------------------------------
' 升级程序的例子
' 作者: 谢家峰
' 日期: 2003/12/19
'
' 这里是通用模块，放置API函数以及公用函数
'
' ------------------------------------------
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal lSize As Long, ByVal lpFilename As String) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As Any, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFilename As String) As Long
Public Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFilename As String) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const WM_Close = &H10
Private Const gintMAX_SIZE% = 255 'Maximum buffer size
Public UpdateIniPath As String
' ===============================================
' 从资源文件中提取文件
'
' ===============================================
Public Function SaveFileFromRes(vntResourceID As Variant, sType As String, sFileName As String) As Boolean
Dim bytImage() As Byte
Dim iFileNum As Integer
On Error GoTo SaveFileFromRes_Err
SaveFileFromRes = True
bytImage = LoadResData(vntResourceID, sType)
iFileNum = FreeFile
Open sFileName For Binary As iFileNum
Put #iFileNum, , bytImage
Close iFileNum
Exit Function
SaveFileFromRes_Err:
SaveFileFromRes = False: Exit Function
End Function
' ===============================================
' 从缓冲区中读取字符串
'
' ===============================================
Private Function StringFromBuffer(Buffer As String) As String
Dim nPos As Long
nPos = InStr(Buffer, vbNullChar)
If nPos > 0 Then
StringFromBuffer = Left$(Buffer, nPos - 1)
Else
StringFromBuffer = Buffer
End If
End Function
' ===============================================
' 读Ini文件
'
' ===============================================
Public Function ReadIniFile(ByVal strIniFile As String, ByVal strSection As String, ByVal strKey As String, Optional ByVal strKeyDefault As String = vbNullString) As String
Dim strBuffer As String
strBuffer = Space$(gintMAX_SIZE)
If GetPrivateProfileString(strSection, strKey, strKeyDefault, strBuffer, gintMAX_SIZE, strIniFile) Then
ReadIniFile = StringFromBuffer(strBuffer)
End If
End Function
' 检查文件是否存在
Function FileExists(filename As String) As Boolean
On Error Resume Next
FileExists = (Dir$(filename) <> "")
End Function
' 改变标签的文本及位置
Public Function ChangeLabelPos(frm As Form, lbl As Label, msg As String)
With lbl
.Caption = msg
.Left = (frm.ScaleWidth - .Width) / 2
.Top = .Height / 2
End With
End Function
'关闭窗体
Function CloseValidForm(Ret As String) As Boolean
Dim WinWnd As Long
'搜寻该窗口的句柄
WinWnd = FindWindow(vbNullString, Ret)
If WinWnd <> 0 Then
SendMessage WinWnd, WM_Close, 0&, 0&
End If
CloseValidForm = True
End Function
Top
15 楼jackcaixia（风）回复于 2006-03-10 08:52:09 得分 0
二、 projNewMain.vbp工程:
说明：这个是新的主程序，即升级后的主程序，由于我目前没有服务器，故将该程序放在projUpdate.vbp工程的资源文件中。在projUpdate.vbp中模拟网络升级。
用记事本打开frmNewMain.frm文件，copy以下内容到其中：
VERSION 5.00
Begin VB.Form frmNewMain
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Form1"
ClientHeight = 1365
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 1365
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command1
Caption = "升级"
Height = 525
Left = 1410
TabIndex = 0
Top = 660
Width = 1245
End
Begin VB.Label lblCap
Caption = "告诉你，我已经升级了，没看出和以前不一样了吗？"
Height = 255
Left = 120
TabIndex = 1
Top = 60
Width = 4275
End
End
Attribute VB_Name = "frmNewMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' ------------------------------------------
' 升级程序的例子
' 作者: 谢家峰
' 日期: 2003/12/19
'
' 这里是升级后的主程序
'
' ------------------------------------------
Private Sub Command1_Click()
Command1.Enabled = False
' 运行更新程序
Shell App.Path & "\update.exe", vbNormalFocus
End Sub
Private Sub Form_Load()
Dim i As Integer
If App.PrevInstance Then End
UpdateIniPath = App.Path & "\Update.ini"
' 记录主程序的名字
WritePrivateProfileString "Main", "Name", App.EXEName, UpdateIniPath
' 记录运行状态
WritePrivateProfileString "Main", "Active", "-1", UpdateIniPath
Me.Caption = App.EXEName
End Sub
Private Sub Form_Unload(Cancel As Integer)
' 记录运行状态
WritePrivateProfileString "Main", "Active", "0", UpdateIniPath
End Sub
三、 projUpdate.vbp工程:
说明：这是升级程序，含有一个资源文件。
用记事本打开frmUpdate.frm文件，copy以下内容到其中：
VERSION 5.00
Begin VB.Form frmUpdate
BackColor = &H80000007&
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 1185
ClientLeft = 0
ClientTop = 0
ClientWidth = 5400
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1185
ScaleWidth = 5400
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command1
Appearance = 0 'Flat
Caption = "关闭"
Height = 435
Left = 2130
TabIndex = 0
Top = 630
Visible = 0 'False
Width = 1245
End
Begin VB.Label lblCap
AutoSize = -1 'True
BackStyle = 0 'Transparent
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 240
Left = 330
TabIndex = 1
Top = 150
Width = 120
End
Begin VB.Shape Shape1
BackColor = &H00C0FFFF&
BackStyle = 1 'Opaque
BorderColor = &H0000FF00&
Height = 1065
Left = 60
Top = 60
Width = 5265
End
End
Attribute VB_Name = "frmUpdate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' ------------------------------------------
' 升级程序的例子
' 作者: 谢家峰
' 日期: 2003/12/19
'
' 这里是升级程序
'
' ------------------------------------------
Dim State As Boolean
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Activate()
Dim i As Integer
Dim j As String
Dim OldExeFile As String
Dim NewExeFile As String
Dim tmpFile As String
Dim MainState As Boolean
DoEvents
If State Then
' 获取旧主程序名称
OldExeFile = CStr(ReadIniFile(UpdateIniPath, "Main", "Name", "主程序"))
NewExeFile = OldExeFile
OldExeFile = App.Path & "\" & OldExeFile & ".exe"
tmpFile = App.Path & "\tmp.tmp"
' 改写升级次数
i = CInt(ReadIniFile(UpdateIniPath, "Update", "Num", "0"))
i = i + 1
ChangeLabelPos Me, lblCap, "这是您第" & i & "次升级！"
Sleep 1500
' 摸拟从网站下载新的更新程序。
ChangeLabelPos Me, lblCap, "正在 摸拟从网站下载新的升级程序 ..."
Sleep 1000
On Error Resume Next
Kill tmpFile
' 此处可以修改为将临时文件放在临时文件夹内
SaveFileFromRes 101, "CUSTOM", tmpFile
Sleep 1000
On Error GoTo 0
' 检查主程序是否开启，若开启则关闭旧程序
MainState = CBool(CInt(ReadIniFile(UpdateIniPath, "Main", "Active", "0")))
If MainState Then
' 关闭旧程序
ChangeLabelPos Me, lblCap, "正在关闭旧程序 ... "
Sleep 300
' 这里强行关闭旧程序
' 你也可以发送消息，让旧程序自己关闭
Do While -1
DoEvents
If CloseValidForm(NewExeFile) Then
Exit Do
End If
Loop
Sleep 200
End If
' 删除旧程序
On Error Resume Next
ChangeLabelPos Me, lblCap, "正在删除旧程序 ... "
Sleep 1000
Kill OldExeFile
Sleep 1000
' 生成新主程序名称
' NewExeFile = CStr(ReadIniFile(UpdateIniPath, "Main", "Name", "主程序"))
j = Right(NewExeFile, 1)
If IsNumeric(j) Then
j = i
NewExeFile = Left(NewExeFile, Len(NewExeFile) - 1)
Else
j = 1
End If
' 记录主程序的名字
NewExeFile = NewExeFile & j
WritePrivateProfileString "Main", "Name", NewExeFile, UpdateIniPath
NewExeFile = App.Path & "\" & NewExeFile & ".exe"
' 拷贝新程序
ChangeLabelPos Me, lblCap, "正在更新程序 ... "
Sleep 1000
FileCopy tmpFile, NewExeFile
Sleep 1000
' 删除临时程序
Kill tmpFile
' 记录更新次数
WritePrivateProfileString "Update", "Num", CStr(i), UpdateIniPath
' 检查旧程序的状态
If MainState Then
ChangeLabelPos Me, lblCap, "正在启动更新后的主程序 ... "
Sleep 1000
Shell NewExeFile, vbNormalNoFocus
End If
' 关闭更新程序
Command1.Visible = True
ChangeLabelPos Me, lblCap, "更新完成，请等待 3 秒后将自动关闭更新程序 ..."
Sleep 3000
lblCap.Refresh
Unload Me
End If
End Sub
Private Sub Form_Load()
If App.PrevInstance Then End
UpdateIniPath = App.Path & "\Update.ini"
State = True
End Sub
完成了三个工程的代码拷贝，在代码的必要之处我都进行了详细注释，这里我就不再介绍代码了，现在进行最后一步，模拟从网站下载升级后的程序。
a. 打开projMain.vbp，编译该工程，并且命名为“主程序.exe”；
b. 打开projNewMain.vbp，编译该工程，并且命名为“projNewMain.exe”；
c. 打开projUpdate.vbp，打开工具栏上的“vb资源编辑器”（若没找到，读者需要点击菜单“外接程序|外接程序管理器”，在打开的对话框中选择“vb6资源编辑器”，在加载行为中选择“加载/卸载”复选框），在资源编辑器中选择“添加自定义资源 …”，在打开的对话框中定位到Update文件夹，选择projNewMain.exe文件，保存该资源文件，最后编译该工程并且命名为“Update.exe”。
d. 将可执行文件“主程序.exe”、“Update.exe”拷贝到同一个文件夹中，运行任一个程序，相信读者会看到效果。
以上代码比较简单，仅供读者分析思路用。在实际工程中的代码编写时也根本没必要把projNewMain.exe放在资源文件中，读者只需将它放在服务器的某个位置，然后在projUpdate.vbp中的相应处写下载代码即可。Top
16 楼dingrj（乐天(Ver 2006)）回复于 2006-03-11 10:43:03 得分 0
upTop
17 楼tjs1688（tangjingsong）回复于 2006-03-15 00:51:33 得分 0
我已经完成了FTP下载，试试看智能升级。Top
18 楼cool_man（土豆）回复于 2006-03-15 08:12:16 得分 0
不知道有没有更好的升级方法，学习中。。。Top
