用VB6.0做的自动更新程序

在公司做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, vbNullString, 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, 1, InStr(1, strProxy, ":") - 1)
        intPort = CInt(Mid$(strProxy, InStr(1, 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, "NN") * 60 + Format$(Now, "SS")) And hSock > 0
        'hlblStatus = "Waiting for response from " & tmpHost & "..." & Start - (Format$(Now, "NN") * 60 + Format$(Now, "SS"))
        DoEvents
    Wend
End Sub

7. 最后制做自动更新程序 CESUpgrade.exe

 

这是更新程序最主要的部分,需要做如下几件事情:
(1)下载FTP服务器服务更新包 update_CN.cab

(2)将下载的服务更新包解压到TEMP目录

(3)读取安装配置文件 cesupdate.txt ,并复制安装到指定位置

(4)对DLL,OCX文件注册,这一点可能并不重要

 

完毕

展开阅读全文

没有更多推荐了,返回首页