<%@ CODEPAGE=65001 %> <% '/////////////////////////////////////////////////////////////////////////////// '// Z-Blog '// 作 者: 朱煊&Sipo '// 版权所有: RainbowSoft Studio '// 技术支持: 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 Spirit Build 80605" '-------------------------------------------------------------------- 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 "创建 " & 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 .Mode = adModeReadWrite .Open .Charset = strCharset .Position = objStream.Size .WriteText = strContent .SaveToFile strFullName,adSaveCreateOverWrite .Close End With Set objStream = Nothing Err.Clear End Function '********************************************************* Function UpdateDateBase() If IsNeedUpdateDataBase=False Then Exit Function Dim tmpSng Dim ZC_DATABASE_PATH tmpSng=LoadFromFile(BlogPath & "/c_custom.asp","utf-8") Call LoadValueForSetting(tmpSng,True,"String","ZC_DATABASE_PATH",ZC_DATABASE_PATH) Dim strDbPath strDbPath=BlogPath & ZC_DATABASE_PATH Set objConn = Server.CreateObject("ADODB.Connection") objConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDbPath If Not CheckUpdateDB("[log_IsTop]","[blog_Article]") Then objConn.execute("ALTER TABLE [blog_Article] ADD COLUMN [log_IsTop] YESNO DEFAULT FALSE") objConn.execute("UPDATE [blog_Article] SET [log_IsTop]=FALSE") End If If Not CheckUpdateDB("[log_Tag]","[blog_Article]") Then objConn.execute("ALTER TABLE [blog_Article] ADD COLUMN [log_Tag] VARCHAR(255)") End If If Not CheckUpdateDB("[tag_ID]","[blog_Tag]") Then objConn.execute("CREATE TABLE [blog_Tag] (tag_ID AutoIncrement primary key,tag_Name VARCHAR(255),tag_Intro text,tag_ParentID int,tag_URL VARCHAR(255),tag_Order int,tag_Count int)") End If If Not CheckUpdateDB("[coun_ID]","[blog_Counter]") Then objConn.execute("CREATE TABLE [blog_Counter] (coun_ID AutoIncrement primary key,coun_IP VARCHAR(20),coun_Agent text,coun_Refer VARCHAR(255),coun_PostTime TIME DEFAULT Now())") End If If Not CheckUpdateDB("[key_ID]","[blog_Keyword]") Then objConn.execute("CREATE TABLE [blog_Keyword] (key_ID AutoIncrement primary key,key_Name VARCHAR(255),key_Intro text,key_URL VARCHAR(255))") End If If Not CheckUpdateDB("[ul_Quote]","[blog_UpLoad]") Then objConn.execute("ALTER TABLE [blog_UpLoad] ADD COLUMN [ul_Quote] VARCHAR(255)") objConn.execute("ALTER TABLE [blog_UpLoad] ADD COLUMN [ul_DownNum] int DEFAULT 0") End If UpdateDataBaseMsg= "数据库升级成功" & vbcrlf Dim objRS,log_Intro,log_Content,log_ID Set objRS=objConn.Execute("SELECT [log_ID],[log_Intro],[log_Content] FROM [blog_Article] WHERE [log_Intro] LIKE '%UPLOAD%' OR [log_Content] LIKE '%UPLOAD%' ") If (Not objRS.bof) And (Not objRS.eof) Then Do While Not objRS.EOF log_ID=Update_Replace16betaUploadStr(objRS("log_ID")) log_Intro=Update_Replace16betaUploadStr(objRS("log_Intro")) log_Content=Update_Replace16betaUploadStr(objRS("log_Content")) objConn.Execute("UPDATE [blog_Article] SET [log_Intro]='"&FilterSQL(log_Intro)&"',[log_Content]='"&FilterSQL(log_Content)&"' WHERE [log_ID]="&log_ID) objRS.MoveNext Loop End If Set objRS=Nothing objConn.Close Set objConn=Nothing End Function '********************************************************* ' 目的: '********************************************************* Function Update_Replace16betaUploadStr(str) Dim objRegExp,Matches,i,FileID,objRS,tmpstr Set objRegExp = New RegExp objRegExp.IgnoreCase = True objRegExp.Global = True objRegExp.Pattern = "\[UPLOAD=(\d+)\]" Set Matches = objRegExp.Execute(Str) For i = 0 To Matches.Count - 1 FileID=Matches(i).SubMatches(0) Set objRS=objConn.Execute("SELECT [ul_ID],[ul_FileName] FROM [blog_UpLoad] WHERE [ul_ID]="&FileID&" ") If (Not objRS.bof) And (Not objRS.eof) Then tmpstr=objRS("ul_FileName") Set objRS=Nothing str=Replace(str,"[UPLOAD="&FileID&"]",""&tmpstr&"") UpdateDataBaseMsg=UpdateDataBaseMsg&"完成由[UPLOAD="&FileID&"]-->"&tmpstr&"的转换
" Next Set Matches = Nothing Set objRegExp=Nothing Update_Replace16betaUploadStr=str End Function '********************************************************* '********************************************************* ' 目的: '********************************************************* Function CheckUpdateDB(a,b) Err.Clear On Error Resume Next Dim Rs Set Rs=objConn.execute("SELECT "&a&" FROM "&b) Set Rs=Nothing If Err.Number=0 Then CheckUpdateDB=True Else Err.Clear CheckUpdateDB=False End If End Function '********************************************************* %> Z-Blog自动安装升级程序

