ASP-Online-Upgrade-Klasse
Autor:Eve Cole
Aktualisierungszeit:2009-06-26 18:09:15
<%
Rem ############################################# ################################
Rem ## Online-Upgrade-Klassenanweisung
Klasse Cls_oUpdate
Rem ############################################# ##############
Rem ## Beschreibung: ASP-Online-Upgrade-Klasse
Rem ## Version: 1.0.0
Rem ## Autor: Xiao Yuehen
Rem ## MSN: xiaoyuehen(at)msn.com
Rem ## Bitte ersetzen Sie (at) durch @
Rem ## Urheberrecht: Da es geteilt wird, besteht kein Urheberrecht. Es muss jedoch auf die Online-Verbreitung beschränkt sein und darf nicht in herkömmlichen Medien verwendet werden!
Rem ## Wenn Sie diese Anleitung behalten können, wäre ich noch dankbarer!
Rem ## Wenn Sie eine bessere Codeoptimierung und damit verbundene Verbesserungen haben, denken Sie bitte daran, es mir mitzuteilen. Vielen Dank!
Rem ############################################# ##############
Öffentliche LocalVersion, LastVersion, FileType
Öffentliche UrlVersion, UrlUpdate, UpdateLocalPath, Info
Öffentlicher URL-Verlauf
Private sstrVersionList, sarrVersionList, sintLocalVersion, sstrLocalVersion
Privat sstrLogContent, sstrHistoryContent, sstrUrlUpdate, sstrUrlLocal
Rem ############################################# ##############
Private Sub Class_Initialize()
Rem ## Vollständige URL der Versionsinformationen, beginnend mit http://
Rem ## Beispiel: http://localhost/software/Version.htm
UrlVersion = ""
Rem ## Upgrade-URL, beginnend mit http:// und endend mit /
Rem ## Beispiel: http://localhost/software/
URLUpdate = ""
Rem ## Lokales Update-Verzeichnis, beginnend mit / und endend mit /, dient zum Verhindern des Schreibens in andere Verzeichnisse.
Rem ## Das Programm prüft, ob das Verzeichnis existiert. Wenn es nicht existiert, wird es automatisch erstellt.
UpdateLocalPath = "/"
Rem ## Erstellte Software-Verlaufsdatei
UrlHistory = "history.htm"
Rem ## Letzte Aufforderungsnachricht
Info = ""
Rem ## Aktuelle Version
LocalVersion = „1.0.0“
Rem ## neueste Version
LastVersion = „1.0.0“
Rem ## Der Suffixname jeder Versionsinformationsdatei
FileType = „.asp“
Sub beenden
Rem ############################################# ##############
Rem ############################################# ##############
Private Sub Class_Terminate()
Sub beenden
Rem ############################################# ##############
Rem ## Upgrade-Aktion durchführen
Rem ############################################# ##############
Öffentliche Funktion doUpdate()
doUpdate = Falsch
UrlVersion = Trim(UrlVersion)
UrlUpdate = Trim(UrlUpdate)
Rem ## URL-Erkennung aktualisieren
If (Left(UrlVersion, 7) <> " http://"<IMG SRC="smile/05.gif"> Or (Left(UrlUpdate, 7) <> " http://"<IMG SRC="smile /05.gif">Dann
Info = „Die Versionserkennungs-URL ist leer, die Upgrade-URL ist leer oder hat das falsche Format (#1)“
Exit-Funktion
Ende wenn
Wenn Right(UrlUpdate, 1) <> "/" Dann
sstrUrlUpdate = UrlUpdate & "/"
Anders
sstrUrlUpdate = UrlUpdate
Ende wenn
Wenn Right(UpdateLocalPath, 1) <> "/" Dann
sstrUrlLocal = UpdateLocalPath & "/"
Anders
sstrUrlLocal = UpdateLocalPath
Ende wenn
Rem ## Aktuelle Versionsinformationen (Nummer)
sstrLocalVersion = LocalVersion
sintLocalVersion = Replacement(sstrLocalVersion, ".", ""<IMG SRC="smile/05.gif">
sintLocalVersion = toNum(sintLocalVersion, 0)
Rem ## Versionserkennung (Versionsinformationen initialisieren und vergleichen)
Wenn IsLastVersion, dann Funktion beenden
Rem ## Starten Sie das Upgrade
doUpdate = NowUpdate()
LastVersion = sstrLocalVersion
Funktion beenden
Rem ############################################# ##############
Rem ## Überprüfen Sie, ob es sich um die neueste Version handelt
Rem ############################################# ##############
Private Funktion IsLastVersion()
Rem ## Versionsinformationen initialisieren (sarrVersionList-Array initialisieren)
Wenn iniVersionList Dann
Rem ## Bei Erfolg Versionen vergleichen
Dim ich
IsLastVersion = True
Für i = 0 bis UBound(sarrVersionList)
Wenn sarrVersionList(i) > sintLocalVersion Dann
Rem ## Wenn es die neueste Version gibt, verlassen Sie die Schleife
IsLastVersion = False
Info = „Bereits die neueste Version!“
Ausgang für
Ende wenn
Nächste
Anders
Rem ## Andernfalls wird eine Fehlermeldung zurückgegeben
IsLastVersion = True
Info = „Fehler beim Abrufen der Versionsinformationen!(#2)“
Ende wenn
Funktion beenden
Rem ############################################# ##############
Rem ## Überprüfen Sie, ob es sich um die neueste Version handelt
Rem ############################################# ##############
Private Funktion iniVersionList()
iniVersionList = False
Dimmen Sie strVersion
strVersion = getVersionList()
Rem ## Wenn der Rückgabewert leer ist, schlägt die Initialisierung fehl.
Wenn strVersion = "" Dann
Info = „Fehler......“
Exit-Funktion
Ende wenn
sstrVersionList = Replacement(strVersion, " ", ""<IMG SRC="smile/05.gif">
sarrVersionList = Split(sstrVersionList, vbCrLf)
iniVersionList = True
Funktion beenden
Rem ############################################# ##############
Rem ## Überprüfen Sie, ob es sich um die neueste Version handelt
Rem ############################################# ##############
Private Funktion getVersionList()
getVersionList = GetContent(UrlVersion)
Funktion beenden
Rem ############################################# ##############
Rem ## Starten Sie die Aktualisierung
Rem ############################################# ##############
Private Funktion NowUpdate()
Dim ich
Für i = UBound(sarrVersionList) bis 0 Schritt -1
Rufen Sie doUpdateVersion(sarrVersionList(i)) auf.
Nächste
Info = „Upgrade abgeschlossen! <a href=""" & sstrUrlLocal & UrlHistory & """>Anzeigen</a>"
Funktion beenden
Rem ############################################# ##############
Rem ## Aktualisierter Versionsinhalt
Rem ############################################# ##############
Private Funktion doUpdateVersion(strVer)
doUpdateVersion = False
Dim intVer
intVer = toNum(Replace(strVer, ".", ""<IMG SRC="smile/05.gif">, 0)
Rem ## Wenn die aktualisierte Version kleiner als die aktuelle Version ist, beenden Sie das Update
Wenn intVer <= sintLocalVersion Dann
Exit-Funktion
Ende wenn
Dimmen Sie strFileListContent, arrFileList, strUrlUpdate
strUrlUpdate = sstrUrlUpdate & intVer & FileType
strFileListContent = GetContent(strUrlUpdate)
Wenn strFileListContent = "" Dann
Exit-Funktion
Ende wenn
Rem ## Aktualisiert die aktuelle Versionsnummer
sintLocalVersion = intVer
sstrLocalVersion = strVer
Dim i, arrTmp
Rem ## Update-Dateiliste abrufen
arrFileList = Split(strFileListContent, vbCrLf)
Rem ## Protokoll aktualisieren
sstrLogContent = ""
sstrLogContent = sstrLogContent & strVer & ":" & vbCrLf
Rem ## Starten Sie die Aktualisierung
Für i = 0 bis UBound(arrFileList)
Rem ## Update-Format: Versionsnummer/Datei.htm|Zieldatei
arrTmp = Split(arrFileList(i), "|"<IMG SRC="smile/05.gif">
sstrLogContent = sstrLogContent & vbTab & arrTmp(1)
Rufen Sie doUpdateFile(intVer & "/" & arrTmp(0), arrTmp(1)) auf.
Nächste
Rem ## In Protokolldatei schreiben
sstrLogContent = sstrLogContent & Now() & vbCrLf
Response.Write("<pre>" & sstrLogContent & "</pre>"<IMG SRC="smile/05.gif">
Rufen Sie sDoCreateFile(Server.MapPath(sstrUrlLocal & "Log" & intVer & ".htm"<IMG SRC="smile/05.gif">, _ "<pre>" & sstrLogContent & "</pre>"<IMG SRC auf ="smile/05.gif">
Call sDoAppendFile(Server.MapPath(sstrUrlLocal & UrlHistory), "<pre>" & _ strVer & "_______" & Now() & "</pre>" & vbCrLf)
Funktion beenden
Rem ############################################# ##############
Rem ## Update-Datei
Rem ############################################# ##############
Private Funktion doUpdateFile(strSourceFile, strTargetFile)
Dim strContent
strContent = GetContent(sstrUrlUpdate & strSourceFile)
Rem ## Aktualisieren und in das Protokoll schreiben
Wenn sDoCreateFile(Server.MapPath(sstrUrlLocal & strTargetFile), strContent) Dann
sstrLogContent = sstrLogContent & "Erfolg" & vbCrLf
Anders
sstrLogContent = sstrLogContent & „Fehlgeschlagen“ & vbCrLf
Ende wenn
Funktion beenden
Rem ############################################# ##############
Rem ## Inhalte aus der Ferne abrufen
Rem ############################################# ##############
Private Funktion GetContent(strUrl)
GetContent = ""
Dim oXhttp, strContent
Legen Sie oXhttp = Server.CreateObject("Microsoft.XMLHTTP"<IMG SRC="smile/05.gif"> fest
„Bei Fehler Weiter fortsetzen.“
Mit oXhttp
.Öffnen Sie „GET“, strUrl, False, „“, „“
.Schicken
Wenn .readystate <> 4, dann Funktion beenden
strContent = .Responsebody
strContent = sBytesToBstr(strContent)
Ende mit
Setze oXhttp = Nichts
Wenn Err.Number <> 0, dann
Antwort.Write(Err.Description)
Err.Clear
Exit-Funktion
Ende wenn
GetContent = strContent
Funktion beenden
Rem ############################################# ##############
Rem ############################################# ##############
Rem ## Kodierungskonvertierung binär => Zeichenfolge
Private Funktion 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 = nichts
Funktion beenden
Rem ############################################# ##############
Rem ############################################# ##############
Rem ## Kodierungskonvertierung binär => Zeichenfolge
Private Funktion sDoCreateFile(strFileName, ByRef strContent)
sDoCreateFile = False
Dimmen Sie strPath
strPath = Left(strFileName, InstrRev(strFileName, "", -1, 1))
Rem ## Überprüfen Sie die Gültigkeit von Pfad und Dateiname
Wenn nicht (CreateDir(strPath)), dann Funktion beenden
'If Not(CheckFileName(strFileName)) Then Exit function
'response.Write(strFileName)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Setze fso = CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif">
Setze f = fso.OpenTextFile(strFileName, ForWriting, True)
f. Schreiben Sie strContent
f.Schließen
Setze fso = nichts
Setze f = nichts
sDoCreateFile = True
Funktion beenden
Rem ############################################# ##############
Rem ############################################# ##############
Rem ## Kodierungskonvertierung binär => Zeichenfolge
Private Funktion sDoAppendFile(strFileName, ByRef strContent)
sDoAppendFile = False
Dimmen Sie strPath
strPath = Left(strFileName, InstrRev(strFileName, "", -1, 1))
Rem ## Überprüfen Sie die Gültigkeit von Pfad und Dateiname
Wenn nicht (CreateDir(strPath)), dann Funktion beenden
'If Not(CheckFileName(strFileName)) Then Exit function
'response.Write(strFileName)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Setze fso = CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif">
Setze f = fso.OpenTextFile(strFileName, ForAppending, True)
f. Schreiben Sie strContent
f.Schließen
Setze fso = nichts
Setze f = nichts
sDoAppendFile = True
Funktion beenden
Rem ############################################# ##############
Rem ## Programm zum Erstellen eines Verzeichnisses. Wenn es mehrere Verzeichnisebenen gibt, erstellen Sie diese nacheinander.
Rem ############################################# ##############
Private Funktion CreateDir(ByVal strLocalPath)
Dim i, strPath, objFolder, tmpPath, tmptPath
Dimmen Sie arrPathList, intLevel
„Bei Fehler Weiter fortsetzen.“
strPath = Replacement(strLocalPath, "", "/"<IMG SRC="smile/05.gif">
Legen Sie objFolder = server.CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif"> fest
arrPathList = Split(strPath, "/"<IMG SRC="smile/05.gif">
intLevel = UBound(arrPathList)
Für I = 0 bis intLevel
Wenn I = 0, dann
tmptPath = arrPathList(0) & "/"
Anders
tmptPath = tmptPath & arrPathList(I) & "/"
Ende wenn
tmpPath = Left(tmptPath, Len(tmptPath) - 1)
Wenn nicht objFolder.FolderExists(tmpPath), dann objFolder.CreateFolder tmpPath
Nächste
Setze objFolder = Nothing
Wenn Err.Number <> 0, dann
CreateDir = False
Err.Clear
Anders
CreateDir = True
Ende wenn
Funktion beenden
Rem ############################################# ##############
Rem ## Long-Integer-Konvertierung
Rem ############################################# ##############
Private Funktion toNum(s, Standard)
Wenn IsNumeric(s) und s <> "", dann
toNum = CLng(s)
Anders
toNum = Standard
Ende wenn
Funktion beenden
Rem ############################################# ##############
Unterricht beenden
Rem ############################################# ################################
%>