Automatic update program with VB6.0

During the company's ERP system development, because of the large number of clients, the software often needs to be modified, it is too troublesome to manually update the client every time. In order not to do such annoying tasks manually, the client can automatically update the program to the latest version, and also use the system anti-virus software and firewall...

 

 

Requirement Analysis:

1. Each time the client runs the system, a new version needs to be updated.

2. There are multiple DLL, ocx, and exe files to be updated and need to be packaged

3. Install and register in the specified directory as required

 

 

Programming Method:

 

 

1. First, an FTP server is required to provide the update package download service.

2. package the program to be installed and use makecab, the built-in cab packaging tool of VB6.0. EXE, write the name of the program file to be installed into *. in DDF, for example, cesupdate. the DDF content is as follows:

. 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. Run makecab. EXE/F "cesupdate. DDF" to package it into update_cn.cab.

4. The package contains an installation configuration file cesupdate.txt, which is used to specify the location where the program is installed. For details, refer to the source code of the setup program in VB6.0. The content of this file is as follows:

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. put update.txt on the FTP server. This file is used to record the version number and service package. You only need to replace the update package every time a program needs to be updated. Modify the version number as follows:

Ver = V1-0-0080 'version
Url = update_cn.cab 'update package

6. Add the following code to the main program to compare the program version number.
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 ("the system obtains a service update package that needs to be updated, the version number is:" & gpackver & vbcrlf & "do you need to update the system? ", 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 encoded ed, 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

Doevents

'Connect to server
Rc = connect (hsock, socketbuffer, Len (socketbuffer ))

If rc = socket_error then
Closesocket hsock
Call endwinsock
Err. Raise vbobjecterror + 1, "cocould 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. Finally, make the automatic update program cesupgrade.exe.

 

This is the most important part of the update program. You need to do the following:
(1) download the FTP server service update package update_cn.cab

(2) decompress the downloaded service update package to the temp directory.

(3) read the installation configuration file cesupdate.txt and copy and install the file to the specified location.

(4) Registration of DLL and OCX files may not be important.

 

Finished