<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%Option Explicit
Response.Buffer = false
response.charset = "gb2312"
Server.ScriptTimeout=100 

dim step
Dim conn,rs,msg
step=request.querystring("step")
if step="" or isnumeric(step)=false then step="0"
if step="0" then
	opendata
	step0
	closedata
	response.redirect "install.asp?step=1"
elseif step="1" then
	head
	step1
	foot
elseif step="2" then
	head
	step2
	foot
elseif step="3" then
	if Request.serverVariables("request_method")="POST" then
	dim f_server,f_database,f_uid,f_pwd
	f_server=request.form("server")
	f_database=request.form("database")
	f_uid=request.form("uid")
	f_pwd=request.form("pwd")
	On Error Resume Next
	dim con,constr
	constr="Provider=SQLOLEDB.1;Persist Security Info=False;Server="&f_server&";Uid="&f_uid&";Pwd="&f_pwd&";Database="&f_database&";"
	set con=server.createobject("ADODB.Connection")
	con.open constr
	if Err Then
		err.Clear
		set con=nothing
		msg="数据库连接不正确！请检查上述内容！"
		head
		step3
		foot
	else
		set rs=con.execute("SELECT name From sysobjects WHERE xtype = 'u'")
		if not rs.eof then
			if request.form("clear")<>"1" and request.form("clear")<>"0" then
			msg="数据库里已经有旧数据，是否要？<label><input type=""radio"" name=""clear"" value=""1"" />清空旧数据</label><label><input type=""radio"" name=""clear"" value=""0"" checked />保留旧数据库</label>"
			set rs=nothing
			head
			step3
			foot
		elseif request.form("clear")="0" then
			response.cookies("Asprain")("newdatabase")="0"
			set rs=nothing
			head
			constr="Server="&f_server&";Uid="&f_uid&";Pwd="&f_pwd&";Database="&f_database
			step3installsql false
			set con=nothing
			foot
		elseif request.form("clear")="1" then
			response.cookies("Asprain")("newdatabase")="1"
			do while not rs.eof
			con.execute "drop table ["&rs(0)&"]",1,128
			rs.movenext
			loop
			set rs=nothing
			head
			constr="Server="&f_server&";Uid="&f_uid&";Pwd="&f_pwd&";Database="&f_database
			step3installsql true
			set con=nothing
			foot
		end if
	else
		response.cookies("Asprain")("newdatabase")="1"
		head
		constr="Server="&f_server&";Uid="&f_uid&";Pwd="&f_pwd&";Database="&f_database
		step3installsql true
		foot
	end if
	end if
	set conn=nothing
	else
	head
	step3
	set con=nothing
	foot
	end if
elseif step="4" then
	head
	step4
	foot
elseif step="5" then
	if request.cookies("Asprain")("newdatabase")="0" then
	set fso=server.createobject("scripting.filesystemobject")
	fso.deletefile server.mappath("asprain.asa"),True
	fso.deletefile server.mappath("install.asp"),True
	set fso=nothing
	head
	step6
	foot
	else
	head
	step5
	foot
	end if
elseif step="6" then
	if Request.serverVariables("request_method")="POST" then
	dim f_sitename,f_sitedescription,f_sitekeyword,f_username
	f_sitename=request.form("sitename")
	f_sitedescription=request.form("sitedescription")
	f_sitekeyword=request.form("keyword")
	f_username=request.form("username")
	f_sitename=replace(f_sitename,"'","")
	f_sitedescription=replace(f_sitedescription,"'","")
	f_sitekeyword=replace(f_sitekeyword,"'","")
	f_username=replace(f_username,"'","")
	opendata()
	constr=conn.execute("select top 1 [sql] from [sql] order by id desc")(0)
	set con=server.createobject("ADODB.Connection")
	con.open "Provider=SQLOLEDB.1;Persist Security Info=False;"&constr&";"
	con.execute "update [ar_user] set [username]='"&f_username&"' where [username]='Admin'",1,128
	con.execute "update [ar_board] set [lastauthor]='"&f_username&"' where [lastauthor]='Admin'",1,128
	con.execute "update [ar_topic] set [firstauthor]='"&f_username&"' where [firstauthor]='Admin'",1,128
	con.execute "update [ar_topic] set [lastauthor]='"&f_username&"' where [lastauthor]='Admin'",1,128
	con.execute "update [ar_siteconfig] set [sitename]='"&f_sitename&"',[sitedescription]='"&f_sitedescription&"',[sitekeyword]='"&f_sitekeyword&"'",1,128
	application.lock
	application("Asprain_sitename")=f_sitename
	application("Asprain_sitedescription")=f_sitedescription
	application("Asprain_sitekeyword")=f_sitekeyword
	application.unlock
	con.close
	set con=nothing
	closedata()
	end if
	dim fso
	set fso=server.createobject("scripting.filesystemobject")
	fso.deletefile server.mappath("asprain.asa"),True
	fso.deletefile server.mappath("install.asp"),True
	set fso=nothing
	head
	step6
	foot
