Home>Network programming tutorial>ASP tutorial

ASP online upgrade class

Author：Eve Cole Update Time：2009-06-26 18:09:15
<%
Rem ############################################### ####################################
Rem ## Online upgrade class statement
Class Cls_oUpdate
Rem ############################################### ################
Rem ## Description: ASP online upgrade class
Rem ## Version: 1.0.0
Rem ## Author: Xiao Yuehen
Rem ## MSN: xiaoyuehen(at)msn.com
Rem ## Please replace (at) with @
Rem ## Copyright: Since it is shared, there is no copyright. But it must be limited to online dissemination and cannot be used in traditional media!
Rem ## If you can keep these instructions, I would be even more grateful!
Rem ## If you have better code optimization and related improvements, please remember to tell me, thank you very much!
Rem ############################################### ################
Public LocalVersion, LastVersion, FileType
Public UrlVersion, UrlUpdate, UpdateLocalPath, Info
Public UrlHistory
Private sstrVersionList, sarrVersionList, sintLocalVersion, sstrLocalVersion
Private sstrLogContent, sstrHistoryContent, sstrUrlUpdate, sstrUrlLocal
Rem ############################################### ################
Private Sub Class_Initialize()
Rem ## Complete URL of version information, starting with http://
Rem ## Example: http://localhost/software/Version.htm
UrlVersion = ""

Rem ## Upgrade URL, starting with http:// and ending with /
Rem ## Example: http://localhost/software/
UrlUpdate = ""

Rem ## Local update directory, starting with / and ending with /. Starting with / is for updating the current site. Prevent writing to other directories.
Rem ## The program will check whether the directory exists. If it does not exist, it will be created automatically.
UpdateLocalPath = "/"

Rem ## Generated software history file
UrlHistory = "history.htm"

Rem ## Last prompt message
Info = ""

Rem ## Current version
LocalVersion = "1.0.0"

Rem ## latest version
LastVersion = "1.0.0"

Rem ## The suffix name of each version information file
FileType = ".asp"
End Sub
Rem ############################################### ################

Rem ############################################### ################
Private Sub Class_Terminate()

End Sub
Rem ############################################### ################
Rem ## Perform upgrade action
Rem ############################################### ################
Public function doUpdate()
doUpdate = False

UrlVersion = Trim(UrlVersion)
UrlUpdate = Trim(UrlUpdate)

