网站首页 > 书籍教程 > ASP教程 > ASP在线升级类

ASP在线升级类

作者：互联网
时间：2009-06-26 18:09:15

<%
Rem #####################################################################################
Rem ## 在线升级类声明
Class Cls_oUpdate
Rem #################################################################
Rem ## 描述: ASP 在线升级类
Rem ## 版本: 1.0.0
Rem ## 作者: 萧月痕
Rem ## MSN: xiaoyuehen(at)msn.com
Rem ## 请将(at)以 @ 替换
Rem ## 版权: 既然共享, 就无所谓版权了. 但必须限于网络传播, 不得用于传统媒体!
Rem ## 如果您能保留这些说明信息, 本人更加感谢!
Rem ## 如果您有更好的代码优化, 相关改进, 请记得告诉我, 非常谢谢!
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 ## 版本信息完整URL, 以 http:// 起头
   Rem ## 例: http://localhost/software/Version.htm
   UrlVersion     = ""

   Rem ## 升级URL, 以 http:// 起头, /结尾
   Rem ## 例: http://localhost/software/
   UrlUpdate     = ""

   Rem ## 本地更新目录, 以 / 起头, /结尾. 以 / 起头是为当前站点更新.防止写到其他目录.
   Rem ## 程序将检测目录是否存在, 不存在则自动创建
   UpdateLocalPath = "/"

   Rem ## 生成的软件历史文件
   UrlHistory     = "hi***ry.htm"

   Rem ## 最后的提示信息
   Info        = ""

   Rem ## 当前版本
   LocalVersion    = "1.0.0"

   Rem ## 最新版本
   LastVersion    = "1.0.0"

   Rem ## 各版本信息文件后缀名
   FileType      = ".asp"
End Sub
Rem #################################################################

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

