|
在公司做ERP系统开发时，由于客户端数量大多，软件经常需要修改，每次都去手动更新客户端太麻烦，为了不再去手工做这么烦锁的事情，客户端就可以自动更新程序为最新版本，同时还要通过系统防毒软件和防火墙。。。
需求分析：
1.客户端每次运行系统时有新版本需要更新,要提示更新
2.有多个DLL，OCX，EXE文件需要更新，需要打包
3.要跟据要求安装到指定目录并注册
程序设计方法：
1. 首先，需要安排一台FTP服务器用于提供更新包下载服务
2. 打包需要安装的程序，采用VB6.0自带的CAB打包工具 MAKECAB.EXE ，把需要安装的程序文件名字写入一个 *.DDF 里，例如我做的这个文件 cesupdate.DDF 内容如下：
.OPTION EXPLICIT
.Set Cabinet=off
.Set Compress=off
.Set MaxDiskSize=CDROM
.Set ReservePerCabinetSize=6144
.Set DiskDirectoryTemplate=".."
.Set CompressionType=MSZIP
.Set CompressionLevel=7
.Set CompressionMemory=21
.Set CabinetNameTemplate="update_CN.cab"
.Set Cabinet=on
.Set Compress=on
"prjTest.exe"
"CESUpgrade.exe"
"CESCommon.dll"
"CESToolLib.dll"
"CESTOOL.dll"
"CESQMLib.dll"
"CESQM.dll"
"CESPMLib.dll"
"CESPM.dll"
"CESPLANLib.dll"
"CESPLAN.dll"
"CESBMLib.dll"
"CESBM.dll"
"cesupdate.txt"
3. 运行一个这个命令 MAKECAB.EXE /f "cesupdate.DDF" 就可以打包成 update_CN.cab
4. 打包程序里面包含一个安装配置文件 cesupdate.txt 用于指定程序安装到什么位置，可以参考VB6.0的SETUP程序源码，此文件内容如下：
prjTest.exe,$(APPPATH)
CESUpgrade.exe,$(APPPATH)/Dlls/
CESCommon.dll,$(APPPATH)/Dlls/
CESPLAN.dll,$(APPPATH)/Dlls/
CESPLANLib.dll,$(APPPATH)/Dlls/
CESPM.dll,$(APPPATH)/Dlls/
CESPMLib.dll,$(APPPATH)/Dlls/
CESQM.dll,$(APPPATH)/Dlls/
CESQMLib.dll,$(APPPATH)/Dlls/
CESToolLib.dll,$(APPPATH)/Dlls/
CESTOOL.dll,$(APPPATH)/Dlls/
CESBM.dll,$(APPPATH)/Dlls/
CESBMLib.dll,$(APPPATH)/Dlls/
5. 在FTP服务器里面放上 update.txt,此文件用于记录版本号和服务包，每次有程序需要更新时只需替换更新包，改动这面的版本号就行了，此文件内容如下：
VER=V1-0-0080 ' 版本号
URL=update_CN.cab ‘更新包
6. 在主程序里面加入如下代码用于比较程序版本号
Private Declare Function ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hwnd As Long,ByVal lpOperation As String,ByVal lpFile As String,ByVal lpParameters As String,ByVal lpDirectory As String,ByVal nShowCmd As Long) As Long
'Winsock
Dim hSock As Integer
Dim bBytes As Integer
Dim gPackVer As String
Dim gPackFile As String
Private Sub MDIForm_MouseUp(Button As Integer,Shift As Integer,x As Single,y As Single)
Dim ServerResponse As String
Dim MsgBuffer As String * 8192
Dim a() As String
On Error Resume Next
'A Socket is open
If hSock > 0 Then
'Receive up to 8192 chars
bBytes = recv(hSock,ByVal MsgBuffer,8192,0)
If bBytes > 0 Then
ServerResponse = Mid$(MsgBuffer,1,bBytes)
a = Split(MsgBuffer,Chr(13) & Chr(10))
'Debug.Print a(1)
gPackVer = Trim(Mid(a(0),6))
gPackFile = Trim(Mid(a(1),6))
If gUpdatePackVer <> gPackVer Then
If MsgBox("系统获取到有一个服务更新包需要更新,版本号为:" & gPackVer & vbCrLf & " 您需要更新系统吗?",vbYesNo) = vbYes Then
closesocket (hSock)
Call EndWinsock 'Very important!
hSock = 0
ShellExecute 0,vbNullString,App.Path & "/CESUpgrade.exe ",gPackVer & " " & gPackFile,vbNormalFocus
End
Else
closesocket (hSock)
Call EndWinsock 'Very important!
hSock = 0
End If
End If
'0 Bytes received,close sock to indicate end of receive
ElseIf WSAGetLastError() <> WSAEWOULDBLOCK Then
closesocket (hSock)
Call EndWinsock 'Very important!
hSock = 0
End If
End If
End Sub
Private Sub sbStatus_PanelClick(ByVal Panel As MSComctlLib.Panel)
GetfromInet gUpdatePackUrl & "update.txt"
End Sub
Private Sub GetfromInet(strURL As String,Optional strProxy As String)
Dim SocketBuffer As sockaddr
Dim IpAddr As Long
Dim SlashPos As Integer
Dim strPath As String
Dim strHost As String
Dim tmpHost As String
Dim intPort As Integer
Dim RC As Long
Dim strMsg As String
'Separate URL into Host and Path
SlashPos = InStr(8,strURL,"/")
If SlashPos = 0 Then SlashPos = Len(strURL) + 1
strPath = Mid$(strURL,SlashPos)
If strPath = "" Then strPath = "/"
strHost = Mid$(strURL,8,SlashPos - 8)
If strProxy <> "" Then 'There is a Proxy
tmpHost = "http://" & strHost
strHost = Mid$(strProxy,InStr(1,strProxy,":") - 1)
intPort = CInt(Mid$(strProxy,":") + 1))
Else 'No Proxy
intPort = 80
End If
'Start winsock
Call StartWinsock
'Create socket
hSock = socket(AF_INET,SOCK_STREAM,0)
If hSock = SOCKET_ERROR Then Exit Sub
IpAddr = GetHostByNameAlias(strHost)
If IpAddr = -1 Then
'Err.Raise vbObjectError + 1,"Unknown host"
Exit Sub
End If
With SocketBuffer
.sin_family = AF_INET
.sin_port = htons(intPort)
.sin_addr = IpAddr
.sin_zero = String$(8,0)
End With
DoEvents
'Connect to server
RC = connect(hSock,SocketBuffer,Len(SocketBuffer))
If RC = SOCKET_ERROR Then
closesocket hSock
Call EndWinsock
Err.Raise vbObjectError + 1,"Could not connect to " & strHost
Exit Sub
Else
End If
DoEvents
'Set receive window
RC = WSAAsyncSelect(hSock,Me.hwnd,ByVal &H202,ByVal FD_READ Or FD_CLOSE)
If RC = SOCKET_ERROR Then
closesocket hSock
Call EndWinsock
Exit Sub
End If
'Prepare GET header
'When to use GET? -> When the amount of data that you
'need to pass to the server is not much
strMsg = "GET " & tmpHost & strPath & " HTTP/1.0" & vbCrLf
strMsg = strMsg & "Accept: */*" & vbCrLf
' strMsg = strMsg & "Accept-Language: zh-cn" & vbCrLf
' strMsg = strMsg & "Accept-Encoding: gzip,deflate" & vbCrLf
strMsg = strMsg & "User-Agent: " & App.Title & vbCrLf
strMsg = strMsg & "Host: " & strHost & vbCrLf
strMsg = strMsg & vbCrLf
' lblStatus = "Sending request..."
DoEvents
'Send request
SendData hSock,strMsg
If tmpHost = "" Then tmpHost = strHost
'Wait for page to be downloaded
'Seconds to wait = 10
Dim Start As Integer
Start = (Format$(Now,"NN") * 60 + Format$(Now,"SS")) + 10
While Not Start <= (Format$(Now,"SS")) And hSock > 0
'hlblStatus = "Waiting for response from " & tmpHost & "..." & Start - (Format$(Now,"SS"))
DoEvents
Wend
End Sub
7. 最后制做自动更新程序 CESUpgrade.exe
这是更新程序最主要的部分，需要做如下几件事情：
（1）下载FTP服务器服务更新包 update_CN.cab
（2）将下载的服务更新包解压到TEMP目录
（3）读取安装配置文件 cesupdate.txt ，并复制安装到指定位置
（4）对DLL，OCX文件注册，这一点可能并不重要
完毕 （编辑：李大同）
【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!
|
