<% '################################################################################# '## Snitz Forums 2000 v3.4.06 '################################################################################# '## Copyright (C) 2000-06 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 %> <% if MemberID <> intAdminMemberID then Err_Msg = "

Only the Forum Admin can access this page

" Response.Write "" & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "

" & vbNewLine & _ "

There has been a problem!

" & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "

" & Err_Msg & "

" & vbNewLine & _ "

Go Back To Admin Section

" & vbNewLine & _ "

" & vbNewLine Response.End end if Response.Write "

" & _ "Snitz Forum Modifications

" & 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 "" & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "

" & vbNewLine & _ "

" & vbNewLine & _ " Database Setup....
" If strDBType = "" then Response.Write "Your strDBType is not set, please edit your config.asp
" & _ "to reflect your database type
" & _ "
Go Back to Forum" Response.End end if Response.Write "

" & vbNewLine if strDBType = "sqlserver" then Response.Write " " & _ "You are using SQL Server, please select the correct version
" & vbNewLine & _ " SQL 7.x " & vbNewLine & _ " SQL 6.x
" & vbNewLine end if on error resume next Response.Write " " & vbNewLine & _ "

Select the Mod from the list below, and press Update!
" & vbNewLine & _ " A script will execute to perform the database upgrade.

" & vbNewLine & _ " " & vbNewLine & _ "
" & vbNewLine & _ " Delete the dbs file when finished?

" & vbNewLine & _ "

" & vbNewLine & _ " Click here to go to the forum.

" & vbNewLine else Response.Write "" & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "

" & vbNewLine & _ "

" & vbNewLine sqlVer = Request.Form("sqltype") Set fs = CreateObject("Scripting.FileSystemObject") Set thisfile = fs.OpenTextFile(Request.Form("dbMod"), 1, False) ModName = thisfile.readline response.write (" ") response.write ("

" & ModName & "

") '## 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 " The dbs file was successfully deleted.
" & vbNewLine else Response.write " Unable to remove dbs file
" & err.description & "" & vbNewLine end if end if if ErrorCount > 0 then Response.write "
If there were errors please post a question in the MOD Implementation Forum at
" & vbNewLine & _ " Snitz Forums" & vbNewLine else Response.Write "
Database setup finished
" & vbNewLine end if Response.Write " " & vbNewLine & _ "
" & vbNewLine & _ " " & vbNewLine & _ "
" & vbNewLine & _ "

" & vbNewLine & _ " Click here to go to the forum.

" & vbNewLine & _ "" & vbNewLine end if set fs = nothing set fso = nothing WriteFooter Response.End Sub CreateTables( numfields ) response.write "
" & vbNewLine response.write " Creating table(s)...
" & 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 " case "mysql" strSql = strSql & idFieldName &" INT (11) 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 & "
" & vbNewLine my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords if err.number <> 0 and err.number <> 13 and err.number <> tableExists then response.Write " " & strSql & "
" & vbNewLine response.Write(" " & err.number & " | " & err.description & "
" & vbNewLine) ErrorCount = ErrorCount + 1 else if err.number = tableExists then Response.Write(" Table already exists
" & vbNewLine) else Response.Write(" Table created successfully
" & vbNewLine) end if end if response.write("

" & vbNewLine) end Sub Sub AlterTables(numfields) Response.write "
" & vbNewLine 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 " Adding Column " & fName & "...
" & vbNewLine else strSql = strSQL & fName Response.Write " Dropping Column...
" & vbNewLine end if response.write " " & strSql & "
" & vbNewLine my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords if err.number <> 0 and err.number <> 13 and err.number <> fieldExists then response.write " " & strSQL & "
" & vbNewLine response.write(" " & err.number & " | " & err.description & "
" & vbNewLine) ErrorCount = ErrorCount + 1 resultString = "" else if fAction = "DROP" then Response.Write(" Column " & LCase(fAction) & "ped successfully
" & vbNewLine) resultString = " Table(s) updated
" & vbNewLine else if err.number = fieldExists then Response.Write(" Column already exists
" & vbNewLine) resultString = "" else Response.Write(" Column " & LCase(fAction) & "ed successfully
" & vbNewLine) end if end if if fDefault <> "" and err.number <> fieldExists then strSQL = "UPDATE " & TablePrefix & strTableName & " SET " & fName & "=" & fDefault response.write " " & strSql & "
" & vbNewLine my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords response.write " Populating Current Records with new Default value
" & vbNewLine resultString = " Table(s) updated
" & vbNewLine end if end if if fieldArray(y) = "" then y = numfields next Response.Write(resultString) Response.Write("

" & vbNewLine) end Sub Sub InsertValues(numfields) Response.Write "
" & vbNewLine on error resume next Response.Write (" Adding new records..
" & vbNewLine) 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 & "
" & vbNewLine my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords next if err.number <> 0 and err.number <> 13 then Response.Write " " & strSql & "
" & vbNewLine Response.Write(" " & err.number & " | " & err.description & "
" & vbNewLine) ErrorCount = ErrorCount + 1 else Response.Write("
Value(s) updated successfully" & vbNewLine) end if Response.Write("

" & vbNewLine) end Sub Sub UpdateValues(numfields) on error resume next Response.write "
" & vbNewLine response.write(" Updating Forum Values..
" & vbNewLine) 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 & "
" & vbNewLine my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords next if err.number <> 0 then Response.Write(" " & err.number & " | " & err.description & "
" & vbNewLine) ErrorCount = ErrorCount + 1 Response.Write " " & strSql & "
" & vbNewLine else Response.Write("
Value(s) updated successfully" & vbNewLine) end if Response.Write("

" & vbNewLine) end Sub Sub DeleteValues(numfields) on error resume next response.write "
" & vbNewLine response.write(" Updating Forum Values..
" & vbNewLine) 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 & "
" & vbNewLine my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords if err.number <> 0 then response.write " " & strSql & "
" & vbNewLine response.write(" " & err.number & " | " & err.description & "
" & vbNewLine) ErrorCount = ErrorCount + 1 else response.write("
Value(s) updated successfully" & vbNewLine) end if response.write("

" & vbNewLine) end Sub Sub DropTable() on error resume next response.write "
" & vbNewLine response.write(" Dropping Table..
" & vbNewLine) if Instr(1,strTableName,"MEMBER",1) > 0 then strSql = "DROP TABLE " & strMemberTablePrefix & strTableName else strSql = "DROP TABLE " & strTablePrefix & strTableName end if my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords if err.number <> 0 and err.number <> 13 and err.number <> tableNotExist then response.write " " & strSql & "
" & vbNewLine response.write(" " & err.number & " | " & err.description & "
" & vbNewLine) ErrorCount = ErrorCount + 1 else if err.number = tableNotExist then response.write("
Table does not exist" & vbNewLine) else response.write("
Table dropped successfully" & vbNewLine) end if end if response.write("

" & vbNewLine) end Sub on error goto 0 %>