Classe de mise à niveau en ligne ASP
Auteur：Eve Cole
Date de mise à jour：2009-06-26 18:09:15
<%
Rem ############################################## ## ##################################
Rem ## Déclaration de classe de mise à niveau en ligne
Classe Cls_oUpdate
Rem ############################################## ## ##############
Rem ## Description : cours de mise à niveau en ligne ASP
Rem ## Version : 1.0.0
Rem ## Auteur : Xiao Yuehen
Rem ## MSN : xiaoyuehen(at)msn.com
Rem ## Veuillez remplacer (at) par @
Rem ## Copyright : Puisqu'il est partagé, il n'y a pas de droit d'auteur. Mais il doit être limité à la diffusion en ligne et ne peut pas être utilisé dans les médias traditionnels !
Rem ## Si vous parvenez à conserver ces instructions, je vous en serais encore plus reconnaissant !
Rem ## Si vous avez une meilleure optimisation du code et des améliorations associées, n'oubliez pas de me le dire, merci beaucoup !
Rem ############################################## ## ##############
Version locale publique, Dernière version, Type de fichier
UrlVersion publique, UrlUpdate, UpdateLocalPath, Info
Historique des URL publiques
sstrVersionList privée, sarrVersionList, sintLocalVersion, sstrLocalVersion
SstrLogContent privé, sstrHistoryContent, sstrUrlUpdate, sstrUrlLocal
Rem ############################################## ## ##############
Sous-classe privée_Initialize()
Rem ## URL complète des informations de version, commençant par http://
Rem ## Exemple : http://localhost/software/Version.htm
UrlVersion = ""
Rem ## URL de mise à niveau, commençant par http:// et se terminant par /
Rem ## Exemple : http://localhost/software/
UrlMise à jour = ""
Rem ## Répertoire de mise à jour local, commençant par / et se terminant par /. Commencer par / sert à mettre à jour le site actuel. Empêcher l'écriture dans d'autres répertoires.
Rem ## Le programme vérifiera si le répertoire existe. S'il n'existe pas, il sera créé automatiquement.
UpdateLocalPath = "/"
Rem ## Fichier historique du logiciel généré
UrlHistorique = "histoire.htm"
Rem ## Dernier message d'invite
Infos = ""
Rem ## Version actuelle
Version locale = "1.0.0"
Rem ## dernière version
DernièreVersion = "1.0.0"
Rem ## Le nom suffixe de chaque fichier d'informations de version
Type de fichier = ".asp"
Fin du sous-marin
Rem ############################################## ## ##############
Rem ############################################## ## ##############
Sous-classe privée_Terminate()
Fin du sous-marin
Rem ############################################## ## ##############
Rem ## Effectuer une action de mise à niveau
Rem ############################################## ## ##############
Fonction publique doUpdate()
doUpdate = Faux
UrlVersion = Trim(UrlVersion)
UrlUpdate = Trim(UrlUpdate)
Rem ## Détection d'URL de mise à niveau
Si (Left(UrlVersion, 7) <> " http://"<IMG SRC="smile/05.gif"> Ou (Left(UrlUpdate, 7) <> " http://"<IMG SRC="smile/05.gif"> /05.gif">Alors
Info = "L'URL de détection de version est vide, l'URL de mise à niveau est vide ou a un format incorrect (#1)"
Fonction de sortie
Fin si
Si c'est vrai (UrlUpdate, 1) <> "/" Alors
sstrUrlUpdate = UrlUpdate & "/"
Autre
sstrUrlUpdate = UrlUpdate
Fin si
Si c'est vrai (UpdateLocalPath, 1) <> "/" Alors
sstrUrlLocal = UpdateLocalPath & "/"
Autre
sstrUrlLocal = UpdateLocalPath
Fin si
Rem ## Informations sur la version actuelle (numéro)
sstrLocalVersion = LocalVersion
sintLocalVersion = Remplacer(sstrLocalVersion, ".", ""<IMG SRC="smile/05.gif">
sintLocalVersion = toNum(sintLocalVersion, 0)
Rem ## Détection de version (initialiser les informations de version et comparer)
Si IsLastVersion Alors Quittez la fonction
Rem ## Commencer la mise à jour
doUpdate = MaintenantUpdate()
DernièreVersion = sstrLocalVersion
Fin de fonction
Rem ############################################## ## ##############
Rem ## Vérifiez s'il s'agit de la dernière version
Rem ############################################## ## ##############
Fonction privée IsLastVersion()
Rem ## Initialiser les informations de version (initialiser le tableau sarrVersionList)
Si iniVersionList Alors
Rem ## En cas de succès, comparez les versions
Faible je
EstLastVersion = Vrai
Pour i = 0 à UBound(sarrVersionList)
Si sarrVersionList(i) > sintLocalVersion Alors
Rem ## S'il existe la dernière version, quittez la boucle
EstLastVersion = Faux
Info = "Déjà la dernière version !"
Quitter pour
Fin si
Suivant
Autre
Rem ## Sinon, renvoie un message d'erreur
EstLastVersion = Vrai
Info = "Erreur lors de l'obtention des informations sur la version ! (#2)"
Fin si
Fin de fonction
Rem ############################################## ## ##############
Rem ## Vérifiez s'il s'agit de la dernière version
Rem ############################################## ## ##############
Fonction privée iniVersionList()
iniVersionList = Faux
Dim strVersion
strVersion = getVersionList()
Rem ## Si la valeur de retour est vide, l'initialisation échoue.
Si strVersion = "" Alors
Info = "Erreur..."
Fonction de sortie
Fin si
sstrVersionList = Remplacer(strVersion, " ", ""<IMG SRC="smile/05.gif">
sarrVersionList = Split(sstrVersionList, vbCrLf)
iniVersionList = Vrai
Fin de fonction
Rem ############################################## ## ##############
Rem ## Vérifiez s'il s'agit de la dernière version
Rem ############################################## ## ##############
Fonction privée getVersionList()
getVersionList = GetContent (UrlVersion)
Fin de fonction
Rem ############################################## ## ##############
Rem ## Commencer la mise à jour
Rem ############################################## ## ##############
Fonction privée NowUpdate()
Faible je
Pour i = UBound(sarrVersionList) à 0 étape -1
Appelez doUpdateVersion(sarrVersionList(i))
Suivant
Info = "Mise à niveau terminée ! <a href=""" & sstrUrlLocal & UrlHistory & """>Afficher</a>"
Fin de fonction
Rem ############################################## ## ##############
Rem ## Contenu de la version mise à jour
Rem ############################################## ## ##############
Fonction privée doUpdateVersion(strVer)
doUpdateVersion = Faux
Dim intVer
intVer = toNum(Replace(strVer, ".", ""<IMG SRC="smile/05.gif">, 0)
Rem ## Si la version mise à jour est plus petite que la version actuelle, quittez la mise à jour
Si intVer <= sintLocalVersion Alors
Fonction de sortie
Fin si
Dim strFileListContent, arrFileList, strUrlUpdate
strUrlUpdate = sstrUrlUpdate & intVer & FileType
strFileListContent = GetContent (strUrlUpdate)
Si strFileListContent = "" Alors
Fonction de sortie
Fin si
Rem ## Mettre à jour le numéro de version actuel
sintLocalVersion = intVer
sstrLocalVersion = strVer
Dim je, arrTmp
Rem ## Obtenir la liste des fichiers de mise à jour
arrFileList = Split(strFileListContent, vbCrLf)
Rem ## Journal de mise à jour
sstrLogContent = ""
sstrLogContent = sstrLogContent & strVer & ":" & vbCrLf
Rem ## Commencer la mise à jour
Pour i = 0 à UBound(arrFileList)
Rem ## Format de mise à jour : numéro de version/fichier.htm|fichier de destination
arrTmp = Split(arrFileList(i), "|"<IMG SRC="smile/05.gif">
sstrLogContent = sstrLogContent & vbTab & arrTmp(1)
Appelez doUpdateFile(intVer & "/" & arrTmp(0), arrTmp(1))
Suivant
Rem ## Écrire dans le fichier journal
sstrLogContent = sstrLogContent & Maintenant() & vbCrLf
réponse.Write("<pre>" & sstrLogContent & "</pre>"<IMG SRC="smile/05.gif">
Appelez sDoCreateFile(Server.MapPath(sstrUrlLocal & "Log" & intVer & ".htm"<IMG SRC="smile/05.gif">, _ "<pre>" & sstrLogContent & "</pre>"<IMG SRC ="sourire/05.gif">
Appelez sDoAppendFile(Server.MapPath(sstrUrlLocal & UrlHistory), "<pre>" & _ strVer & "_______" & Now() & "</pre>" & vbCrLf)
Fin de fonction
Rem ############################################## ## ##############
Rem ## fichier de mise à jour
Rem ############################################## ## ##############
Fonction privée doUpdateFile(strSourceFile, strTargetFile)
Dim strContent
strContent = GetContent (sstrUrlUpdate & strSourceFile)
Rem ## Mettre à jour et écrire dans le journal
Si sDoCreateFile(Server.MapPath(sstrUrlLocal & strTargetFile), strContent) Alors
sstrLogContent = sstrLogContent & "Succès" & vbCrLf
Autre
sstrLogContent = sstrLogContent & "Échec" & vbCrLf
Fin si
Fin de fonction
Rem ############################################## ## ##############
Rem ## Obtenir du contenu à distance
Rem ############################################## ## ##############
Fonction privée GetContent(strUrl)
ObtenirContenu = ""
Dim oXhttp, strContent
Définir oXhttp = Server.CreateObject("Microsoft.XMLHTTP"<IMG SRC="smile/05.gif">
'En cas d'erreur, reprendre ensuite
Avec oXhttp
.Ouvrez "GET", strUrl, False, "", ""
.Envoyer
Si .readystate <> 4 Alors Quitter la fonction
strContent = .Responsebody
strContent = sBytesToBstr(strContent)
Terminer par
Définir oXhttp = Rien
Si Err.Number <> 0 Alors
réponse.Write(Err.Description)
Err.Effacer
Fonction de sortie
Fin si
GetContent = strContent
Fin de fonction
Rem ############################################## ## ##############
Rem ############################################## ## ##############
Rem ## Conversion d'encodage binaire => chaîne
Fonction privée 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.Fermer
définir objStream = rien
Fin de fonction
Rem ############################################## ## ##############
Rem ############################################## ## ##############
Rem ## Conversion d'encodage binaire => chaîne
Fonction privée sDoCreateFile(strFileName, ByRef strContent)
sDoCreateFile = Faux
Dim strPath
strPath = Gauche(strFileName, InstrRev(strFileName, "", -1, 1))
Rem ## Vérifier la validité du chemin et du nom du fichier
If Not(CreateDir(strPath)) Then Quitter la fonction
'Si non (CheckFileName (strFileName)) Alors quittez la fonction
'response.Write(strFileName)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Faible fso, f
Définir fso = CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif">
Définir f = fso.OpenTextFile(strFileName, ForWriting, True)
f.Écrire strContent
f.Fermer
Définir fso = rien
Définir f = rien
sDoCreateFile = Vrai
Fin de fonction
Rem ############################################## ## ##############
Rem ############################################## ## ##############
Rem ## Conversion d'encodage binaire => chaîne
Fonction privée sDoAppendFile(strFileName, ByRef strContent)
sDoAppendFile = Faux
Dim strPath
strPath = Gauche(strFileName, InstrRev(strFileName, "", -1, 1))
Rem ## Vérifiez la validité du chemin et du nom du fichier
If Not(CreateDir(strPath)) Then Quitter la fonction
'Si non (CheckFileName (strFileName)) Alors quittez la fonction
'response.Write(strFileName)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Faible fso, f
Définir fso = CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif">
Définir f = fso.OpenTextFile(strFileName, ForAppending, True)
f.Écrire strContent
f.Fermer
Définir fso = rien
Définir f = rien
sDoAppendFile = Vrai
Fin de fonction
Rem ############################################## ## ##############
Rem ## Programme pour créer un répertoire S'il existe plusieurs niveaux de répertoires, créez-les un par un.
Rem ############################################## ## ##############
Fonction privée CreateDir (ByVal strLocalPath)
Dim i, strPath, objFolder, tmpPath, tmptPath
Dim arrPathList, intLevel
'En cas d'erreur, reprendre ensuite
strPath = Remplacer(strLocalPath, "", "/"<IMG SRC="smile/05.gif">
Définir objFolder = server.CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif">
arrPathList = Split(strPath, "/"<IMG SRC="smile/05.gif">
intLevel = UBound (arrPathList)
Pour I = 0 À intLevel
Si je = 0 Alors
tmptPath = arrPathList(0) & "/"
Autre
tmptPath = tmptPath & arrPathList(I) & "/"
Fin si
tmpPath = Gauche (tmptPath, Len (tmptPath) - 1)
Si ce n'est pas le cas, objFolder.FolderExists(tmpPath) Then objFolder.CreateFolder tmpPath
Suivant
Définir objFolder = Rien
Si Err.Number <> 0 Alors
CreateDir = Faux
Err.Effacer
Autre
CreateDir = Vrai
Fin si
Fin de fonction
Rem ############################################## ## ##############
Rem ## conversion d'entier long
Rem ############################################## ## ##############
Fonction privée toNum(s, par défaut)
Si IsNumeric(s) et s <> "" alors
toNum = CLng(s)
Autre
toNum = par défaut
Fin si
Fin de fonction
Rem ############################################## ## ##############
Fin du cours
Rem ############################################## ## ##################################
%>
