悉远

 找回密码
 注册
搜索
查看: 1394|回复: 0

ASP在线升级类

[复制链接]
发表于 2009-6-22 23:26:30 | 显示全部楼层 |阅读模式

  1. <%
  2. Rem #####################################################################################
  3. Rem ## 在线升级类声明
  4. Class Cls_oUpdate
  5.   Rem #################################################################
  6.   Rem ## 描述: ASP 在线升级类
  7.   Rem ## 版本: 1.0.0
  8.   Rem ## 作者: 萧月痕
  9.   Rem ## MSN:  xiaoyuehen(at)msn.com
  10.   Rem ## 请将(at)以 @ 替换
  11.   Rem ## 版权: 既然共享, 就无所谓版权了. 但必须限于网络传播, 不得用于传统媒体!
  12.   Rem ## 如果您能保留这些说明信息, 本人更加感谢!
  13.   Rem ## 如果您有更好的代码优化, 相关改进, 请记得告诉我, 非常谢谢!
  14.   Rem #################################################################
  15.   Public LocalVersion, LastVersion, FileType
  16.   Public UrlVersion, UrlUpdate, UpdateLocalPath, Info
  17.   Public UrlHistory
  18.   Private sstrVersionList, sarrVersionList, sintLocalVersion, sstrLocalVersion
  19.   Private sstrLogContent, sstrHistoryContent, sstrUrlUpdate, sstrUrlLocal
  20.   Rem #################################################################
  21.   Private Sub Class_Initialize()
  22.    Rem ## 版本信息完整URL, 以 http:// 起头
  23.    Rem ## 例: http://localhost/software/Version.htm
  24.    UrlVersion     = ""
  25.    
  26.    Rem ## 升级URL, 以 http:// 起头, /结尾
  27.    Rem ## 例: http://localhost/software/
  28.    UrlUpdate     = ""
  29.    
  30.    Rem ## 本地更新目录, 以 / 起头, /结尾. 以 / 起头是为当前站点更新.防止写到其他目录.
  31.    Rem ## 程序将检测目录是否存在, 不存在则自动创建
  32.    UpdateLocalPath  = "/"
  33.    
  34.    Rem ## 生成的软件历史文件
  35.    UrlHistory     = "history.htm"
  36.    
  37.    Rem ## 最后的提示信息
  38.    Info        = ""
  39.    
  40.    Rem ## 当前版本
  41.    LocalVersion    = "1.0.0"
  42.    
  43.    Rem ## 最新版本
  44.    LastVersion    = "1.0.0"
  45.    
  46.    Rem ## 各版本信息文件后缀名
  47.    FileType      = ".asp"
  48.   End Sub
  49.   Rem #################################################################
  50.   
  51.   Rem #################################################################
  52.   Private Sub Class_Terminate()
  53.   
  54.   End Sub
  55.   Rem #################################################################
  56.   Rem ## 执行升级动作
  57.   Rem #################################################################
  58.   Public function doUpdate()
  59.    doUpdate = False
  60.    
  61.    UrlVersion    = Trim(UrlVersion)
  62.    UrlUpdate    = Trim(UrlUpdate)
  63.    
  64.    Rem ## 升级网址检测
  65.    If (Left(UrlVersion, 7) <> "http://"<IMG SRC="smile/05.gif"> Or (Left(UrlUpdate, 7) <> "http://"<IMG SRC="smile/05.gif"> Then
  66.     Info = "版本检测网址为空, 升级网址为空或格式错误(#1)"
  67.     Exit function
  68.    End If
  69.    
  70.    If Right(UrlUpdate, 1) <> "/" Then
  71.     sstrUrlUpdate = UrlUpdate & "/"
  72.    Else
  73.     sstrUrlUpdate = UrlUpdate
  74.    End If
  75.    
  76.    If Right(UpdateLocalPath, 1) <> "/" Then
  77.     sstrUrlLocal = UpdateLocalPath & "/"
  78.    Else
  79.     sstrUrlLocal = UpdateLocalPath
  80.    End If   
  81.    
  82.    Rem ## 当前版本信息(数字)
  83.    sstrLocalVersion = LocalVersion
  84.    sintLocalVersion = Replace(sstrLocalVersion, ".", ""<IMG SRC="smile/05.gif">
  85.    sintLocalVersion = toNum(sintLocalVersion, 0)
  86.    
  87.    Rem ## 版本检测(初始化版本信息, 并进行比较)
  88.    If IsLastVersion Then Exit function
  89.    
  90.    Rem ## 开始升级
  91.    doUpdate = NowUpdate()
  92.    LastVersion = sstrLocalVersion
  93.   End function
  94.   Rem #################################################################
  95.   
  96.   Rem ## 检测是否为最新版本
  97.   Rem #################################################################
  98.    Private function IsLastVersion()
  99.     Rem ## 初始化版本信息(初始化 sarrVersionList 数组)
  100.     If iniVersionList Then
  101.      Rem ## 若成功, 则比较版本
  102.      Dim i
  103.      IsLastVersion = True
  104.      For i = 0 to UBound(sarrVersionList)
  105.       If sarrVersionList(i) > sintLocalVersion Then
  106.        Rem ## 若有最新版本, 则退出循环
  107.        IsLastVersion = False
  108.        Info = "已经是最新版本!"
  109.        Exit For
  110.       End If
  111.      Next
  112.     Else
  113.      Rem ## 否则返回出错信息
  114.      IsLastVersion = True
  115.      Info = "获取版本信息时出错!(#2)"
  116.     End If   
  117.    End function
  118.   Rem #################################################################
  119.   Rem ## 检测是否为最新版本
  120.   Rem #################################################################
  121.    Private function iniVersionList()
  122.     iniVersionList = False
  123.    
  124.     Dim strVersion
  125.     strVersion = getVersionList()
  126.    
  127.     Rem ## 若返回值为空, 则初始化失败
  128.     If strVersion = "" Then
  129.      Info = "出错......."
  130.      Exit function
  131.     End If
  132.    
  133.     sstrVersionList = Replace(strVersion, " ", ""<IMG SRC="smile/05.gif">
  134.     sarrVersionList = Split(sstrVersionList, vbCrLf)
  135.    
  136.     iniVersionList = True
  137.    End function
  138.   Rem #################################################################
  139.   Rem ## 检测是否为最新版本
  140.   Rem #################################################################
  141.    Private function getVersionList()
  142.     getVersionList = GetContent(UrlVersion)
  143.    End function
  144.   Rem #################################################################
  145.   Rem ## 开始更新
  146.   Rem #################################################################
  147.    Private function NowUpdate()
  148.     Dim i
  149.     For i = UBound(sarrVersionList) to 0 step -1
  150.      Call doUpdateVersion(sarrVersionList(i))
  151.     Next
  152.     Info = "升级完成! <a href=""" & sstrUrlLocal & UrlHistory & """>查看</a>"
  153.    End function
  154.   Rem #################################################################
  155.   
  156.   Rem ## 更新版本内容
  157.   Rem #################################################################
  158.    Private function doUpdateVersion(strVer)
  159.     doUpdateVersion = False
  160.    
  161.     Dim intVer
  162.     intVer = toNum(Replace(strVer, ".", ""<IMG SRC="smile/05.gif">, 0)
  163.    
  164.     Rem ## 若将更新的版本小于当前版本, 则退出更新
  165.     If intVer <= sintLocalVersion Then
  166.      Exit function
  167.     End If
  168.    
  169.     Dim strFileListContent, arrFileList, strUrlUpdate   
  170.     strUrlUpdate = sstrUrlUpdate & intVer & FileType
  171.    
  172.     strFileListContent = GetContent(strUrlUpdate)
  173.    
  174.     If strFileListContent = "" Then
  175.      Exit function
  176.     End If
  177.    
  178.     Rem ## 更新当前版本号
  179.     sintLocalVersion = intVer
  180.     sstrLocalVersion = strVer
  181.    
  182.     Dim i, arrTmp
  183.     Rem ## 获取更新文件列表
  184.     arrFileList = Split(strFileListContent, vbCrLf)
  185.    
  186.     Rem ## 更新日志
  187.     sstrLogContent = ""
  188.     sstrLogContent = sstrLogContent & strVer & ":" & vbCrLf
  189.    
  190.     Rem ## 开始更新
  191.     For i = 0 to UBound(arrFileList)
  192.      Rem ## 更新格式: 版本号/文件.htm|目的文件
  193.      arrTmp = Split(arrFileList(i), "|"<IMG SRC="smile/05.gif">
  194.      sstrLogContent = sstrLogContent & vbTab & arrTmp(1)
  195.      Call doUpdateFile(intVer & "/" & arrTmp(0), arrTmp(1))     
  196.     Next
  197.    
  198.     Rem ## 写入日志文件
  199.     sstrLogContent = sstrLogContent & Now() & vbCrLf
  200.     response.Write("<pre>" & sstrLogContent & "</pre>"<IMG SRC="smile/05.gif">
  201.     Call sDoCreateFile(Server.MapPath(sstrUrlLocal & "Log" & intVer & ".htm"<IMG SRC="smile/05.gif">, _                                          "<pre>" & sstrLogContent & "</pre>"<IMG SRC="smile/05.gif">
  202.     Call sDoAppendFile(Server.MapPath(sstrUrlLocal & UrlHistory), "<pre>" & _                                          strVer & "_______" & Now() & "</pre>" & vbCrLf)
  203.    End function
  204.   Rem #################################################################
  205.   
  206.   Rem ## 更新文件
  207.   Rem #################################################################
  208.    Private function doUpdateFile(strSourceFile, strTargetFile)
  209.     Dim strContent
  210.     strContent = GetContent(sstrUrlUpdate & strSourceFile)
  211.    
  212.     Rem ## 更新并写入日志
  213.     If sDoCreateFile(Server.MapPath(sstrUrlLocal & strTargetFile), strContent) Then     
  214.      sstrLogContent = sstrLogContent & "  成功" & vbCrLf
  215.     Else
  216.      sstrLogContent = sstrLogContent & "  失败" & vbCrLf
  217.     End If
  218.    End function
  219.   Rem #################################################################
  220.   Rem ## 远程获得内容
  221.   Rem #################################################################
  222.    Private function GetContent(strUrl)
  223.     GetContent = ""
  224.    
  225.     Dim oXhttp, strContent
  226.     Set oXhttp = Server.CreateObject("Microsoft.XMLHTTP"<IMG SRC="smile/05.gif">
  227.     'On Error Resume Next
  228.     With oXhttp
  229.      .Open "GET", strUrl, False, "", ""
  230.      .Send
  231.      If .readystate <> 4 Then Exit function
  232.      strContent = .Responsebody
  233.      
  234.      strContent = sBytesToBstr(strContent)
  235.     End With
  236.    
  237.     Set oXhttp = Nothing
  238.     If Err.Number <> 0 Then
  239.      response.Write(Err.Description)
  240.      Err.Clear
  241.      Exit function
  242.     End If
  243.    
  244.     GetContent = strContent
  245.    End function
  246.   Rem #################################################################
  247.   Rem #################################################################
  248.   Rem ## 编码转换 2进制 => 字符串
  249.    Private function sBytesToBstr(vIn)
  250.     dim objStream
  251.     set objStream = Server.CreateObject("adodb.stream"<IMG SRC="smile/05.gif">
  252.     objStream.Type    = 1
  253.     objStream.Mode    = 3
  254.     objStream.Open
  255.     objStream.Write vIn
  256.    
  257.     objStream.Position  = 0
  258.     objStream.Type    = 2
  259.     objStream.Charset  = "GB2312"
  260.     sBytesToBstr     = objStream.ReadText
  261.     objStream.Close
  262.     set objStream    = nothing
  263.    End function
  264.   Rem #################################################################
  265.   Rem #################################################################
  266.   Rem ## 编码转换 2进制 => 字符串
  267.    Private function sDoCreateFile(strFileName, ByRef strContent)
  268.     sDoCreateFile = False
  269.     Dim strPath
  270.     strPath = Left(strFileName, InstrRev(strFileName, "", -1, 1))
  271.     Rem ## 检测路径及文件名有效性
  272.     If Not(CreateDir(strPath)) Then Exit function
  273.     'If Not(CheckFileName(strFileName)) Then Exit function
  274.    
  275.     'response.Write(strFileName)
  276.     Const ForReading = 1, ForWriting = 2, ForAppending = 8
  277.     Dim fso, f
  278.     Set fso = CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif">
  279.     Set f = fso.OpenTextFile(strFileName, ForWriting, True)
  280.     f.Write strContent
  281.     f.Close
  282.     Set fso = nothing
  283.     Set f = nothing
  284.     sDoCreateFile = True
  285.    End function
  286.   Rem #################################################################
  287.   Rem #################################################################
  288.   Rem ## 编码转换 2进制 => 字符串
  289.    Private function sDoAppendFile(strFileName, ByRef strContent)
  290.     sDoAppendFile = False
  291.     Dim strPath
  292.     strPath = Left(strFileName, InstrRev(strFileName, "", -1, 1))
  293.     Rem ## 检测路径及文件名有效性
  294.     If Not(CreateDir(strPath)) Then Exit function
  295.     'If Not(CheckFileName(strFileName)) Then Exit function
  296.    
  297.     'response.Write(strFileName)
  298.     Const ForReading = 1, ForWriting = 2, ForAppending = 8
  299.     Dim fso, f
  300.     Set fso = CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif">
  301.     Set f = fso.OpenTextFile(strFileName, ForAppending, True)
  302.     f.Write strContent
  303.     f.Close
  304.     Set fso = nothing
  305.     Set f = nothing
  306.     sDoAppendFile = True
  307.    End function
  308.   Rem #################################################################
  309.   Rem ## 建立目录的程序,如果有多级目录,则一级一级的创建
  310.   Rem #################################################################
  311.    Private function CreateDir(ByVal strLocalPath)
  312.     Dim i, strPath, objFolder, tmpPath, tmptPath
  313.     Dim arrPathList, intLevel
  314.    
  315.     'On Error Resume Next
  316.     strPath     = Replace(strLocalPath, "", "/"<IMG SRC="smile/05.gif">
  317.     Set objFolder  = server.CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif">
  318.     arrPathList   = Split(strPath, "/"<IMG SRC="smile/05.gif">
  319.     intLevel     = UBound(arrPathList)
  320.    
  321.     For I = 0 To intLevel
  322.      If I = 0 Then
  323.       tmptPath = arrPathList(0) & "/"
  324.      Else
  325.       tmptPath = tmptPath & arrPathList(I) & "/"
  326.      End If
  327.      tmpPath = Left(tmptPath, Len(tmptPath) - 1)
  328.      If Not objFolder.FolderExists(tmpPath) Then objFolder.CreateFolder tmpPath
  329.     Next
  330.    
  331.     Set objFolder = Nothing
  332.     If Err.Number <> 0 Then
  333.      CreateDir = False
  334.      Err.Clear
  335.     Else
  336.      CreateDir = True
  337.     End If
  338.    End function
  339.   Rem #################################################################
  340.   Rem ## 长整数转换
  341.   Rem #################################################################
  342.    Private function toNum(s, default)
  343.     If IsNumeric(s) and s <> "" then
  344.      toNum = CLng(s)
  345.     Else
  346.      toNum = default
  347.     End If
  348.    End function
  349.   Rem #################################################################
  350. End Class
  351. Rem #####################################################################################
  352. %>
  353. 资料引用:http://www.knowsky.com/535960.html
复制代码
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|QQ客服|联系我们|Archiver|手机版|小黑屋|悉远网络 ( 鄂ICP备09013446号 )

GMT+8, 2024-3-29 19:09 , Processed in 0.037197 second(s), 7 queries , Redis On.

Powered by Discuz! X3.5

Copyright © 2001-2023 Tencent Cloud.

快速回复 返回顶部 返回列表