<% '################################################################################# '## 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 & _ " " & vbNewLine & _ "
" & vbNewLine & _ " " & getCurrentIcon(strIconFolderOpen,"","") & " All Forums
" & vbNewLine & _ " " & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpen,"","") & " Admin Section
" & vbNewLine & _ " " & getCurrentIcon(strIconBlank,"","") & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " MOD Setup
" & 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 & _ "
      " & Err_Msg & "
    " & 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 & _ "
      " & Err_Msg & "
    " & 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 "

    " & strModTitle & "

    " & 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 & _ "" & vbNewLine & _ "" & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "
    " & vbNewline & _ " " & vbNewline & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine If strDBType = "" then Response.Write " " & _ " " & vbNewLine & _ "
    Snitz Forums 2000 MOD Database Setup

    " & vbNewLine & _ "Your strDBType is not set, please edit your config.asp file
    " &_ "to reflect your database type
    " & _ "
    Back to Admin Options
    " & vbNewLine & _ "

    " & vbNewLine WriteFooter Response.End end if Response.Write " Database Type:" & vbNewLine & _ " " & strUserDBType & "" & vbNewLine & _ " " & vbNewLine If strDBType = "sqlserver" then Response.Write " " & vbNewLine & _ " SQL Server Version:" & vbNewLine & _ " " & vbNewLine & _ " SQL 6.x   " & vbNewLine & _ " SQL 7.x/2000" & vbNewLine & _ " " & vbNewLine end if Response.Write " " & vbNewLine & _ " CODE:" & vbNewLine & _ " " & vbNewLine & _ "" & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " Enter the Code in the box above that you would like to process.
    A script will execute to perform the database upgrade.
    " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "" & vbNewLine & _ "" & 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 %>