Rem ## Upgrade URL detection
If (Left(UrlVersion, 7) <> " http://"<IMG SRC="smile/05.gif"> Or (Left(UrlUpdate, 7) <> " http://"<IMG SRC="smile /05.gif">Then
Info = "The version detection URL is empty, the upgrade URL is empty or has the wrong format (#1)"
Exit function
End If

If Right(UrlUpdate, 1) <> "/" Then
sstrUrlUpdate = UrlUpdate & "/"
Else
sstrUrlUpdate = UrlUpdate
End If

If Right(UpdateLocalPath, 1) <> "/" Then
sstrUrlLocal = UpdateLocalPath & "/"
Else
sstrUrlLocal = UpdateLocalPath
End If

Rem ## Current version information (number)
sstrLocalVersion = LocalVersion
sintLocalVersion = Replace(sstrLocalVersion, ".", ""<IMG SRC="smile/05.gif">
sintLocalVersion = toNum(sintLocalVersion, 0)

Rem ## Version detection (initialize version information and compare)
If IsLastVersion Then Exit function

Rem ## Start upgrading
doUpdate = NowUpdate()
LastVersion = sstrLocalVersion
End function
Rem ############################################### ################

Rem ## Check whether it is the latest version
Rem ############################################### ################
Private function IsLastVersion()
Rem ## Initialize version information (initialize sarrVersionList array)
If iniVersionList Then
Rem ## If successful, compare versions
Dim i
IsLastVersion = True
For i = 0 to UBound(sarrVersionList)
If sarrVersionList(i) > sintLocalVersion Then
Rem ## If there is the latest version, exit the loop
IsLastVersion = False
Info = "Already the latest version!"
Exit For
End If
Next
Else
Rem ## Otherwise return error message
IsLastVersion = True
Info = "Error getting version information!(#2)"
End If
End function
Rem ############################################### ################
Rem ## Check whether it is the latest version
Rem ############################################### ################
Private function iniVersionList()
iniVersionList = False

Dim strVersion
strVersion = getVersionList()

Rem ## If the return value is empty, the initialization fails.
If strVersion = "" Then
Info = "Error......"
Exit function
End If

sstrVersionList = Replace(strVersion, " ", ""<IMG SRC="smile/05.gif">
sarrVersionList = Split(sstrVersionList, vbCrLf)

iniVersionList = True
End function
Rem ############################################### ################
Rem ## Check whether it is the latest version
Rem ############################################### ################
Private function getVersionList()
getVersionList = GetContent(UrlVersion)
End function
Rem ############################################### ################
Rem ## Start updating
Rem ############################################### ################
Private function NowUpdate()
Dim i
For i = UBound(sarrVersionList) to 0 step -1
Call doUpdateVersion(sarrVersionList(i))
Next
Info = "Upgrade completed! <a href=""" & sstrUrlLocal & UrlHistory & """>View</a>"
End function
Rem ############################################### ################

Rem ## Updated version content
Rem ############################################### ################
Private function doUpdateVersion(strVer)
doUpdateVersion = False

Dim intVer
intVer = toNum(Replace(strVer, ".", ""<IMG SRC="smile/05.gif">, 0)

Rem ## If the updated version is smaller than the current version, exit the update
If intVer <= sintLocalVersion Then
Exit function
End If

Dim strFileListContent, arrFileList, strUrlUpdate
strUrlUpdate = sstrUrlUpdate & intVer & FileType

strFileListContent = GetContent(strUrlUpdate)

If strFileListContent = "" Then
Exit function
End If

Rem ## Update the current version number
sintLocalVersion = intVer
sstrLocalVersion = strVer

Dim i, arrTmp
Rem ## Get update file list
arrFileList = Split(strFileListContent, vbCrLf)

Rem ## Update log
sstrLogContent = ""
sstrLogContent = sstrLogContent & strVer & ":" & vbCrLf

Rem ## Start updating
For i = 0 to UBound(arrFileList)
Rem ## Update format: version number/file.htm|destination file
arrTmp = Split(arrFileList(i), "|"<IMG SRC="smile/05.gif">
sstrLogContent = sstrLogContent & vbTab & arrTmp(1)
Call doUpdateFile(intVer & "/" & arrTmp(0), arrTmp(1))
Next

Rem ## Write to log file
sstrLogContent = sstrLogContent & Now() & vbCrLf
response.Write("<pre>" & sstrLogContent & "</pre>"<IMG SRC="smile/05.gif">
Call sDoCreateFile(Server.MapPath(sstrUrlLocal & "Log" & intVer & ".htm"<IMG SRC="smile/05.gif">, _ "<pre>" & sstrLogContent & "</pre>"<IMG SRC ="smile/05.gif">
Call sDoAppendFile(Server.MapPath(sstrUrlLocal & UrlHistory), "<pre>" & _ strVer & "_______" & Now() & "</pre>" & vbCrLf)
End function
Rem ############################################### ################

Rem ## update file
Rem ############################################### ################
Private function doUpdateFile(strSourceFile, strTargetFile)
Dim strContent
strContent = GetContent(sstrUrlUpdate & strSourceFile)

Rem ## Update and write to the log
If sDoCreateFile(Server.MapPath(sstrUrlLocal & strTargetFile), strContent) Then
sstrLogContent = sstrLogContent & "Success" & vbCrLf
Else
sstrLogContent = sstrLogContent & "Failed" & vbCrLf
End If
End function
Rem ############################################### ################
Rem ## Get content remotely
Rem ############################################### ################
Private function GetContent(strUrl)
GetContent = ""

Dim oXhttp, strContent
Set oXhttp = Server.CreateObject("Microsoft.XMLHTTP"<IMG SRC="smile/05.gif">
'On Error Resume Next
With oXhttp
.Open "GET", strUrl, False, "", ""
.Send
If .readystate <> 4 Then Exit function
strContent = .Responsebody

strContent = sBytesToBstr(strContent)
End With

Set oXhttp = Nothing
If Err.Number <> 0 Then
response.Write(Err.Description)
Err.Clear
Exit function
End If

GetContent = strContent
End function
Rem ############################################### ################
Rem ############################################### ################
Rem ## Encoding conversion binary => string
Private function sBytesToBstr(vIn)
dimobjStream
set objStream = Server.CreateObject("adodb.stream"<IMG SRC="smile/05.gif">
objStream.Type = 1
objStream.Mode = 3
objStream.Open
objStream.Write vIn

objStream.Position = 0
objStream.Type = 2
objStream.Charset = "GB2312"
sBytesToBstr = objStream.ReadText
objStream.Close
set objStream = nothing
End function
Rem ############################################### ################
Rem ############################################### ################
Rem ## Encoding conversion binary => string
Private function sDoCreateFile(strFileName, ByRef strContent)
sDoCreateFile = False
Dim strPath
strPath = Left(strFileName, InstrRev(strFileName, "", -1, 1))
Rem ## Check the validity of path and file name
If Not(CreateDir(strPath)) Then Exit function
'If Not(CheckFileName(strFileName)) Then Exit function

'response.Write(strFileName)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif">
Set f = fso.OpenTextFile(strFileName, ForWriting, True)
f.Write strContent
f.Close
Set fso = nothing
Set f = nothing
sDoCreateFile = True
End function
Rem ############################################### ################
Rem ############################################### ################
Rem ## Encoding conversion binary => string
Private function sDoAppendFile(strFileName, ByRef strContent)
sDoAppendFile = False
Dim strPath
strPath = Left(strFileName, InstrRev(strFileName, "", -1, 1))
Rem ## Check the validity of path and file name
If Not(CreateDir(strPath)) Then Exit function
'If Not(CheckFileName(strFileName)) Then Exit function

'response.Write(strFileName)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif">
Set f = fso.OpenTextFile(strFileName, ForAppending, True)
f.Write strContent
f.Close
Set fso = nothing
Set f = nothing
sDoAppendFile = True
End function
Rem ############################################### ################
Rem ## Program to create a directory. If there are multiple levels of directories, create them one by one.
Rem ############################################### ################
Private function CreateDir(ByVal strLocalPath)
Dim i, strPath, objFolder, tmpPath, tmptPath
Dim arrPathList, intLevel

'On Error Resume Next
strPath = Replace(strLocalPath, "", "/"<IMG SRC="smile/05.gif">
Set objFolder = server.CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif">
arrPathList = Split(strPath, "/"<IMG SRC="smile/05.gif">
intLevel = UBound(arrPathList)

For I = 0 To intLevel
If I = 0 Then
tmptPath = arrPathList(0) & "/"
Else
tmptPath = tmptPath & arrPathList(I) & "/"
End If
tmpPath = Left(tmptPath, Len(tmptPath) - 1)
If Not objFolder.FolderExists(tmpPath) Then objFolder.CreateFolder tmpPath
Next

Set objFolder = Nothing
If Err.Number <> 0 Then
CreateDir = False
Err.Clear
Else
CreateDir = True
End If
End function
Rem ############################################### ################
Rem ## long integer conversion
Rem ############################################### ################
Private function toNum(s, default)
If IsNumeric(s) and s <> "" then
toNum = CLng(s)
Else
toNum = default
End If
End function
Rem ############################################### ################
End Class
Rem ############################################### ####################################
%>
Related Articles