Classe de atualização on-line ASP
Autor:Eve Cole
Data da Última Atualização:2009-06-26 18:09:15
<%
Rem ############################################### #################################
Rem ## Declaração de classe de atualização online
Classe Cls_oUpdate
Rem ############################################### ##############
Rem ## Descrição: classe de atualização online ASP
Rem ## Versão: 1.0.0
Rem ## Autor: Xiao Yuehen
Rem ## MSN: xiaoyuehen(at)msn.com
Rem ## Substitua (arroba) por @
Rem ## Copyright: Por ser compartilhado, não há direitos autorais. Mas deve ser limitado à divulgação online e não pode ser usado na mídia tradicional!
Rem ## Se você puder guardar essas instruções, ficaria ainda mais grato!
Rem ## Se você tiver uma melhor otimização de código e melhorias relacionadas, lembre-se de me dizer, muito obrigado!
Rem ############################################### ##############
LocalVersion pública, LastVersion, FileType
UrlVersion pública, UrlUpdate, UpdateLocalPath, Informações
Histórico de URL público
sstrVersionList privado, sarrVersionList, sintLocalVersion, sstrLocalVersion
SstrLogContent privado, sstrHistoryContent, sstrUrlUpdate, sstrUrlLocal
Rem ############################################### ##############
Subclasse Privada_Initialize()
Rem ## URL completo das informações da versão, começando com http://
Rem ## Exemplo: http://localhost/software/Version.htm
URLVersão = ""
Rem ## URL de atualização, começando com http:// e terminando com /
Rem ## Exemplo: http://localhost/software/
UrlUpdate = ""
Rem ## Diretório de atualização local, começando com / e terminando com / é para atualizar o site atual.
Rem ## O programa irá verificar se o diretório existe. Caso não exista, ele será criado automaticamente.
UpdateLocalPath = "/"
Rem ## Arquivo de histórico de software gerado
UrlHistory = "história.htm"
Rem ## Última mensagem de prompt
Informações = ""
Rem ## Versão atual
VersãoLocal = "1.0.0"
Rem ## versão mais recente
Última versão = "1.0.0"
Rem ## O nome do sufixo de cada arquivo de informações de versão
Tipo de arquivo = ".asp"
Finalizar sub
Rem ############################################### ##############
Rem ############################################### ##############
Subclasse Privada_Terminate()
Finalizar sub
Rem ############################################### ##############
Rem ## Executar ação de atualização
Rem ############################################### ##############
Função pública doUpdate()
doUpdate = Falso
UrlVersion = Trim(UrlVersion)
UrlUpdate = Trim(UrlUpdate)
Rem ## Detecção de URL de atualização
If (Left(UrlVersion, 7) <> " http://"<IMG SRC="smile/05.gif"> Ou (Left(UrlUpdate, 7) <> " http://"<IMG SRC="smile /05.gif">Então
Info = "O URL de detecção de versão está vazio, o URL de atualização está vazio ou tem o formato errado (#1)"
Função de saída
Terminar se
If Right(UrlUpdate, 1) <> "/" Então
sstrUrlUpdate = UrlUpdate & "/"
Outro
sstrUrlUpdate = UrlUpdate
Terminar se
If Right(UpdateLocalPath, 1) <> "/" Então
sstrUrlLocal = UpdateLocalPath & "/"
Outro
sstrUrlLocal = UpdateLocalPath
Terminar se
Rem ## Informações da versão atual (número)
sstrLocalVersion = LocalVersion
sintLocalVersion = Substituir(sstrLocalVersion, ".", ""<IMG SRC="smile/05.gif">
sintLocalVersion = toNum(sintLocalVersion, 0)
Rem ## Detecção de versão (inicializar informações de versão e comparar)
Se IsLastVersion então sai da função
Rem ## Iniciar atualização
doUpdate = AgoraAtualizar()
ÚltimaVersão = sstrLocalVersion
Função final
Rem ############################################### ##############
Rem ## Verifique se é a versão mais recente
Rem ############################################### ##############
Função privada IsLastVersion()
Rem ## Inicializar informações de versão (inicializar array sarrVersionList)
Se iniVersionList então
Rem ## Se for bem-sucedido, compare as versões
Escureça eu
IsLastVersion = Verdadeiro
Para i = 0 para UBound(sarrVersionList)
Se sarrVersionList(i) > sintLocalVersion Então
Rem ## Se houver a versão mais recente, saia do loop
IsLastVersion = Falso
Info = "Já é a versão mais recente!"
Sair para
Terminar se
Próximo
Outro
Rem ## Caso contrário, retorne mensagem de erro
IsLastVersion = Verdadeiro
Info = "Erro ao obter informações da versão!(#2)"
Terminar se
Função final
Rem ############################################### ##############
Rem ## Verifique se é a versão mais recente
Rem ############################################### ##############
Função privada iniVersionList()
iniVersionList = Falso
Dim strVersão
strVersion = getVersionList()
Rem ## Se o valor de retorno estiver vazio, a inicialização falhará.
Se strVersion = "" Então
Informações = "Erro......"
Função de saída
Terminar se
sstrVersionList = Substituir(strVersion, " ", ""<IMG SRC="smile/05.gif">
sarrVersionList = Dividir(sstrVersionList, vbCrLf)
iniVersionList = Verdadeiro
Função final
Rem ############################################### ##############
Rem ## Verifique se é a versão mais recente
Rem ############################################### ##############
Função privada getVersionList()
getVersionList = GetContent(UrlVersion)
Função final
Rem ############################################### ##############
Rem ## Comece a atualizar
Rem ############################################### ##############
Função privada NowUpdate()
Escureça eu
Para i = UBound(sarrVersionList) para 0 passo -1
Chame doUpdateVersion(sarrVersionList(i))
Próximo
Info = "Atualização concluída! <a href=""" & sstrUrlLocal & UrlHistory & """>Ver</a>"
Função final
Rem ############################################### ##############
Rem ## Conteúdo da versão atualizada
Rem ############################################### ##############
Função privada doUpdateVersion(strVer)
doUpdateVersion = Falso
Dim intVer
intVer = toNum(Replace(strVer, ".", ""<IMG SRC="smile/05.gif">, 0)
Rem ## Se a versão atualizada for menor que a versão atual, saia da atualização
Se intVer <= sintLocalVersion então
Função de saída
Terminar se
Dim strFileListContent, arrFileList, strUrlUpdate
strUrlUpdate = sstrUrlUpdate & intVer & FileType
strFileListContent = GetContent(strUrlUpdate)
Se strFileListContent = "" Então
Função de saída
Terminar se
Rem ## Atualize o número da versão atual
sintLocalVersion = intVer
sstrLocalVersion = strVer
Dim eu, arrTmp
Rem ## Obter lista de arquivos de atualização
arrFileList = Dividir(strFileListContent, vbCrLf)
Rem ## Registro de atualização
sstrLogContent = ""
sstrLogContent = sstrLogContent & strVer & ":" & vbCrLf
Rem ## Comece a atualizar
Para i = 0 para UBound(arrFileList)
Rem ## Formato de atualização: número da versão/arquivo.htm|arquivo de destino
arrTmp = Split(arrFileList(i), "|"<IMG SRC="smile/05.gif">
sstrLogContent = sstrLogContent & vbTab & arrTmp(1)
Chame doUpdateFile(intVer & "/" & arrTmp(0), arrTmp(1))
Próximo
Rem ## Grava no arquivo de log
sstrLogContent = sstrLogContent & Now() & vbCrLf
resposta.Write("<pre>" & sstrLogContent & "</pre>"<IMG SRC="smile/05.gif">
Chame sDoCreateFile(Server.MapPath(sstrUrlLocal & "Log" & intVer & ".htm"<IMG SRC="smile/05.gif">, _ "<pre>" & sstrLogContent & "</pre>"<IMG SRC ="sorriso/05.gif">
Chame sDoAppendFile(Server.MapPath(sstrUrlLocal & UrlHistory), "<pre>" & _ strVer & "_______" & Now() & "</pre>" & vbCrLf)
Função final
Rem ############################################### ##############
Arquivo de atualização Rem ##
Rem ############################################### ##############
Função privada doUpdateFile(strSourceFile, strTargetFile)
Dim strContent
strContent = GetContent(sstrUrlUpdate & strSourceFile)
Rem ## Atualizar e gravar no log
Se sDoCreateFile(Server.MapPath(sstrUrlLocal & strTargetFile), strContent) Então
sstrLogContent = sstrLogContent & "Sucesso" & vbCrLf
Outro
sstrLogContent = sstrLogContent & "Falha" & vbCrLf
Terminar se
Função final
Rem ############################################### ##############
Rem ## Obtenha conteúdo remotamente
Rem ############################################### ##############
Função privada GetContent(strUrl)
GetContent = ""
Dim oXhttp, strContent
Definir oXhttp = Server.CreateObject("Microsoft.XMLHTTP"<IMG SRC="smile/05.gif">
'Em caso de erro, retomar próximo
Com oXhttp
.Abra "GET", strUrl, False, "", ""
.Enviar
Se .readystate <> 4 Então sai da função
strContent = .Responsebody
strContent = sBytesToBstr(strContent)
Terminar com
Definir oXhttp = Nada
Se Err.Number <> 0 Então
resposta.Write(Err.Descrição)
Err.Limpar
Função de saída
Terminar se
GetContent = strConteúdo
Função final
Rem ############################################### ##############
Rem ############################################### ##############
Rem ## Codificação de conversão binária => string
Função privada sBytesToBstr(vIn)
dimobjStream
definir 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.Fechar
definir objStream = nada
Função final
Rem ############################################### ##############
Rem ############################################### ##############
Rem ## Codificação de conversão binária => string
Função privada sDoCreateFile(strFileName, ByRef strContent)
sDoCreateFile = Falso
Dim strPath
strPath = Esquerda(strNomeArquivo, InstrRev(strNomeArquivo, "", -1, 1))
Rem ## Verifique a validade do caminho e nome do arquivo
If Not(CreateDir(strPath)) Então sai da função
'If Not(CheckFileName(strFileName)) Então sai da função
'response.Write(strNomeArquivo)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Definir fso = CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif">
Definir f = fso.OpenTextFile(strFileName, ForWriting, True)
f.Escrever strContent
f.Fechar
Defina fso = nada
Definir f = nada
sDoCreateFile = Verdadeiro
Função final
Rem ############################################### ##############
Rem ############################################### ##############
Rem ## Codificação de conversão binária => string
Função privada sDoAppendFile(strFileName, ByRef strContent)
sDoAppendFile = Falso
Dim strPath
strPath = Esquerda(strNomeArquivo, InstrRev(strNomeArquivo, "", -1, 1))
Rem ## Verifique a validade do caminho e nome do arquivo
If Not(CreateDir(strPath)) Então sai da função
'If Not(CheckFileName(strFileName)) Então sai da função
'response.Write(strNomeArquivo)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Definir fso = CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif">
Definir f = fso.OpenTextFile(strFileName, ForAppending, True)
f.Escrever strContent
f.Fechar
Defina fso = nada
Definir f = nada
sDoAppendFile = Verdadeiro
Função final
Rem ############################################### ##############
Rem ## Programa para criar um diretório Se houver vários níveis de diretórios, crie-os um por um.
Rem ############################################### ##############
Função privada CreateDir(ByVal strLocalPath)
Dim i, strPath, objFolder, tmpPath, tmptPath
Dim arrPathList, intLevel
'Em caso de erro, retomar próximo
strPath = Substituir(strLocalPath, "", "/"<IMG SRC="smile/05.gif">
Definir objFolder = server.CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif">
arrPathList = Split(strPath, "/"<IMG SRC="smile/05.gif">
intLevel = UBound(arrPathList)
Para I = 0 Para intLevel
Se eu = 0 então
tmptPath = arrPathList(0) & "/"
Outro
tmptPath = tmptPath & arrPathList(I) & "/"
Terminar se
tmpPath = Esquerda(tmptPath, Len(tmptPath) - 1)
Se não objFolder.FolderExists (tmpPath) Então objFolder.CreateFolder tmpPath
Próximo
Definir objFolder = Nada
Se Err.Number <> 0 Então
CriarDir = Falso
Err.Limpar
Outro
CriarDir = Verdadeiro
Terminar se
Função final
Rem ############################################### ##############
Rem ## conversão de número inteiro longo
Rem ############################################### ##############
Função privada toNum(s, padrão)
Se IsNumeric(s) es <> "" então
toNum = CLng(s)
Outro
toNum = padrão
Terminar se
Função final
Rem ############################################### ##############
Fim da aula
Rem ############################################### #################################
%>