end if


Sub opendata()
	On Error Resume Next
    Set conn = Server.CreateObject("ADODB.Connection")
    conn.open "Driver={Microsoft Access Driver (*.mdb)};Dbq="&server.mappath("asprain.asa")&";"
	'If Err Then
	'	err.Clear
	'	Set Conn = Nothing
	'	Response.Write "Database connect error"
	'	Response.End
	'End If
end sub
Sub CloseData()
     conn.Close
     set conn=nothing
End Sub

sub step0()
	set rs=server.createobject("adodb.recordset")
	dim st,filename

	set st=server.createobject("adodb.stream")
	rs.open "select * from file where id<6",conn,1,1
	if rs.eof then
	response.write "eof"
	else
	do while not rs.eof
		st.open
		st.Type = 1
		filename=rs("filename")
		st.Write rs("content").getChunk(8000000)
		st.savetofile server.mappath(rs("filename")),2
		st.close
		rs.movenext
	loop
	end if
	rs.close
	set st=nothing
	set rs=nothing
end sub

sub step1()
	Response.Write "<div id=""sidebar"">" & vbCrlf
	Response.Write "<ul>" & vbCrlf
	Response.Write "<li class=""current"">开始安装</li>" & vbCrlf
	Response.Write "<li>检查环境</li>" & vbCrlf
	Response.Write "<li>解压文件</li>" & vbCrlf
	Response.write "<li>连接数据库</li>" & vbcrlf
	Response.Write "<li>基本设置</li>" & vbCrlf
	Response.Write "<li>完成安装</li>" & vbCrlf
	Response.Write "</ul>" & vbCrlf
	Response.Write "<p id=""copy"">CopyRight &copy; <a href=""http://www.asprain.com/"" target=""_blank"">AspRain.com</a></p>" & vbCrlf
	Response.Write "</div>" & vbCrlf
	Response.Write "<div id=""tMain"">" & vbCrlf
	Response.Write "<h2>欢迎使用AspRain论坛系统</h2>" & vbCrlf
	Response.Write "<p style=""text-indent:2em;"">AspRain论坛系统是由fanxiaojie开发的一套开源的ASP论坛系统程序，具有Asp+Access或Asp+SqlServer两个版本。相对于其它Asp论坛系统，AspRain论坛系统具有前端代码符合xhtml标准和CSS2.0标准、兼容各种主流浏览器、广泛使用Ajax机制以及缓存机制，内容读取快，数据库使用效率高、支持Web发送邮件以及支付宝财付通在线支付等特点。</p>" & vbCrlf
	Response.Write "<p style=""text-indent:2em;"">AspRain论坛系统目前的版本为Beta版，即将推出正式版，欲知更新情况、下载更新版本请访问官方网站<a href=""http://www.asprain.com"" target=""_blank""><img src=""ie.gif"" align=""absmiddle"" border=""0"" />http://www.asprain.com</a>。下载插件、皮肤以及教程请访问官方论坛<a href=""http://www.asprain.com""><img src=""ie.gif"" align=""absmiddle"" border=""0""/>http://www.asprain.com</a>。</p>" & vbCrlf
	Response.Write "<p style=""text-indent:2em;"">本论坛系统可以安装在空间根目录下也可以安装在一级子目录下。</p>" & vbCrlf
	Response.Write "<p style=""text-indent:2em;"">AspRain论坛系统允许非商业化免费使用。商业化使用本系统的费用以及论坛个性定制收费，请访问官方网站<a href=""http://www.asprain.com/"" target=""_blank""><img src=""ie.gif"" align=""absmiddle"" border=""0""/>http://www.asprain.com/</a>了解。</p>" & vbCrlf
	Response.Write "<p style=""text-indent:2em;"">做最好的论坛系统，让社区交流更精彩！</p>" & vbCrlf
	Response.Write "<p style=""text-align:right""><input type=""button"" value=""下一步"" onclick=""window.location.href='install.asp?step=2';""/></p>" & vbCrlf & "</div>" & vbCrlf