Z-Blog <%=ZB_VERSION%> 自动安装程序

Z-Blog主页 | Zblogger社区 | Z-Wiki | 菠萝阁 | 菠萝秀 | 菠萝的海 | DBS博客主机
<% Dim ok ok=Request.QueryString("ok") If TypeName(ok)="Empty" Then %>
Z-Blog软件最终用户许可协议:
<%If IsEmpty(Request.QueryString("update")) Then%>
     
<%Else%>
请选择您当前的Z-BLOG版本:   
<%End If%> <% Else Select Case Request.QueryString("ver") Case "12" IsNeedUpdateDataBase=True IsNeedCreateCustom=False IsNeedCreateOption=True Case "13" IsNeedUpdateDataBase=True IsNeedCreateCustom=False IsNeedCreateOption=True Case "14" IsNeedUpdateDataBase=True IsNeedCreateCustom=False IsNeedCreateOption=True Case "15" IsNeedUpdateDataBase=True IsNeedCreateCustom=False IsNeedCreateOption=True Case "15Plus" IsNeedUpdateDataBase=True IsNeedCreateCustom=False IsNeedCreateOption=True Case "16Beta" IsNeedUpdateDataBase=True IsNeedCreateCustom=False IsNeedCreateOption=True Case "16Final" IsNeedUpdateDataBase=True IsNeedCreateCustom=False IsNeedCreateOption=True Case "17Squirrel" IsNeedUpdateDataBase=True IsNeedCreateCustom=False IsNeedCreateOption=True Case "17Laputa" IsNeedUpdateDataBase=True IsNeedCreateCustom=False IsNeedCreateOption=True Case "18Terminator" IsNeedUpdateDataBase=True IsNeedCreateCustom=False IsNeedCreateOption=True Case "18Devo" IsNeedUpdateDataBase=True IsNeedCreateCustom=False IsNeedCreateOption=False Case "18Spirit" IsNeedUpdateDataBase=True IsNeedCreateCustom=False IsNeedCreateOption=False Case Else IsNeedUpdateDataBase=False IsNeedCreateCustom=True IsNeedCreateOption=True End Select %>
创建目录和释放文件到当前空间:
<% If Request.QueryString("ver")=Empty Or Request.QueryString("ver")="" Then %> <% Else %> <% End If %>
<% End If %>
Powered By RainbowSoft Studio