Класс онлайн-обновления ASP
Автор：Eve Cole
Время обновления：2009-06-26 18:09:15
<%
Рем ############################################## ########################################################################
Rem ## Заявление о классе онлайн-обновления
Класс Cls_oUpdate
Рем ############################################## ##############
Rem ## Описание: Класс онлайн-обновления ASP.
Рем ## Версия: 1.0.0
Рем ## Автор: Сяо Юэхэнь
Рем ## MSN: xiaoyuehen(at)msn.com
Rem ## Пожалуйста, замените (at) на @
Rem ## Авторское право: поскольку оно является общим, авторские права отсутствуют. Но оно должно быть ограничено распространением в Интернете и не может использоваться в традиционных средствах массовой информации!
Rem## Если сможете сохранить эту инструкцию, буду еще больше благодарен!
Rem ## Если у вас есть лучшая оптимизация кода и связанные с этим улучшения, не забудьте сказать мне, большое спасибо!
Рем ############################################## ##############
Публичный LocalVersion, LastVersion, FileType
Публичная UrlVersion, UrlUpdate, UpdateLocalPath, Информация
История общедоступных URL-адресов
Частный sstrVersionList, sarrVersionList, sintLocalVersion, sstrLocalVersion
Частный sstrLogContent, sstrHistoryContent, sstrUrlUpdate, sstrUrlLocal
Рем ############################################## ##############
Частный подкласс_Initialize()
Rem ## Полный URL-адрес информации о версии, начиная с http://
Rem ## Пример: http://localhost/software/Version.htm
УрлВерсия = ""
Rem ## URL-адрес обновления, начинающийся с http:// и заканчивающийся /
Rem ## Пример: http://localhost/software/
УрлОбновление = ""
Rem ## Локальный каталог обновления, начинающийся с / и заканчивающийся /. Запретить запись в другие каталоги.
Rem ## Программа проверит, существует ли каталог. Если он не существует, он будет создан автоматически.
UpdateLocalPath = "/"
Rem ## Созданный файл истории программного обеспечения
UrlHistory = "history.htm"
Rem ## Последнее сообщение с подсказкой
Информация = ""
Рем ## Текущая версия
Локальная версия = "1.0.0"
Рем ## последняя версия
Последняя версия = "1.0.0"
Rem ## Суффиксное имя каждого файла с информацией о версии.
ТипФайла = ".asp"
Конец субтитра
Рем ############################################## ##############
Рем ############################################## ##############
Частный подкласс_Terminate()
Конец субтитра
Рем ############################################## ##############
Rem ## Выполнить обновление
Рем ############################################## ##############
Открытая функция doUpdate()
доОбновление = Ложь
UrlVersion = Обрезать(UrlVersion)
UrlUpdate = Trim(UrlUpdate)
Rem ## Обнаружение URL-адреса обновления
If (Left(UrlVersion, 7) <> " http://"<IMG SRC="smile/05.gif"> Или (Left(UrlUpdate, 7) <> " http://"<IMG SRC="smile /05.gif">Тогда
Info = «URL-адрес определения версии пуст, URL-адрес обновления пуст или имеет неверный формат (#1)»
Функция выхода
Конец, если
Если Right(UrlUpdate, 1) <> "/" Тогда
sstrUrlUpdate = UrlUpdate & "/"
Еще
sstrUrlUpdate = UrlUpdate
Конец, если
Если Right(UpdateLocalPath, 1) <> "/" Тогда
sstrUrlLocal = UpdateLocalPath & "/"
Еще
sstrUrlLocal = UpdateLocalPath
Конец, если
Rem ## Информация о текущей версии (номер)
sstrLocalVersion = Локальная версия
sintLocalVersion = replace(sstrLocalVersion, ".", ""<IMG SRC="smile/05.gif">
sintLocalVersion = toNum(sintLocalVersion, 0)
Rem ## Обнаружение версии (инициализация информации о версии и сравнение)
Если IsLastVersion, то выйти из функции
Rem ## Начать обновление
doUpdate = NowUpdate()
ЛастВерсион = сстрЛокалВерсион
Конечная функция
Рем ############################################## ##############
Rem ## Проверьте, последняя ли это версия
Рем ############################################## ##############
Частная функция IsLastVersion()
Rem ## Инициализировать информацию о версии (инициализировать массив sarrVersionList)
Если iniVersionList Тогда
Rem ## В случае успеха сравнить версии
Дим я
Исластверсион = Истина
Для i = 0 до UBound(sarrVersionList)
Если sarrVersionList(i) > sintLocalVersion Тогда
Rem ## Если установлена последняя версия, выходим из цикла
Исластверсион = ложь
Info="Уже последняя версия!"
Выход для
Конец, если
Следующий
Еще
Rem ## В противном случае вернуть сообщение об ошибке.
Исластверсион = Истина
Info = "Ошибка получения информации о версии!(#2)"
Конец, если
Конечная функция
Рем ############################################## ##############
Rem ## Проверьте, последняя ли это версия
Рем ############################################## ##############
Частная функция iniVersionList()
iniVersionList = Ложь
Dim strVersion
стрВерсия = getVersionList()
Rem ## Если возвращаемое значение пусто, инициализация не удалась.
Если стрВерсия = "" Тогда
Информация = "Ошибка......"
Функция выхода
Конец, если
sstrVersionList = Заменить(strVersion, " ", ""<IMG SRC="smile/05.gif">
sarrVersionList = Split(sstrVersionList, vbCrLf)
iniVersionList = Истина
Конечная функция
Рем ############################################## ##############
Rem ## Проверьте, последняя ли это версия
Рем ############################################## ##############
Частная функция getVersionList()
getVersionList = GetContent(UrlVersion)
Конечная функция
Рем ############################################## ##############
Рем ## Начать обновление
Рем ############################################## ##############
Частная функция NowUpdate()
Дим я
Для i = UBound(sarrVersionList) до 0 шаг -1
Вызов doUpdateVersion(sarrVersionList(i))
Следующий
Info = "Обновление завершено! <a href=""" & sstrUrlLocal & UrlHistory & """>Просмотр</a>"
Конечная функция
Рем ############################################## ##############
Rem ## Содержание обновленной версии
Рем ############################################## ##############
Частная функция doUpdateVersion(strVer)
доОбдатеВерсион = Ложь
Тусклый интервал
intVer = toNum(Replace(strVer, ".", ""<IMG SRC="smile/05.gif">, 0)
Rem ## Если обновленная версия меньше текущей, выйти из обновления
Если intVer <= sintLocalVersion Тогда
Функция выхода
Конец, если
Dim strFileListContent, arrFileList, strUrlUpdate
strUrlUpdate = sstrUrlUpdate & intVer & FileType
strFileListContent = GetContent(strUrlUpdate)
Если strFileListContent = "" Тогда
Функция выхода
Конец, если
Rem ## Обновить номер текущей версии
sintLocalVersion = intVer
sstrLocalVersion = стрвер
Дим я, arrTmp
Rem ## Получить список файлов обновлений
arrFileList = Split (strFileListContent, vbCrLf)
Rem ## Журнал обновлений
сстрлогконтент = ""
sstrLogContent = sstrLogContent & strVer & ":" & vbCrLf
Рем ## Начать обновление
Для i = 0 до UBound(arrFileList)
Rem ## Формат обновления: номер версии/file.htm|файл назначения
arrTmp = Split(arrFileList(i), "|"<IMG SRC="smile/05.gif">
sstrLogContent = sstrLogContent & vbTab & arrTmp (1)
Вызовите doUpdateFile(intVer & "/" & arrTmp(0), arrTmp(1))
Следующий
Rem ## Запись в файл журнала
sstrLogContent = sstrLogContent & Now() & vbCrLf
response.Write("<pre>" & sstrLogContent & "</pre>"<IMG SRC="smile/05.gif">
Вызовите sDoCreateFile(Server.MapPath(sstrUrlLocal & "Log" & intVer & ".htm"<IMG SRC="smile/05.gif">, _ "<pre>" & sstrLogContent & "</pre>"<IMG SRC ="улыбка/05.gif">
Вызов sDoAppendFile(Server.MapPath(sstrUrlLocal & UrlHistory), "<pre>" & _ strVer & "_______" & Now() & "</pre>" & vbCrLf)
Конечная функция
Рем ############################################## ##############
Rem ## файл обновления
Рем ############################################## ##############
Частная функция doUpdateFile(strSourceFile, strTargetFile)
Dim strContent
strContent = GetContent(sstrUrlUpdate & strSourceFile)
Rem ## Обновить и записать в лог
Если sDoCreateFile(Server.MapPath(sstrUrlLocal & strTargetFile), strContent) Тогда
sstrLogContent = sstrLogContent & «Успех» & vbCrLf
Еще
sstrLogContent = sstrLogContent & «Не удалось» & vbCrLf
Конец, если
Конечная функция
Рем ############################################## ##############
Rem ## Получайте контент удаленно
Рем ############################################## ##############
Частная функция GetContent(strUrl)
ПолучитьСодержимое = ""
Dim oXhttp, strContent
Установите oXhttp = Server.CreateObject("Microsoft.XMLHTTP"<IMG SRC="smile/05.gif">
'При ошибке возобновить далее
С oXhttp
.Откройте "GET", strUrl, False, "", ""
.Отправлять
Если .readystate <> 4 Тогда Выход из функции
strContent = .Responsebody
стрКонтент = sBytesToBstr(strContent)
Конец с
Установить oXhttp = Ничего
Если Номер ошибки <> 0 Тогда
ответ.Запись(Ошибка.Описание)
Ошиб.Очистить
Функция выхода
Конец, если
GetContent = стрКонтент
Конечная функция
Рем ############################################## ##############
Рем ############################################## ##############
Rem ## Преобразование кодировки двоичная => строка
Частная функция 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
установить objStream = ничего
Конечная функция
Рем ############################################## ##############
Рем ############################################## ##############
Rem ## Преобразование кодировки двоичная => строка
Частная функция sDoCreateFile(strFileName, ByRef strContent)
сДоКреатеФиле = Ложь
Тусклый стрПат
strPath = Left(strFileName, InstrRev(strFileName, "", -1, 1))
Rem ## Проверьте правильность пути и имени файла.
Если нет (CreateDir (strPath)) Тогда выход из функции
'Если нет(CheckFileName(strFileName)) Тогда выход из функции
'response.Write(strFileName)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Дим fso, f
Set fso = CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif">
Установите f = fso.OpenTextFile(strFileName, ForWriting, True)
е. Напишите strContent
е.Закрыть
Установить fso = ничего
Установить f = ничего
сДоКреатеФиле = Истина
Конечная функция
Рем ############################################## ##############
Рем ############################################## ##############
Rem ## Преобразование кодировки двоичная => строка
Частная функция sDoAppendFile(strFileName, ByRef strContent)
sDoAppendFile = Ложь
Тусклый стрПат
strPath = Left(strFileName, InstrRev(strFileName, "", -1, 1))
Rem ## Проверьте правильность пути и имени файла.
Если нет (CreateDir (strPath)) Тогда выход из функции
'Если нет(CheckFileName(strFileName)) Тогда выход из функции
'response.Write(strFileName)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Дим fso, f
Set fso = CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif">
Установите f = fso.OpenTextFile(strFileName, ForAppending, True)
е. Напишите strContent
е.Закрыть
Установить fso = ничего
Установить f = ничего
sDoAppendFile = Истина
Конечная функция
Рем ############################################## ##############
Rem ## Программа для создания каталога. Если существует несколько уровней каталогов, создайте их один за другим.
Рем ############################################## ##############
Частная функция CreateDir(ByVal strLocalPath)
Dim i, strPath, objFolder, tmpPath, tmptPath
Dim arrPathList, intLevel
'При ошибке возобновить далее
strPath = Заменить(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)
Для I = 0 Для intLevel
Если я = 0 Тогда
tmptPath = arrPathList(0) & "/"
Еще
tmptPath = tmptPath & arrPathList(I) & "/"
Конец, если
tmpPath = Влево(tmptPath, Len(tmptPath) - 1)
Если не objFolder.FolderExists(tmpPath), то objFolder.CreateFolder tmpPath
Следующий
Установить objFolder = Ничего
Если Номер ошибки <> 0 Тогда
СоздатьДир = Ложь
Ошиб.Очистить
Еще
СоздатьДир = Истина
Конец, если
Конечная функция
Рем ############################################## ##############
Rem ## преобразование длинных целых чисел
Рем ############################################## ##############
Частная функция toNum(s, по умолчанию)
Если IsNumeric(s) и s <> "" тогда
toNum = CLng(s)
Еще
toNum = по умолчанию
Конец, если
Конечная функция
Рем ############################################## ##############
Конечный класс
Рем ############################################## #################################
%>