end sub

sub step2()
	redim objectInstall(10)
	redim objectversion(10)
	dim isok : isok=True
	if Request.ServerVariables("SERVER_SOFTWARE")="Microsoft-IIS/6.0" then 
		objectversion(0)="Windows Server 2003" : objectversion(1)="IIS 6.0" : objectInstall(0)=1 : objectInstall(1)=1
	elseif Request.ServerVariables("SERVER_SOFTWARE")="Microsoft-IIS/5.0" then
		objectversion(0)="Windows Server 2000 " : objectversion(1) ="IIS5.0" : objectInstall(0)=1  : objectInstall(1)=1
	elseif Request.ServerVariables("SERVER_SOFTWARE")="Microsoft-IIS/7.0" then
		objectversion(0)="Windows Server 2008 " : objectversion(1)="未知" : objectversion(1) ="IIS7.0" : objectInstall(0)=1  : objectInstall(1)=1
	else
		objectversion(0)="未知" : objectInstall(0)=1  : objectInstall(1)=1 : isok=false
	end if
	if ScriptEngine()="VBScript" then
		objectversion(2)= ScriptEngineMajorVersion &"."&ScriptEngineMinorVersion&"."& ScriptEngineBuildVersion
		if ScriptEngineMajorVersion=5 and ScriptEngineMinorVersion>=5 then
			objectInstall(2)=1 
		else
			objectInstall(2)=0 : isok=false
		end if
	else
		objectversion(2)=ScriptEngine()
		objectInstall(2)=0 : isok=false
	end if
	if isObjInstalled("adodb.connection") then
		objectversion(3)=getversion("adodb.connection") 
		if objectversion(3) >=2.5 then objectInstall(3)=1 else objectInstall(3)=0 : isok=false
	else
		objectversion(3)="未知" : objectInstall(3)=0 : isok=false
	end if
	if isobjInstalled("Scripting.FileSystemObject") then
		objectversion(4)="可用" : objectInstall(4)=1
	else
		objectversion(4)="不可用" : objectInstall(4)=0 : isok=false
	end if
	if isobjInstalled("Scripting.Dictionary") then
		objectversion(5)="可用" : objectInstall(5)=1
	else
		objectversion(5)="不可用" : objectInstall(5)=0 : isok=false
	end if
	if isobjInstalled("Persits.Jpeg") then
		objectversion(6)=getversion("Persits.Jpeg")
		if left(getversion("Persits.Jpeg"),3)>1.4 then objectInstall(6)=1 else objectInstall(6)=0
	else
		objectversion(6)="不可用" : objectInstall(6)=0 : isok=false
	end if
	if isobjInstalled("Persits.MailSender") then
		objectversion(7)="AspEmail"&getversion("Persits.MailSender") : objectInstall(7)=1
	elseif isobjInstalled("jmail.message") then
		objectversion(7)="w3.Jmail"&getversion("jmail.message") : objectInstall(7)=1
	else
		objectversion(7)="不可用" : objectInstall(7)=0 : isok=false
	end if
	if isobjInstalled("Msxml2.DOMDocument.3.0") then
		objectversion(8)="DOMDocument.3.0" : objectInstall(8)=1 
	else
		if isobjInstalled("Msxml2.DOMDocument") then
		objectversion(8)="DOMDocument.1.0" : objectInstall(8)=0 : isok=false
		elseif isobjInstalled("Msxml2.DOMDocument.6.0") then 
		objectversion(8)="DOMDocument.6.0" : objectInstall(8)=0 : isok=false
		elseif isobjInstalled("Msxml2.DOMDocument.5.0") then
		objectversion(8)="DOMDocument.5.0" : objectInstall(8)=0 : isok=false
		elseif isobjInstalled("Msxml2.DOMDocument.4.0") then
		objectversion(8)="DOMDocument.4.0" : objectInstall(8)=0 : isok=false
		else
		objectversion(8)="未知" : objectInstall(8)=0 : isok=false
		end if
	end if
	if isobjInstalled("Msxml2.ServerXMLHTTP.3.0") then
		objectversion(9)="ServerXMLHTTP.3.0" : objectInstall(9)=1
	else
		objectversion(9)="未知" : objectInstall(9)=0 : isok=false
	end if
	dim demain,path,port
	demain="http://"&Request.ServerVariables("SERVER_NAME")
	if Request.ServerVariables("SERVER_Port")&""<>"80" then demain=demain&":"&Request.ServerVariables("SERVER_Port")
	path=Request.ServerVariables("Path_Info")
	objectInstall(10)=1 : isok=true
	path=left(path,instrrev(path,"/")) 
	dim s
	s=Array("<font color=""red""><b>&times;</b></font>","<font color=""green""><b>√</b></font>")
	Response.Write "<div id=""sidebar"">" & vbCrlf
	Response.Write "<ul>" & vbCrlf
	Response.Write "<li>开始安装</li>" & vbCrlf
	Response.Write "<li class=""current"">检查环境</li>" & vbCrlf
	Response.write "<li>连接数据库</li>" & vbcrlf
	Response.Write "<li>解压文件</li>" & vbCrlf
	Response.Write "<li>基本设置</li>" & vbCrlf
	Response.Write "<li>完成安装</li>" & vbCrlf
	Response.Write "</ul>" & vbCrlf
	Response.Write "<p id=""copy"">CopyRight &copy; <a href=""http://www.asprain.com"" target=""_blank"">AspRain.com</a></p>" & vbCrlf
	Response.Write "</div>" & vbCrlf
	Response.Write "<div id=""tMain"">" & vbCrlf
	Response.Write "<h4>以下是AspRain的安装必备条件</h4>" & vbCrlf
	Response.Write "<table width=""460"" border=""1"" cellpadding=""0"" cellspacing=""0"" bordercolor=""#999999"" style=""border-collapse:collapse;"">" & vbCrlf
	Response.Write "<tr><td>操作系统：</td><td>"&objectversion(0)&"</td><td width=""40"">"&s(objectInstall(0))&"</td></tr>" & vbCrlf
	Response.Write "<tr><td>服务器软件：</td><td>"&objectversion(1)&"</td><td>"&s(objectInstall(1))&"</td></tr>" & vbCrlf
	Response.Write "<tr><td>VBScript版本：</td><td>"&objectversion(2)&"</td><td>"&s(objectInstall(2))&"</td></tr>" & vbCrlf
	Response.Write "<tr><td>ADO版本：</td><td>"&objectversion(3)&"</td><td>"&s(objectInstall(3))&"</td></tr>" & vbCrlf
	Response.Write "<tr><td>FSO组件：</td><td>"&objectversion(4)&"</td><td>"&s(objectInstall(4))&"</td></tr>" & vbCrlf
	Response.Write "<tr><td>Scripting.Dictionary组件：</td><td>"&objectversion(5)&"</td><td>"&s(objectInstall(5))&"</td></tr>" & vbCrlf
	Response.Write "<tr><td>Persits.Jpeg组件：</td><td>"&objectversion(6)&"</td><td>"&s(objectInstall(6))&"</td></tr>" & vbCrlf
	Response.Write "<tr><td>电子邮件组件：</td><td>"&objectversion(7)&"</td><td>"&s(objectInstall(7))&"</td></tr>" & vbCrlf
	Response.Write "<tr><td>Microsoft.XMLDOM组件：</td><td>"&objectversion(8)&"</td><td>"&s(objectInstall(8))&"</td></tr>" & vbCrlf
	Response.Write "<tr><td>Microsoft.XMLHTTP组件：</td><td>"&objectversion(9)&"</td><td>"&s(objectInstall(9))&"</td></tr>" & vbCrlf
	Response.Write "<tr><td>安装路径</td><td>"&demain&path&"</td><td>"&s(objectInstall(10))&"</td>" & vbCrlf
	Response.Write "</tr>" & vbCrlf
	Response.Write "</table>" & vbCrlf
	Response.Write "<p style=""text-align:right""><input type=""button"" value=""上一步"" onclick=""window.location.href='install.asp?step=1'""/>&nbsp;<input type=""button"" value=""下一步"" "
	if isok=true then response.write "onclick=""window.location.href='install.asp?step=3';"" " else response.write "disabled "
	response.write "/></p>" & vbCrlf
	Response.Write "</div>" & vbCrlf
