📄 admin_mod_dbsetup.asp
字号:
<%
'#################################################################################
'## Snitz Forums 2000 v3.4.05
'#################################################################################
'## Copyright (C) 2000-05 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000
'## must remain intact in the scripts and in the outputted HTML
'## The "powered by" text/logo with a link back to
'## http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
'##
'## Support can be obtained from our support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## manderson@snitz.com
'##
'#################################################################################
%>
<!--#include file="config.asp"-->
<%
if Session(strCookieURL & "Approval") <> "15916941253" then
scriptname = split(request.servervariables("SCRIPT_NAME"),"/")
Response.Redirect "admin_login.asp?target=" & scriptname(ubound(scriptname))
end if
%>
<!--#include file="inc_sha256.asp"-->
<!--#include file="inc_header.asp"-->
<%
if MemberID <> intAdminMemberID then
Err_Msg = "<li>Only the Forum Admin can access this page</li>"
Response.Write "<table align=""center"" width=""50%"" height=""50%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td>" & vbNewLine & _
" <p align=""center""><font face=""Verdana, Arial, Helvetica"" size=""3"" color=""#FF0000"">There has been a problem!</font></p>" & vbNewLine & _
" <table align=""center"" border=""0"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td><font face=""Verdana, Arial, Helvetica"" size=""2"" color=""#FF0000""><ul>" & Err_Msg & "</ul></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" <p align=""center"" valign=""middle""><font face=""Verdana, Arial, Helvetica"" size=""2""><a href=""JavaScript:history.go(-1)"">Go Back To Admin Section</a></font></p>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine
Response.End
end if
Response.Write "<div align=""center""><center><p><font face=""Verdana, Arial, Helvetica"" size=""4"">" & _
"Snitz Forum Modifications</font></p></center></div>" & vbNewLine
Dim strTableName
Dim fieldArray (100)
Dim idFieldName
Dim tableExists
Dim fieldExists
Dim ErrorCount
tableExists = -2147217900
tableNotExist = -2147217865
fieldExists = -2147217887
ErrorCount = 0
on error resume next
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if err.number <> 0 then
response.write "error " & err.number & "|" & err.description
response.redirect "admin_mod_dbsetup2.asp"
err.clear
response.end
end if
set objFile = fso.Getfile(server.mappath(Request.ServerVariables("PATH_INFO")))
set objFolder = objFile.ParentFolder
set objFolderContents = objFolder.Files
if Request.Form("dbMod") = "" then
Response.Write "<table border=""0"" cellspacing=""0"" cellpadding=""5"" width=""50%"" height=""50%"" align=""center"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgColor=""#9FAFDF"" align=""center"">" & vbNewLine & _
" <p><font face=""Verdana, Arial, Helvetica"" size=""2"">" & vbNewLine & _
" <b>Database Setup....</b><br />"
If strDBType = "" then
Response.Write "<font face=""Verdana, Arial, Helvetica"" color=""#FF0000"" size=""2"">Your strDBType is not set, please edit your config.asp<br />" & _
"to reflect your database type<br /></font>" & _
"<br /><a href=""default.asp"">Go Back to Forum</a></font>"
Response.End
end if
Response.Write " <form action=""" & Request.ServerVariables("PATH_INFO") & """ method=""post"" name=""form1"">" & vbNewLine
if strDBType = "sqlserver" then
Response.Write " <font face=""Verdana, Arial, Helvetica"" size=""1"">" & _
"You are using SQL Server, please select the correct version<br />" & vbNewLine & _
" <input type=""radio"" name=""sqltype"" value=""7"" checked> SQL 7.x " & vbNewLine & _
" <input type=""radio"" name=""sqltype"" value=""6""> SQL 6.x<br /></font>" & vbNewLine
end if
on error resume next
Response.Write " <font face=""Verdana, Arial, Helvetica"" size=""1"">" & vbNewLine & _
" <p>Select the Mod from the list below, and press Update!<br />" & vbNewLine & _
" A script will execute to perform the database upgrade.</p></font>" & vbNewLine & _
" <select name=""dbMod"" size=""1"">" & vbNewLine
for each objFileItem in objFolderContents
intFile = instr(objFileItem.Name, "dbs_")
if intFile <> 0 then
whichfile = server.mappath(objFileItem.Name)
Set fs = CreateObject("Scripting.FileSystemObject")
Set thisfile = fs.OpenTextFile(whichfile, 1, False)
ModName = thisfile.readline
Response.Write " <option value=""" & whichfile & """>" & ModName & "</option>"
thisfile.close
if err.number <> 0 then
Response.Write err.description
Response.end
end if
set fs = nothing
end if
Next
Response.Write " </select>" & vbNewLine & _
" <input type=""submit"" name=""submit1"" value=""Update!""><br />" & vbNewLine & _
" <input type=""checkbox"" name=""delFile"" value=""1"">Delete the dbs file when finished?</form>" & vbNewLine & _
" </font></p></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center"">" & vbNewLine & _
" <font face=""Verdana, Arial, Helvetica"" size=""2""><a href=""default.asp"" target=""_top"">Click here to go to the forum.</a></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine
else
Response.Write "<table border=""0"" cellspacing=""0"" cellpadding=""5"" width=""50%"" height=""50%"" align=""center"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgColor=""#9FAFDF"" align=""center"">" & vbNewLine & _
" <p><font face=""Verdana, Arial, Helvetica"" size=""2"">" & vbNewLine
sqlVer = Request.Form("sqltype")
Set fs = CreateObject("Scripting.FileSystemObject")
Set thisfile = fs.OpenTextFile(Request.Form("dbMod"), 1, False)
ModName = thisfile.readline
response.write (" <font face=""Verdana, Arial, Helvetica"" size=""3"">")
response.write (" <h4>" & ModName & "</h4></font>")
'## Load Sections for processing
do while not thisfile.AtEndOfStream
sectionName = thisfile.readline
Select case uCase(sectionName)
case "[CREATE]"
strTableName = uCase(thisfile.readline)
idFieldName = uCase(thisfile.readline)
tempField = thisfile.readline
rec = 0
do while uCase(tempField) <> "[END]"
fieldArray(rec) = tempField
rec = rec+1
tempField = thisfile.readline
loop
CreateTables(rec)
case "[ALTER]"
strTableName = uCase(thisfile.readline)
tempField = thisfile.readline
rec = 0
do while uCase(tempField) <> "[END]"
fieldArray(rec) = tempField
rec = rec+1
tempField = thisfile.readline
loop
AlterTables(rec)
case "[DELETE]"
strTableName = uCase(thisfile.readline)
tempField = thisfile.readline
rec = 0
do while uCase(tempField) <> "[END]"
fieldArray(rec) = tempField
rec = rec+1
tempField = thisfile.readline
loop
DeleteValues(rec)
case "[INSERT]"
strTableName = uCase(thisfile.readline)
tempField = thisfile.readline
rec = 0
do while uCase(tempField) <> "[END]"
fieldArray(rec) = tempField
rec = rec+1
tempField = thisfile.readline
loop
InsertValues(rec)
case "[UPDATE]"
strTableName = uCase(thisfile.readline)
tempField = thisfile.readline
rec = 0
do while uCase(tempField) <> "[END]"
fieldArray(rec) = tempField
rec = rec+1
tempField = thisfile.readline
loop
UpdateValues(rec)
case "[DROP]"
strTableName = thisfile.readline
tempField = thisfile.readline
DropTable()
end select
loop
Response.Write ""
if request("delFile") = "1" then
thisfile.close
on error resume next
fs.DeleteFile(Request.Form("dbMod"))
if err.number = 0 then
Response.write " <font face=""Verdana, Arial, Helvetica"" size=""2""><b>The dbs file was successfully deleted.</b></font><br />" & vbNewLine
else
Response.write " <font face=""Verdana, Arial, Helvetica"" size=""2""><b>Unable to remove dbs file<br /><font color=""#FF0000"">" & err.description & "</font></font>" & vbNewLine
end if
end if
if ErrorCount > 0 then
Response.write " <br />If there were errors please post a question in the MOD Implementation Forum at<br />" & vbNewLine & _
" <a href=""http://forum.snitz.com/forum/forum.asp?FORUM_ID=94"">Snitz Forums</a>" & vbNewLine
else
Response.Write " <br /><font face=""Verdana, Arial, Helvetica"" size=""2""><p><b>Database setup finished</b></p>" & vbNewLine
end if
Response.Write " </font>" & vbNewLine & _
" <form action=""" & Request.ServerVariables("PATH_INFO") & """ method=""post"" name=""form2"">" & vbNewLine & _
" <input type=""hidden"" name=""dbMod"" value="""">" & vbNewLine & _
" <input type=""submit"" name=""submit2"" value=""Finished""></form>" & vbNewLine & _
" </font></p></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""Verdana, Arial, Helvetica"" size=""2"">" & vbNewLine & _
" <a href=""default.asp"" target=""_top"">Click here to go to the forum.</a></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine & _
"</form>" & vbNewLine
end if
set fs = nothing
set fso = nothing
WriteFooter
Response.End
Sub CreateTables( numfields )
response.write " <br /><font face=""Verdana, Arial, Helvetica"" size=""1"">" & vbNewLine
response.write " <b>Creating table(s)...</b><br />" & vbNewLine
if Instr(1,strTableName,"MEMBER",1) > 0 then
TablePrefix = strMemberTablePrefix
else
TablePrefix = strTablePrefix
end if
strSql = "CREATE TABLE " & TablePrefix & strTableName & "( "
if idFieldName <> "" then
select case strDBType
case "access"
if Instr(strConnString,"(*.mdb)") then
strSql = strSql & idFieldName &" COUNTER CONSTRAINT PrimaryKey PRIMARY KEY "
else
strSql = strSql & idFieldName &" int IDENTITY (1, 1) PRIMARY KEY NOT NULL "
end if
case "sqlserver"
strSql = strSql & idFieldName &" int IDENTITY (1, 1) PRIMARY KEY NOT NULL "
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -