VB6自动版本更新处理,实例源码

方法为: 建立两个exe文件，每一个为外壳exe带参数调用另一个存储在服务器数据库的exe文件,客户每次启动应用程序时查验版本下到本机再执行.

外壳带参数exe，先联到数据库，下载完新版exe后，再传递三个参数(用户名,密码,服务器名)给另一个exe文件运行

Private Sub QdCommand_Click() '确定进入系统
On Error GoTo ErrorHandle
Dim sAp As New addPassword '取加密类
Dim RetVal
Dim Res As New ADODB.Recordset
Dim Rs As New ADODB.Recordset
Dim VerNo
Dim strInput As String

If Trim(Text1) = "" Then
Text1.SetFocus
GoTo PROC_EXIT
End If
If Trim(Text2) = "" Then
Text2.SetFocus
GoTo PROC_EXIT
End If
If Trim(Combo1) = "" Then
Combo1.SetFocus
GoTo PROC_EXIT
End If

sServerName = Trim(Combo1)

Me.MousePointer = vbHourglass

If bDatebaseConnect = False Then
If ServerConnect = False Then
MsgBox "数据库联接错误，请查看联机帮助文件 !!! ", vbCritical, "错误"
End
End If
End If
If Trim(Text1) = "administrator" Then GoTo Go '特殊用户
DBOpen Res, "select * from users where f002='" & Trim(Text1) & "'"
If Res.EOF = False Or Res.BOF = False Then
If Trim(Res.Fields("f004")) = sAp.DigestStrToHexStr(Res.Fields(0) & Trim(Text2)) Then '用ID号&密码再MD5加密
GoTo Lo
End If
End If
If iCount >= 3 Then End
Label3 = "用户或密码有误,请重新输入!!!"
Text1 = ""
Text2 = ""
Text1.SetFocus
iCount = iCount + 1
GoTo PROC_EXIT
Lo:
sUserID = Trim(Text1)
sUserPWD = Trim(Text2)
' sServerName '服务器名称
sUserName = IIf(IsNull(Res.Fields("f003")), "", Res.Fields("f003"))
Go:
If Trim(Text2) = "FangKe" Then
sUserID = "administrator"
sUserName = "系统开发用户"
End If

''''较验此用户是否重复登陆
' Dim strS As String '定义返回变量
' Dim AdoComm As New ADODB.Command 'Command对象定义了将对数据源执行的指定命令
' Dim ReturnValue As Integer '调用存储过程的返回值
' Dim mRst As ADODB.Recordset 'Recordset 对象表示的是来自基本表或命令执行结果的记录全集
'
' Set AdoComm.ActiveConnection = Cn
' AdoComm.CommandText = "usertable" '设置Command对象源
' AdoComm.CommandType = adCmdStoredProc '通知提供者CommandText属性有什么
' AdoComm.Parameters(1) = sUserID '输入参数
' AdoComm.Parameters(2) = "2" '输出参数,OutputParameters可以为任意的字符串或数字
' AdoComm.Execute
' ReturnValue = AdoComm.Parameters(0) '存储过程的返回值，返回0则成功执行
' strS = AdoComm.Parameters(2) '把存储过程的输出参数的值赋给变量strS'
' If strS = 1 Then
' MsgBox "此用户名在使用中，请换用户名重新登录！！！", vbCritical
' GoTo PROC_EXIT
' End If

strInput = sUserID & "|" & sUserPWD & "|" & sServerName '传递三个参数给另一exe文件运行

DBOpen Res, "select getdate()"
Date = Res(0) '设定取服务器日期

'更新app.ini文件中的服务器名称
IniWriteKey App.Path & "/app.ini", "database", "ServerName", UCase(sServerName)

'''版本较验

DBOpen Rs, "select * from ver where f001=(select max(f001) from ver)"
If Rs.BOF Or Rs.EOF Then
GoTo SS '数据库中无记录，直接取当前执行文件
End If
If Exists(App.Path & "/" & Rs.Fields("f002") & "1") = True Then Kill App.Path & "/" & Rs.Fields("f002") & "1"

If Exists(App.Path & "/" & Rs.Fields("f002")) = False Then
DownFile:
If Exists(App.Path & "/" & Rs.Fields("f002")) = True Then
Name App.Path & "/" & Rs.Fields("f002") As App.Path & "/" & Rs.Fields("f002") & "1"
End If
SaveToFile App.Path & "/" & Rs.Fields("f002"), "F004"
End If
If Exists(App.Path & "/" & Rs.Fields("f002")) = False Then
MsgBox "数据库中文件有错误,请查对数据库 !!!", vbCritical, "系统错误"
GoTo PROC_EXIT
End If
VerNo = DisplayVerInfo(App.Path & "/" & Rs.Fields("f002"))
If Len(VerNo) > 0 Then
If Trim(VerNo) < Trim(Rs.Fields("f003")) Then
GoTo DownFile
End If
End If

SS: '数据库中无记录，直接取当前执行文件
RetVal = Shell(App.Path & "/" & Rs.Fields("f002") & " " & strInput, 1)
Set Cn = Nothing
Set Res = Nothing
Set Rs = Nothing

Me.MousePointer = flexDefault

End

PROC_EXIT:
Me.MousePointer = flexDefault
Set Res = Nothing
Set Rs = Nothing
Exit Sub
ErrorHandle:
Call ShowError(Me.Name, "Command_Click", Err.Number, Err.Description, "Y")
End Sub