End Sub
Rem #################################################################
Rem ## 执行升级动作
Rem #################################################################
Public function doUpdate()
   doUpdate = False

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

   Rem ## 升级网址检测
   If (Left(UrlVersion, 7) <> "http://" SRC="https://images.downcodes.comsmile/05.gif"> Or (Left(UrlUpdate, 7) <> "http://" SRC="https://images.downcodes.comsmile/05.gif"> Then
    Info = "版本检测网址为空, 升级网址为空或格式错误(#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 ## 当前版本信息(数字)
   sstrLocalVersion = LocalVersion
   sintLocalVersion = Replace(sstrLocalVersion, ".", ""

, 0)

    Rem ## 若将更新的版本小于当前版本, 则退出更新
    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 ## 更新当前版本号
    sintLocalVersion = intVer
    sstrLocalVersion = strVer

    Dim i, arrTmp
    Rem ## 获取更新文件列表
    arrFileList = Split(strFileListContent, vbCrLf)

    Rem ## 更新日志
    sstrLogContent = ""
    sstrLogContent = sstrLogContent & strVer & ":" & vbCrLf

    Rem ## 开始更新
    For i = 0 to UBound(arrFileList)
     Rem ## 更新格式: 版本号/文件.htm|目的文件
     arrTmp = Split(arrFileList(i), "|"

     sstrLogContent = sstrLogContent & vbTab & arrTmp(1)
     Call doUpdateFile(intVer & "/" & arrTmp(0), arrTmp(1))
    Next

    Rem ## 写入日志文件
    sstrLogContent = sstrLogContent & Now() & vbCrLf
    re***nse.Write("

" & sstrLogContent & "

Call sDoCreateFile(Se***r.MapPath(sstrUrlLocal & "Log" & intVer & ".htm"

, _ "

" & sstrLogContent & "

Call sDoAppendFile(Se***r.MapPath(sstrUrlLocal & UrlHistory), "

" & _                                          strVer & "_______" & Now() & "

" & vbCrLf)
   End function
Rem #################################################################

Rem ## 更新文件
Rem #################################################################
   Private function doUpdateFile(strSourceFile, strTargetFile)
    Dim strContent
    strContent = GetContent(sstrUrlUpdate & strSourceFile)

    Rem ## 更新并写入日志
    If sDoCreateFile(Se***r.MapPath(sstrUrlLocal & strTargetFile), strContent) Then
     sstrLogContent = sstrLogContent & " 成功" & vbCrLf
    Else
     sstrLogContent = sstrLogContent & " 失败" & vbCrLf
    End If
   End function
Rem #################################################################
Rem ## 远程获得内容
Rem #################################################################
   Private function GetContent(strUrl)
    GetContent = ""

    Dim oXhttp, strContent
    Set oXhttp = Se***r.CreateObject("Mi***soft.XMLHTTP"

    '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 Er***umber <> 0 Then
     re***nse.Write(Er***escription)
     Er***lear
     Exit function
    End If

    GetContent = strContent
   End function
Rem #################################################################
Rem #################################################################
Rem ## 编码转换 2进制 => 字符串
   Private function sBytesToBstr(vIn)
    dim objStream
    set objStream = Se***r.CreateObject("ad***.stream"

    ob***ream.Type ;   = 1
    ob***ream.Mode ;   = 3
    ob***ream.Open
    ob***ream.Write vIn

    ob***ream.Position ; = 0
    ob***ream.Type ;   = 2
    ob***ream.Charset ; = "GB2312"
    sBytesToBstr     = ob***ream.ReadText
    ob***ream.Close
    set objStream    = nothing
   End function
Rem #################################################################
Rem #################################################################
Rem ## 编码转换 2进制 => 字符串
   Private function sDoCreateFile(strFileName, ByRef strContent)
    sDoCreateFile = False
    Dim strPath
    strPath = Left(strFileName, InstrRev(strFileName, "", -1, 1))
    Rem ## 检测路径及文件名有效性
    If Not(CreateDir(strPath)) Then Exit function
    'If Not(CheckFileName(strFileName)) Then Exit function

    're***nse.Write(strFileName)
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim fso, f
    Set fso = CreateObject("Sc***ting.FileSystemObject"

    Set f = fs***penTextFile(strFileName, ForWriting, True)
    f.Write strContent
    f.Close
    Set fso = nothing
    Set f = nothing
    sDoCreateFile = True
   End function
Rem #################################################################
Rem #################################################################
Rem ## 编码转换 2进制 => 字符串
   Private function sDoAppendFile(strFileName, ByRef strContent)
    sDoAppendFile = False
    Dim strPath
    strPath = Left(strFileName, InstrRev(strFileName, "", -1, 1))
    Rem ## 检测路径及文件名有效性
    If Not(CreateDir(strPath)) Then Exit function
    'If Not(CheckFileName(strFileName)) Then Exit function

    're***nse.Write(strFileName)
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim fso, f
    Set fso = CreateObject("Sc***ting.FileSystemObject"

    Set f = fs***penTextFile(strFileName, ForAppending, True)
    f.Write strContent
    f.Close
    Set fso = nothing
    Set f = nothing
    sDoAppendFile = True
   End function
Rem #################################################################
Rem ## 建立目录的程序，如果有多级目录，则一级一级的创建
Rem #################################################################
   Private function CreateDir(ByVal strLocalPath)
    Dim i, strPath, objFolder, tmpPath, tmptPath
    Dim arrPathList, intLevel

    'On Error Resume Next
    strPath     = Replace(strLocalPath, "", "/"

Set objFolder = se***r.CreateObject("Sc***ting.FileSystemObject"

arrPathList = Split(strPath, "/"

    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 ob***lder.FolderExists(tmpPath) Then ob***lder.CreateFolder tmpPath
    Next

    Set objFolder = Nothing
    If Er***umber <> 0 Then
     CreateDir = False
     Er***lear
    Else
     CreateDir = True
    End If
   End function
Rem #################################################################
Rem ## 长整数转换
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 #####################################################################################
%>

上一篇：缓存的应用,调用速度要比每次都要从数据库中读要快N陪

下一篇： ASP写的汉字转换UTF-8及UTF-8转GB2312

ASP在线升级类

相关阅读

最新文章

人气下载推荐

相关应用

热门文章

推荐游戏