end sub

sub step3()
	Response.Write "<div id=""sidebar"">" & vbCrlf
	Response.Write "<ul>" & vbCrlf
	Response.Write "<li>开始安装</li>" & vbCrlf
	Response.Write "<li>检查环境</li>" & vbCrlf
	Response.Write "<li class=""current"">连接数据库</li>" & vbCrlf
	Response.Write "<li>解压文件</li>" & vbCrlf
	Response.Write "<li>基本设置</li>" & vbCrlf
	Response.Write "<li>完成安装</li>" & vbCrlf
	Response.Write "</ul>" & vbCrlf
	Response.Write "<p id=""copy"">CopyRight &copy; <a href=""http://www.asprain.com"" target=""_blank"">AspRain.com</a></p>" & vbCrlf
	Response.Write "</div>" & vbCrlf
	Response.Write "<div id=""tMain"">" & vbCrlf
	Response.Write "<h4>请填写你的数据库信息</h4>" & vbCrlf
	Response.Write "<form name=""form"" method=""post"" action=""install.asp?step=3"">" & vbCrlf
	Response.Write "<table width=""460"" border=""1"" cellpadding=""0"" cellspacing=""0"" bordercolor=""#999999"" style=""border-collapse:collapse;"">" & vbCrlf
	Response.Write "<tr height=""40""><td valign=""middle"">数据库服务器地址</td><td valign=""middle""><input type=""text"" name=""server"" size=""40"" maxlength=""60"" value="""&f_server&""" /></td></tr>" & vbCrlf
	Response.Write "<tr height=""40""><td valign=""middle"">数据库名：</td><td valign=""middle""><input type=""text"" name=""database"" size=""40"" maxlength=""60"" value="""&f_database&""" /></td></tr>" & vbCrlf
	Response.Write "<tr height=""40""><td valign=""middle"">登录用户名：</td><td valign=""middle""><input type=""text"" name=""uid"" size=""40"" maxlength=""60"" value="""&f_uid&""" /></td></tr>" & vbCrlf
	Response.Write "<tr height=""40""><td valign=""middle"">登录密码：</td><td valign=""middle""><input type=""text"" name=""pwd"" size=""40"" maxlength=""60"" value="""&f_pwd&""" /></td></tr>" & vbCrlf
	
	Response.Write "<tr height=""40""><td colspan=""2"" valign=""middle"" align=""center"">"
	if msg<>"" then response.write "<span style=""text-align:center;color:red"">"&msg&"</span>"
	Response.write "<button type=""submit""> 连  接　 </button></td></tr>" & vbCrlf
	Response.Write "</table>" & vbCrlf
	
	Response.Write "</form>" & vbcrlf & "<p style=""text-align:right""><input type=""button"" value=""上一步""  onclick=""window.location.href='install.asp?step=2';""/>&nbsp;<input type=""button"" value=""下一步"" disabled/></p>" & vbCrlf
	Response.Write "</div>" & vbCrlf
end sub

sub step3installsql(bool)
	Response.Write "<div id=""sidebar"">" & vbCrlf
	Response.Write "<ul>" & vbCrlf
	Response.Write "<li>开始安装</li>" & vbCrlf
	Response.Write "<li>检查环境</li>" & vbCrlf
	Response.Write "<li class=""current"">连接数据库</li>" & vbCrlf
	Response.Write "<li>解压文件</li>" & vbCrlf
	Response.Write "<li>基本设置</li>" & vbCrlf
	Response.Write "<li>完成安装</li>" & vbCrlf
	Response.Write "</ul>" & vbCrlf
	Response.Write "<p id=""copy"">CopyRight &copy; <a href=""http://www.asprain.com/"" target=""_blank"">AspRain.com</a></p>" & vbCrlf
	Response.Write "</div>" & vbCrlf
	Response.Write "<div id=""tMain"">" & vbCrlf
	Response.Write "<h4>正在导入数据库</h4>" & vbCrlf
	Response.Write "<textarea cols=""63"" rows=""20"" readonly style=""width:462px;"">"
	opendata
	conn.execute "insert into [sql] ([sql]) values ('"&constr&"')",1,128 
	dim i
	set rs=server.createobject("adodb.recordset")
	if bool then
	rs.open "select [desc],[sql] from [sql] where id<71 order by id",conn,1,1
	for i=1 to rs.recordcount
	if rs(0)<>"" then response.write rs(0)&vbcrlf
	con.execute rs(1),1,128
	rs.movenext
	next
	rs.close
	end if
	dim demain,path
	demain=Request.ServerVariables("SERVER_NAME")
	if Request.ServerVariables("SERVER_Port")&""<>"80" then demain=demain&":"&Request.ServerVariables("SERVER_Port")
	path=Request.ServerVariables("Path_Info")
	path=left(path,instrrev(path,"/")-1) 
	con.execute "update [ar_siteconfig] set [sitedemain]='"&demain&path&"'",1,128
	dim fso,file
	set fso=server.createobject("scripting.filesystemobject")
	dim folders
	folders=Array("archiver","control","emot","images","inc","json","script","skins","template","uploadfile","uploadpic","userfaces","control/images","control/script","script/images","userfaces/default","images/board","images/face","images/usergroup","images/topic","images/userhonor")
	for i=1 to ubound(folders)
	if fso.FolderExists(server.mappath(folders(i)))=false then
	fso.createfolder server.mappath(folders(i))
	if err then
	err.clear
	response.write folders(i)&"创建不成功"&vbcrlf
	response.write "</textarea>"&vbcrlf
	exit sub
	end if
	end if
	next
	rs.open "select * from [const]",conn,1,1
	do while not rs.eof
	set file=fso.CreateTextFile(server.mappath(rs("filename")),true,false)
	file.write replace(rs("content"),"$constr$",constr)
	if err then
	response.write rs("filename")&"创建不成功</textarea>"&vbcrlf
	exit sub
	end if
	rs.movenext
	loop
	set file=nothing
	set fso=nothing
	set rs=nothing
	closedata
	Response.Write "数据导入完毕"
	Response.Write "</textarea>" & vbCrlf
	Response.Write "<p style=""text-align:right""><input type=""button"" value=""上一步"" disabled />&nbsp;<input type=""button"" value=""下一步"" onclick=""window.location.href='install.asp?step=4';"" /></p>" & vbCrlf
	if bool=false then response.write "<script type=""text/javascript"">window.location.href='install.asp?step=4';</script>"
end sub

Sub step4
	Response.Write "<div id=""sidebar"">" & vbCrlf
	Response.Write "<ul>" & vbCrlf
	Response.Write "<li>开始安装</li>" & vbCrlf
	Response.Write "<li>检查环境</li>" & vbCrlf
	Response.Write "<li>连接数据库</li>" & vbCrlf	
	Response.Write "<li class=""current"">解压文件</li>" & vbCrlf
	Response.Write "<li>基本设置</li>" & vbCrlf
	Response.Write "<li>完成安装</li>" & vbCrlf
	Response.Write "</ul>" & vbCrlf
	Response.Write "<p id=""copy"">CopyRight &copy; <a href=""http://www.asprain.com/"" target=""_blank"">AspRain.com</a></p>" & vbCrlf
	Response.Write "</div>" & vbCrlf
	Response.Write "<div id=""tMain"">" & vbCrlf
	Response.Write "<h4>文件正在解压缩...</h4>" & vbCrlf
	Response.Write "<textarea cols=""63"" rows=""20"" readonly style=""width:462px;"">" & vbCrlf
	opendata
	dim i,st
	dim fso,folder,filepath
	set fso=server.createobject("scripting.filesystemobject")
	set rs=server.createobject("adodb.recordset")
	rs.open "select [filepath],[filename],[content] from [file] where id>5 order by id",conn,1,1
	set st=server.createobject("adodb.stream")
	for i=1 to rs.recordcount
	filepath=trim(rs("filepath"))
	if filepath<>"" then
	if fso.folderexists(server.mappath(filepath))=false then
	fso.createfolder(server.mappath(filepath))
	end if
	end if
	st.open
	st.Type = 1
	st.Write rs("content").getChunk(8000000)
	response.write "解压文件"&rs("filepath")&rs("filename")&vbcrlf
	st.savetofile server.mappath(rs("filepath")&rs("filename")),2
	st.close
	rs.movenext
	next
	set st=nothing
	rs.close
	set rs=nothing
	set fso=nothing
	closedata
	Response.Write "解压完毕...</textarea>" & vbCrlf
	Response.Write "<p style=""text-align:right""><input type=""button"" value=""上一步"" disabled/>&nbsp;<input type=""button"" value=""下一步"" onclick=""window.location.href='install.asp?step=5';"" /></p>" & vbCrlf
	Response.Write "</div>" & vbCrlf
End Sub

Sub step5
	Response.Write "<div id=""sidebar"">" & vbCrlf
	Response.Write "<ul>" & vbCrlf
	Response.Write "<li>开始安装</li>" & vbCrlf
	Response.Write "<li>检查环境</li>" & vbCrlf
	Response.Write "<li>连接数据库</li>" & vbCrlf	
	Response.Write "<li>解压文件</li>" & vbCrlf
	Response.Write "<li class=""current"">基本设置</li>" & vbCrlf
	Response.Write "<li>完成安装</li>" & vbCrlf
	Response.Write "</ul>" & vbCrlf
	Response.Write "<p id=""copy"">CopyRight &copy; <a href=""http://www.asprain.com"" target=""_blank"">AspRain.com</a></p>" & vbCrlf
	Response.Write "</div>" & vbCrlf
	Response.Write "<div id=""tMain"">" & vbCrlf
	Response.Write "<h4>请填写如下内容完成论坛自定义设置</h4>" & vbCrlf
	Response.Write "<form name=""frm"" action=""install.asp?step=6"" method=""post"">" & vbCrlf
	Response.Write "<table>" & vbCrlf
	Response.Write "<tr><th><label for=""sitename"">论坛名称：</label></th><td><input type=""text"" name=""sitename"" value=""Asprain爱好者之家"" size=""20"" maxlength=""30"" />" & vbCrlf
	Response.Write "<span>建议用15字以下的论坛名称</span></td></tr>" & vbCrlf
	Response.Write "<tr><th><label for=""description"">论坛说明：</label></th><td><textarea name=""sitedescription"" cols=""38"" rows=""4"">讨论asp编程技术、Asprain论坛皮肤制作、asp论坛插件制作</textarea>" & vbCrlf
	Response.Write "<span>建议用45字以下的论坛说明简介</span></td></tr>" & vbCrlf
	Response.Write "<tr><th><label for=""keyword"">论坛关键词：</label></th><td><textarea name=""sitekeyword"" cols=""38"" rows=""4"">Asprain,xhtml,css,asp,vbScript,javascript,网页设计,编程</textarea>" & vbCrlf
	Response.Write "<span>多个关键词之间请用半角逗号分隔开</span></td></tr>" & vbCrlf
	Response.Write "<tr><th><label for=""username"">管理用户名：</label></th><td><input type=""text"" name=""username"" value=""Admin"" size=""16"" maxlength=""16"" autocomplete=""off"" style=""ime-mode:disabled""/><br />" & vbCrlf
	Response.Write "<span>设置后台管理登录用户名，最好只用英文字母和数字</span></td></tr>" & vbCrlf
	Response.Write "<tr><th><label for=""密码"">管理密码：</label></th><td><b>987654321</b>" & vbCrlf
	Response.Write "<span>请进入后台自己修改</span></td>" & vbCrlf
	Response.Write "</tr>" & vbCrlf
	Response.Write "</tr>" & vbCrlf
	Response.Write "</table>" & vbCrlf
	Response.Write "<p style=""text-align:right""><input type=""button"" value=""上一步"" disabled/>&nbsp;<input type=""submit"" value=""下一步"" /></p>" & vbCrlf
	Response.Write "</form>" & vbCrlf
	Response.Write "</div>" & vbCrlf
end Sub

sub step6
	Response.Write "<div id=""sidebar"">" & vbCrlf
	Response.Write "<ul>" & vbCrlf
	Response.Write "<li>开始安装</li>" & vbCrlf
	Response.Write "<li>检查环境</li>" & vbCrlf
	Response.Write "<li>连接数据库</li>" & vbCrlf	
	Response.Write "<li>解压文件</li>" & vbCrlf
	Response.Write "<li>基本设置</li>" & vbCrlf
	Response.Write "<li class=""current"">完成安装</li>" & vbCrlf
	Response.Write "</ul>" & vbCrlf
	Response.Write "<p id=""copy"">CopyRight &copy; <a href=""http://www.asprain.com"" target=""_blank"">AspRain.com</a></p>" & vbCrlf
	Response.Write "</div>" & vbCrlf
	Response.Write "<div id=""tMain"">" & vbCrlf
	Response.Write "<h2>恭喜，论坛系统安装完成了！</h2>" & vbCrlf
	Response.Write "<p style=""text-indent:2em;"">现在你可以：</p>" & vbCrlf
	Response.Write "<ol>" & vbCrlf
	Response.Write "<li><a href=""index.asp"">去首页查看论坛 &gt;&gt;</a></li>" & vbCrlf
	Response.Write "<li><a href=""control.asp"">进入后台进一步设置论坛 &gt;&gt;</a></li>" & vbCrlf
	Response.Write "<li><a href=""http://www.asprain.com"" target=""_blank"">到官方网站里去注册帐号参与讨论 &gt;&gt;</a></li>" & vbCrlf
	Response.Write "</ol>" & vbCrlf
	Response.Write "</div>" & vbCrlf
end sub

sub head()
	Response.Write "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Strict//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"">" & vbCrlf
	Response.Write "<html xmlns=""http://www.w3.org/1999/xhtml"">" & vbCrlf
	Response.Write "<head>" & vbCrlf
	Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"" />" & vbCrlf
	Response.Write "<title>AspRain论坛安装向导</title>" & vbCrlf
	Response.Write "<style type=""text/css"">" & vbCrlf
	Response.Write "body{font-size:14px;line-height:24px;font-family:Arial,微软雅黑,宋体;margin:0;background:#E9F1F8}" & vbCrlf
	Response.Write ".wrap{width:706px;padding-top:4px;height:465px;background:url(bg.jpg) left top no-repeat;margin:60px auto;}" & vbCrlf
	Response.Write ".tBody{width:698px;height:460px;border-top-width:0;padding:0 4px 0 4px;border-bottom:1px solid #A2ADE7;height:460px;}" & vbCrlf
	Response.Write "a:link,a:visited{color:#000000;text-decoration:none;}" & vbCrlf
	Response.Write "a:hover,a:active{color:#000000;text-decoration:underline;}" & vbCrlf
	Response.Write "#sidebar{float:left;width:180px;height:460px;position:relative;}" & vbCrlf
	Response.Write "#sidebar ul{margin:30px 20px 0 20px;padding:0;}" & vbCrlf
	Response.Write "#sidebar li{color:#DFDFDF;font-size:14px;line-height:28px;height:28px;list-style-type:none;background:url(o1.png) 0 5px no-repeat;padding-left:20px;margin:0;}" & vbCrlf
	Response.Write "#sidebar li.current{background:url(o2.png) 0 5px no-repeat;color:#FFE92A}" & vbCrlf
	Response.Write "#tMain{float:right;height:420px;width:478px;padding:20px;}" & vbCrlf
	Response.Write "p{margin:6px 0;}" & vbCrlf
	Response.Write "td{padding:2px 0 2px 8px;}" & vbCrlf
	Response.Write "#copy{position:absolute;left:19px;bottom:0px;font-size:9px;font-family:Verdana;color:#ffffff;}" & vbcrlf
	Response.write "#copy a{color:#ffffff;}"
	Response.Write "td span{font-size:12px;color:#999999;line-height:20px;}" & vbCrlf
	Response.Write "th{font-weight:normal;text-align:right;vertical-align:top;}" & vbCrlf
	Response.Write "textarea{border:1px solid #999999;background:#f6f8fa;color:#666666;font-family:Verdana;display:block;}" & vbCrlf
	Response.Write "table input{border-left:1px solid #999999;border-top:1px solid #999999;border-bottom:1px solid #f8f8f8;border-right:1px solid #f8f8f8;font-family:Verdana;color:#666666;padding:2px 3px;}" & vbCrlf
	Response.Write "table label input{border:none;}"
	Response.Write "</style>" & vbCrlf
	Response.Write "</head>" & vbCrlf
	Response.Write "<body>" & vbCrlf
	Response.Write "<div class=""wrap"">" & vbCrlf
	Response.Write "<div id=""tBody"" class=""tBody"">" & vbCrlf
	end sub

sub foot()
response.write "</div></div>"&vbcrlf&"</body>"&vbcrlf&"</html>"
end sub

Function IsObjInstalled(strClassString)
	On Error Resume Next
	IsObjInstalled = False
	Err = 0
	Dim xTestObj
	Set xTestObj = Server.CreateObject(strClassString)
	If 0 = Err Then IsObjInstalled = True
	Set xTestObj = Nothing
	Err = 0
End Function

Function getversion(Classstr)
	On Error Resume Next
	getver=""
	Err = 0
	Dim xTestObj
	Set xTestObj = Server.CreateObject(Classstr)
	If 0 = Err Then getversion=xtestobj.version
	Set xTestObj = Nothing
	Err = 0
End Function
%>