?? install.asp
字號:
<%@ CODEPAGE=65001 %>
<%
'///////////////////////////////////////////////////////////////////////////////
'// Z-Blog
'// 作 者: 朱煊&Sipo
'// 版權(quán)所有: RainbowSoft Studio
'// 技術(shù)支持: rainbowsoft@163.com
'// 程序名稱:
'// 程序版本:
'// 單元名稱: 自動安裝腳本
'// 開始時間: 2006-8-17
'// 最后修改:
'// 備 注:
'///////////////////////////////////////////////////////////////////////////////
%>
<% Option Explicit %>
<% On Error Resume Next %>
<% Response.Charset="UTF-8" %>
<%Response.Buffer=False
Sub ErrorHandle
On Error Resume Next
Response.CodePage=65001
Err.Clear
End Sub
Call ErrorHandle
Const ZB_VERSION="1.8 Arwen Build 81206"
'--------------------------------------------------------------------
Const adOpenForwardOnly=0
Const adOpenKeyset=1
Const adOpenDynamic=2
Const adOpenStatic=3
Const adLockReadOnly=1
Const adLockPessimistic=2
Const adLockOptimistic=3
Const adLockBatchOptimistic=4
Const ForReading=1
Const ForWriting=2
Const ForAppending=8
Const adTypeBinary=1
Const adTypeText=2
Const adModeRead=1
Const adModeReadWrite=3
Const adSaveCreateNotExist=1
Const adSaveCreateOverWrite=2
'--------------------------------------------------------------------
Public objConn
Dim IsNeedUpdateDataBase
Dim IsNeedCreateCustom
Dim IsNeedCreateOption
Dim BlogPath
BlogPath=Server.MapPath("install.asp")
BlogPath=Left(BlogPath,Len(BlogPath)-Len("install.asp"))
Dim UpdateDataBaseMsg
UpdateDataBaseMsg=""
Dim fso2
Set fso2=Server.CreateObject("Scripting.FileSystemObject")
IF Not fso2.FileExists(BlogPath&"installzblog.xml") Then
Response.Write "沒有找到安裝包，請手動刪除install.asp文件。"
Response.End
End If
Set fso2=Nothing
'*********************************************************
' 目的：
'*********************************************************
Function DelXML()
Dim fso
set fso=Server.CreateObject("Scripting.FileSystemObject")
IF fso.FileExists(Blogpath&"installzblog.xml") Then
fso.DeleteFile Blogpath&"installzblog.xml",True
End If
End Function
'*********************************************************
'*********************************************************
' 目的：
'*********************************************************
Function UpdateFiles()
On Error Resume Next
Dim strC_CUSTOM,strZC_BLOG_THEME
Response.Write UpdateDataBaseMsg
Dim objXmlFile,objXmlFiles,i,item,objStream,objFSO,FileName,astrPath,ulngPath,strTmpPath,bytestr,objXmlfolder,BAKFolderName
Set objXmlFile = Server.CreateObject("Microsoft.XMLDOM")
objXmlFile.async=False
objXmlFile.load(BlogPath&"installzblog.xml")
Randomize
BAKFolderName=Year(Now) & Right("0"&Month(Now),2) & Right("0"&Day(Now),2) & Right("0"&Hour(Now),2) & Right("0"&Minute(Now),2) & Right("0"&Second(Now),2) & Int(9 * Rnd) & Int(9 * Rnd) & Int(9 * Rnd) & Int(9 * Rnd) & Right(FileName,Len(FileName)-InStrRev(FileName,".")+1)
If objXmlFile.readyState=4 Then
If objXmlFile.parseError.errorCode = 0 Then
Set objXmlfolder=objXmlFile.documentElement.SelectNodes("folder")
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
for each item in objXmlfolder
If Not objFSO.FolderExists(BlogPath&item.selectSingleNode("path").text) Then
objFSO.CreateFolder(BlogPath&item.selectSingleNode("path").text)
Response.Write "創(chuàng)建 " & item.selectSingleNode("path").text & vbCrlf
End If
next
Set objFSO =Nothing
Set objXmlfolder=Nothing
Set objXmlFiles=objXmlFile.documentElement.SelectNodes("files")
for each item in objXmlFiles
Set objStream = CreateObject("ADODB.Stream")
With objStream
.Type = 1
.Mode = 3
.Open
.Write item.selectSingleNode("content").nodeTypedvalue
If instr(item.selectSingleNode("path").text,"c_custom.asp")>0 Then
If IsNeedCreateCustom=True Then
.SaveToFile BlogPath & item.selectSingleNode("path").text,2
End If
ElseIf instr(item.selectSingleNode("path").text,"c_option.asp")>0 Then
If IsNeedCreateOption=True Then
.SaveToFile BlogPath & item.selectSingleNode("path").text,2
Else
Dim tmpSng
tmpSng=LoadFromFile(BlogPath & "c_option.asp","utf-8")
Call SaveValueForSetting(tmpSng,True,"String","ZC_BLOG_VERSION",ZB_VERSION)
Call SaveToFile(BlogPath & "c_option.asp",tmpSng,"utf-8",false)
End If
ElseIf InStr(item.selectSingleNode("path").text,"\THEMES\default\TEMPLATE\")>0 Then
Set objFSO=Server.CreateObject("Scripting.FileSystemObject")
Call LoadValueForSetting(LoadFromFile(BlogPath & "c_custom.asp","utf-8"),True,"String","ZC_BLOG_THEME",strZC_BLOG_THEME)
If (strZC_BLOG_THEME<>"default") Or (Not objFSO.FileExists(BlogPath & item.selectSingleNode("path").text)) Then
.SaveToFile BlogPath & item.selectSingleNode("path").text,2
End If
ElseIf instr(item.selectSingleNode("path").text,"\PLUGIN\Totoro\include.asp")>0 Then
If (IsNeedCreateOption=True) Or (Not objFSO.FileExists(BlogPath & item.selectSingleNode("path").text)) Then
.SaveToFile BlogPath & item.selectSingleNode("path").text,2
End If
ElseIf instr(item.selectSingleNode("path").text,"p_include.asp")>0 Then
If IsNeedCreateOption=True Then
.SaveToFile BlogPath & item.selectSingleNode("path").text,2
End If
ElseIf instr(item.selectSingleNode("path").text,"p_theme.asp")>0 Then
If IsNeedCreateOption=True Then
.SaveToFile BlogPath & item.selectSingleNode("path").text,2
End If
ElseIf instr(item.selectSingleNode("path").text,"zblog.mdb")>0 Then
If IsNeedCreateCustom=True Then
.SaveToFile BlogPath & item.selectSingleNode("path").text,2
End If
ElseIf instr(item.selectSingleNode("path").text,"INCLUDE\")>0 Then
Set objFSO=Server.CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists(BlogPath & item.selectSingleNode("path").text) Then
.SaveToFile BlogPath & item.selectSingleNode("path").text,2
End If
Else
'其他覆蓋
.SaveToFile BlogPath & item.selectSingleNode("path").text,2
End If
Response.Write "釋放 " & item.selectSingleNode("path").text & vbCrlf
.Close
End With
Set objStream = Nothing
next
Set objXmlFile=Nothing
Response.Write "安裝完成!"
UpdateFiles=True
Else
Response.Write "文件包出錯"
End If
End If
End Function
'*********************************************************
'*********************************************************
' 目的：
'*********************************************************
Function UpdateCustom()
Dim tmpSng
Dim objFSO
Set objFSO=Server.CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(BlogPath & "c_custom.asp") Then
tmpSng=LoadFromFile(BlogPath & "/c_custom.asp","utf-8")
If InStr(tmpSng,"ZC_BLOG_THEME")=0 Then
tmpSng=Replace(tmpSng,"%"&">","Const ZC_BLOG_THEME=""default"""&vbCrlf&"%"&">",1,1,1)
Call SaveValueForSetting(tmpSng,True,"String","ZC_BLOG_CSS","default2")
Call SaveToFile(BlogPath & "/c_custom.asp",tmpSng,"utf-8",false)
End If
End If
End Function
'*********************************************************
'*********************************************************
' 目的： Load Value For Setting
'*********************************************************
Function LoadValueForSetting(strContent,bolConst,strTypeVar,strItem,ByRef strValue)
Dim i,j,s,t
Dim strConst
Dim objRegExp
Dim Matches,Match
If bolConst=True Then strConst="Const"
Set objRegExp=New RegExp
objRegExp.IgnoreCase =True
objRegExp.Global=True
If strTypeVar="String" Then
objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))(.+?)(\r\n|\n|$)"
Set Matches = objRegExp.Execute(strContent)
If Matches.Count=1 Then
t=Matches(0).Value
t=Replace(t,VbCrlf,"")
t=Replace(t,Vblf,"")
objRegExp.Pattern="( *)""(.*)""( *)($)"
Set Matches = objRegExp.Execute(t)
If Matches.Count>0 Then
s=Trim(Matches(0).Value)
s=Mid(s,2,Len(s)-2)
s=Replace(s,"""""","""")
strValue=s
LoadValueForSetting=True
Exit Function
End If
End If
End If
If strTypeVar="Boolean" Then
objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))([a-z]+)( *)(\r\n|\n|$)"
Set Matches = objRegExp.Execute(strContent)
If Matches.Count=1 Then
t=Matches(0).Value
t=Replace(t,VbCrlf,"")
t=Replace(t,Vblf,"")
objRegExp.Pattern="( *)((True)|(False))( *)($)"
Set Matches = objRegExp.Execute(t)
If Matches.Count>0 Then
s=Trim(Matches(0).Value)
s=LCase(Matches(0).Value)
If InStr(s,"true")>0 Then
strValue=True
ElseIf InStr(s,"false")>0 Then
strValue=False
End If
LoadValueForSetting=True
Exit Function
End If
End If
End If
If strTypeVar="Numeric" Then
objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))([0-9.]+)( *)(\r\n|\n|$)"
Set Matches = objRegExp.Execute(strContent)
If Matches.Count=1 Then
t=Matches(0).Value
t=Replace(t,VbCrlf,"")
t=Replace(t,Vblf,"")
objRegExp.Pattern="( *)([0-9.]+)( *)($)"
Set Matches = objRegExp.Execute(t)
If Matches.Count>0 Then
s=Trim(Matches(0).Value)
If IsNumeric(s)=True Then
strValue=s
LoadValueForSetting=True
Exit Function
End If
End If
End If
End If
LoadValueForSetting=False
End Function
'*********************************************************
'*********************************************************
' 目的： Save Value For Setting
'*********************************************************
Function SaveValueForSetting(ByRef strContent,bolConst,strTypeVar,strItem,strValue)
Dim i,j,s,t
Dim strConst
Dim objRegExp
If bolConst=True Then strConst="Const"
Set objRegExp=New RegExp
objRegExp.IgnoreCase =True
objRegExp.Global=True
If strTypeVar="String" Then
strValue=Replace(strValue,"""","""""")
strValue=""""& strValue &""""
objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))(.+?)(\r\n|\n|$)"
If objRegExp.Test(strContent)=True Then
strContent=objRegExp.Replace(strContent,"$1$2"& strValue &"$8")
SaveValueForSetting=True
Exit Function
End If
End If
If strTypeVar="Boolean" Then
strValue=Trim(strValue)
If LCase(strValue)="true" Then
strValue="True"
Else
strValue="False"
End If
If objRegExp.Test(strContent)=True Then
objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))([a-z]+)( *)(\r\n|\n|$)"
strContent=objRegExp.Replace(strContent,"$1$2"& strValue &"$9")
SaveValueForSetting=True
Exit Function
End If
End If
If strTypeVar="Numeric" Then
strValue=Trim(strValue)
If IsNumeric(strValue)=False Then
strValue=0
End If
If objRegExp.Test(strContent)=True Then
objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))([0-9.]+)( *)(\r\n|\n|$)"
strContent=objRegExp.Replace(strContent,"$1$2"& strValue &"$9")
SaveValueForSetting=True
Exit Function
End If
End If
SaveValueForSetting=False
End Function
'*********************************************************
'*********************************************************
' 目的： Load Text form File
' 輸入：
' 輸入：
' 返回：
'*********************************************************
Function LoadFromFile(strFullName,strCharset)
On Error Resume Next
Dim objStream
Set objStream = Server.CreateObject("ADODB.Stream")
With objStream
.Type = adTypeText
.Mode = adModeReadWrite
.Open
.Charset = strCharset
.Position = objStream.Size
.LoadFromFile strFullName
LoadFromFile=.ReadText
.Close
End With
Set objStream = Nothing
Err.Clear
End Function
'*********************************************************
'*********************************************************
' 目的： Save Text to File
' 輸入：
' 輸入：
' 返回：
'*********************************************************
Function SaveToFile(strFullName,strContent,strCharset,bolRemoveBOM)
On Error Resume Next
Dim objStream
Set objStream = Server.CreateObject("ADODB.Stream")
With objStream
.Type = adTypeText
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -