%
'#################################################################################
'## 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
'##
'#################################################################################
%>
<%
if Session(strCookieURL & "Approval") <> "15916941253" then
scriptname = split(request.servervariables("SCRIPT_NAME"),"/")
Response.Redirect "admin_login.asp?target=" & scriptname(ubound(scriptname))
end if
%>
<%
Response.Write "
" & vbNewLine & _
" " & vbNewLine & _
" " & vbNewLine & _
" " & getCurrentIcon(strIconFolderOpen,"","") & " All Forums " & vbNewLine & _
" " & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpen,"","") & " Admin Section " & vbNewLine & _
" " & getCurrentIcon(strIconBlank,"","") & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " MOD Setup
| " & vbNewLine & _
"
" & vbNewLine & _
"
" & vbNewLine
if MemberID <> intAdminMemberID then
Err_Msg = "Only the Forum Admin can access this page"
Response.Write " There has been a problem!
" & vbNewLine & _
" " & vbNewLine & _
" " & vbNewLine & _
" | " & vbNewLine & _
"
" & vbNewLine & _
"
" & vbNewLine & _
" Go Back To Admin Section
" & vbNewLine
WriteFooter
Response.End
end if
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
Select case strDBType
case "access"
strUserDBType = "Microsoft Access 97/2000/2002"
case "sqlserver"
strUserDBType = "Microsoft SQL Server 6.x/7.x/2000"
case "mysql"
strUserDBType = "MySQL Server"
end Select
strRqMethod = Request.Form("method")
if strRqMethod = "Process" then
if Request.Form("Message") = "" then
Err_Msg = "You did not enter any code to process"
Response.Write "There Was A Problem With Your Details
" & vbNewLine & _
"" & vbNewLine & _
" " & vbNewLine & _
" | " & vbNewLine & _
"
" & vbNewLine & _
"
" & vbNewLine & _
"Go Back To Enter Data
" & vbNewLine
WriteFooter
Response.End
end if
codetoprocess = split(Request.Form("Message"), chr(13) + chr(10))
keycnt = ubound(codetoprocess)
Response.Write "There were " & keycnt & " lines of code
"
x = 0
strModTitle = codetoprocess(x)
Select case uCase(strModTitle)
case "[CREATE]","[ALTER]","[DELETE]","[INSERT]","[UPDATE]","[DROP]"
strModTitle = "Database Update"
case else
end select
Response.Write "" &_
" " &_
" " &_
" " &_
" "
sqlVer = Request.Form("sqltype")
response.write ("")
response.write ("" & ModName & "")
Response.Write "" & vbNewLine
do while x < keycnt
sectionName = codetoprocess(x)
Select case uCase(sectionName)
case "[CREATE]","[ALTER]","[DELETE]","[INSERT]","[UPDATE]","[DROP]"
x = x + 1
Select case uCase(sectionName)
case "[CREATE]"
strTableName = uCase(codetoprocess(x))
x = x + 1
idFieldName = uCase(codetoprocess(x))
x = x + 1
tempField = codetoprocess(x)
rec = 0
do while uCase(tempField) <> "[END]"
fieldArray(rec) = tempField
rec = rec+1
x = x + 1
tempField = codetoprocess(x)
loop
CreateTables(rec)
case "[ALTER]"
strTableName = uCase(codetoprocess(x))
x = x + 1
tempField = codetoprocess(x)
rec = 0
do while uCase(tempField) <> "[END]"
fieldArray(rec) = tempField
rec = rec+1
x = x + 1
tempField = codetoprocess(x)
loop
AlterTables(rec)
case "[DELETE]"
strTableName = uCase(codetoprocess(x))
x = x + 1
tempField = codetoprocess(x)
rec = 0
do while uCase(tempField) <> "[END]"
fieldArray(rec) = tempField
rec = rec+1
x = x + 1
tempField = codetoprocess(x)
loop
DeleteValues(rec)
case "[INSERT]"
strTableName = uCase(codetoprocess(x))
x = x + 1
tempField = codetoprocess(x)
rec = 0
do while uCase(tempField) <> "[END]"
fieldArray(rec) = tempField
rec = rec+1
x = x + 1
tempField = codetoprocess(x)
loop
InsertValues(rec)
case "[UPDATE]"
strTableName = uCase(codetoprocess(x))
x = x + 1
tempField = codetoprocess(x)
rec = 0
do while uCase(tempField) <> "[END]"
fieldArray(rec) = tempField
rec = rec+1
x = x + 1
tempField = codetoprocess(x)
loop
UpdateValues(rec)
case "[DROP]"
strTableName = codetoprocess(x)
x = x + 1
tempField = codetoprocess(x)
DropTable()
end select
x = x + 1
case else
x = x + 1
end select
loop
if ErrorCount > 0 then
Response.write " If there were errors please post a question in the MOD Implementation Forum at "
Response.write "Snitz Forums"
else
Response.write "
Database setup finished "
end if
Response.write "" &_
"" &_
" | " &_
"
" &_
"" &_
"" &_
"" &_
"Click here to go to the forum." &_
" | " &_
"
" &_
"
"
else
Response.write "" & vbNewLine
end if
WriteFooter
Response.End
Sub CreateTables( numfields )
response.write "
"
response.write "Creating table(s)...
"
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 "
case "mysql"
strSql = strSql & idFieldName &" INT (11) DEFAULT '' NOT NULL auto_increment "
end select
end if
for y = 0 to numfields -1
on error resume next
tmpArray = split(fieldArray(y),"#")
fName = uCase(tmpArray(0))
fType = lCase(tmpArray(1))
fNull = uCase(tmpArray(2))
fDefault = tmpArray(3)
if idFieldName <> "" or y <> 0 then
strSql = strSql & ", "
end if
select case strDBType
case "access"
fType = replace(fType,"varchar (","text (")
case "sqlserver"
select case sqlVer
case 7
fType = replace(fType,"memo","ntext")
fType = replace(fType,"varchar","nvarchar")
fType = replace(fType,"date","datetime")
case else
fType = replace(fType,"memo","text")
end select
case "mysql"
fType = replace(fType,"memo","text")
fType = replace(fType,"#int","#int (11)")
fType = replace(fType,"#smallint","#smallint (6)")
end select
if fNull <> "NULL" then fNull = "NOT NULL"
strSql = strSql & fName & " " & fType & " " & fNull & " "
if fdefault <> "" then
select case strDBType
case "access"
if Instr(lcase(strConnString), "jet") then strSql = strSql & "DEFAULT " & fDefault
case else
strSql = strSql & "DEFAULT " & fDefault
end select
end if
next
if strDBType = "mysql" then
if idFieldName <> "" then
strSql = strSql & ",KEY " & TablePrefix & strTableName & "_" & idFieldName & "(" & idFieldName & "))"
else
strSql = strSql & ")"
end if
else
strSql = strSql & ")"
end if
response.write strSql & "
"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
if err.number <> 0 and err.number <> 13 and err.number <> tableExists then
response.write strSql & "
"
response.write("" & err.number & " | " & err.description & "
")
ErrorCount = ErrorCount + 1
else
if err.number = tableExists then
response.write("Table already exists
")
else
response.write("Table created successfully
")
end if
end if
response.write("
")
end Sub
Sub AlterTables(numfields)
Response.write "
"
for y = 0 to numfields -1
on error resume next
if Instr(1,strTableName,"MEMBER",1) > 0 then
TablePrefix = strMemberTablePrefix
else
TablePrefix = strTablePrefix
end if
strSql = "ALTER TABLE " & TablePrefix & strTableName
tmpArray = split(fieldArray(y),"#")
fAction = uCase(tmpArray(0))
fName = uCase(tmpArray(1))
fType = lCase(tmpArray(2))
fNull = uCase(tmpArray(3))
fDefault = tmpArray(4)
select case fAction
case "ADD"
strSQL = strSQL & " ADD "
if strDBType = "access" then strSql = strSql & "COLUMN "
case "DROP"
strSQL = strSQL & " DROP COLUMN "
case "ALTER"
strSQL = strSQL & " ALTER COLUMN "
case else
end select
if fAction = "ADD" or fAction = "ALTER" then
select case strDBType
case "access"
fType = replace(fType,"varchar (","text (")
case "sqlserver"
select case sqlVer
case 7
fType = replace(fType,"memo","ntext")
fType = replace(fType,"varchar","nvarchar")
fType = replace(fType,"date","datetime")
case else
fType = replace(fType,"memo","text")
end select
case "mysql"
fType = replace(fType,"memo","text")
fType = replace(fType,"#int","#int (11)")
fType = replace(fType,"#smallint","#smallint (6)")
end select
if fNull <> "NULL" then fNull = "NOT NULL"
strSql = strSQL & fName & " " & fType & " " & fNULL & " "
if fDefault <> "" then
select case strDBType
case "access"
if Instr(lcase(strConnString), "jet") then strSql = strSql & "DEFAULT " & fDefault
case else
strSql = strSql & "DEFAULT " & fDefault
end select
end if
response.write "" & LCase(fAction) & "ing Column " & fName & "...
"
else
strSql = strSQL & fName
response.write "Dropping Column...
"
end if
response.write strSql & "
"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
if err.number <> 0 and err.number <> 13 and err.number <> fieldExists then
response.write strSQL & "
"
response.write("" & err.number & " | " & err.description & "
")
ErrorCount = ErrorCount + 1
resultString = ""
else
if fAction = "DROP" then
response.write("Column " & LCase(fAction) & "ped successfully
")
resultString = "Table(s) updated
"
else
if err.number = fieldExists then
response.write("Column already exists
")
resultString = ""
else
response.write("Column " & LCase(fAction) & "ed successfully
")
end if
end if
if fDefault <> "" and err.number <> fieldExists then
strSQL = "UPDATE " & TablePrefix & strTableName & " SET " & fName & "=" & fDefault
response.write strSql & "
"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
response.write "Populating Current Records with new Default value
"
resultString = "Table(s) updated
"
end if
end if
if fieldArray(y) = "" then y = numfields
next
response.write(resultString)
response.write("
")
end Sub
Sub InsertValues(numfields)
Response.write "
"
on error resume next
response.write ("Adding new records..
")
for y = 0 to numfields-1
if Instr(1,strTableName,"MEMBER",1) > 0 then
strSql = "INSERT INTO " & strMemberTablePrefix & strTableName & " "
else
strSql = "INSERT INTO " & strTablePrefix & strTableName & " "
end if
tmpArray = split(fieldArray(y),"#")
fNames = tmpArray(0)
fValues = tmpArray(1)
strSql = strSql & tmpArray(0) & " VALUES " & tmpArray(1)
response.write strSql & "
"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
next
if err.number <> 0 and err.number <> 13 then
response.write strSql & "
"
response.write("" & err.number & " | " & err.description & "
")
ErrorCount = ErrorCount + 1
else
response.write("
Value(s) updated successfully")
end if
response.write("
")
end Sub
Sub UpdateValues(numfields)
on error resume next
Response.write "
"
response.write ("Updating Forum Values..
")
for y = 0 to numfields-1
if Instr(1,strTableName,"MEMBER",1) > 0 then
strSql = "UPDATE " & strMemberTablePrefix & strTableName & " SET"
else
strSql = "UPDATE " & strTablePrefix & strTableName & " SET"
end if
tmpArray = split(fieldArray(y),"#")
fName = tmpArray(0)
fValue = tmpArray(1)
fWhere = tmpArray(2)
strSql = strSql & " " & fName & " = " & fvalue
if fWhere <> "" then
strSql = strSql & " WHERE " & fWhere
end if
response.write strSql & "
"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
next
if err.number <> 0 then
response.write("" & err.number & " | " & err.description & "
")
ErrorCount = ErrorCount + 1
response.write strSql & "
"
else
response.write("
Value(s) updated successfully")
end if
response.write("
")
end Sub
Sub DeleteValues(numfields)
on error resume next
response.write "
"
response.write ("Updating Forum Values..
")
if Instr(1,strTableName,"MEMBER",1) > 0 then
strSql = "DELETE FROM " & strMemberTablePrefix & strTableName & " WHERE "
else
strSql = "DELETE FROM " & strTablePrefix & strTableName & " WHERE "
end if
tmpArray = fieldArray(0)
strSql = strSql & tmpArray
response.write strSql & "
"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
if err.number <> 0 then
response.write strSql & "
"
response.write("" & err.number & " | " & err.description & "
")
ErrorCount = ErrorCount + 1
else
response.write("
Value(s) updated successfully")
end if
response.write("
")
end Sub
Sub DropTable()
on error resume next
response.write "
"
response.write ("Dropping Table..
")
if Instr(1,strTableName,"MEMBER",1) > 0 then
strSql = "DROP TABLE " & strMemberTablePrefix & strTableName
else
strSql = "DROP TABLE " & strTablePrefix & strTableName
end if
response.write strSql & "
"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
if err.number <> 0 and err.number <> 13 and err.number <> tableNotExist then
response.write strSql & "
"
response.write("" & err.number & " | " & err.description & "
")
ErrorCount = ErrorCount + 1
else
if err.number = tableNotExist then
response.write("
Table does not exist")
else
response.write("
Table dropped successfully")
end if
end if
response.write("
")
end Sub
on error goto 0
%>