<%@ Language="VBScript" %> <% Option Explicit %> <% On Error Resume Next ' ' CoffeeCup Flash Form Builder: Database Management Example ' ' @author Jeff Welch ' @version 2.0 ' @package CC_FB ' ' EDIT YOUR DATABASE FIELDS HERE '------------------------------- Private Const DatabaseHost = "localhost" Private Const DatabasePort = "3306" Private Const DatabaseUsername = "" Private Const DatabasePassword = "" Private Const DatabaseName = "" Private Const DatabaseTable = "" ' DO NOT EDIT ANYTHING BELOW THIS LINE '------------------------------------- ' Makes sure that the user is using the VBScript Version 5 If ScriptEngineMajorVersion < 5 Then printMessage "Invalid VBScript Version",_ "We're sorry but CoffeeCup Flash Form Builder requires VBScript " & _ " version 5 or greater. Please contact your server " & _ "administrator.", True, "" End If Dim errorMessage, username, extraMessage ' Lets make sure we can start the session. If Request.QueryString("start_session") <> "true" And _ IsEmpty(Session("logged_in")) Then Session("logged_in") = False Response.Redirect Request.ServerVariables("URL") & "?start_session=true" ElseIf Request.QueryString("start_session") = "true" Then If IsEmpty(Session("logged_in")) Then errorMessage = VbCrLf & "

You must " & _ "have cookies enable to use this script.

" & VbCrLf Else Response.Redirect Request.ServerVariables("URL") End If End If ' If Session("logged_in") isn't set, allow the user to login If Session("logged_in") <> True Then If Request.Form("login") <> "" Then If Request.Form("username") = DatabaseUsername And _ Request.Form("password") = DatabasePassword Then Session("logged_in") = True Response.Redirect Request.ServerVariables("URL") Else errorMessage = VbCrLf & "

Invalid " & _ "username/password combination

" & VbCrLf username = Server.HTMLEncode(Request.Form("username")) End If End If printMessage "Please Login", VbCrLf & _ " " & VbCrLf & _ "
" & VbCrLf & _ " " & VbCrLf & _ "
" & VbCrLf & _ " " & VbCrLf & _ " Login Credentials" & VbCrLf & _ " " & errorMessage & VbCrLf & _ " " & VbCrLf & _ "" & VbCrLf & _ " " & VbCrLf & _ " " & VbCrLf & _ "
" & VbCrLf & _ "" & VbCrLf & _ "
" & VbCrLf & _ " " & VbCrLf & _ "
" & VbCrLf & _ "" & VbCrLf & _ "
" & VbCrLf & _ " " & _ VbCrLf, false, "" End If ' Lets make sure we can access ADODB. Dim connection Set connection = Server.CreateObject("ADODB.Connection") If Err.Number <> 0 Then Err.Clear printMessage "Unable to Connect to Database Server.", _ "We're sorry but we were unable to connect to your " & _ "database server. This script requires ADODB, " & _ "which we were unable to locate on your server. " & _ "Please contact your server administrator.", True, "" End If connection.Open "Driver={MySQL ODBC 3.51 Driver};" & _ "Server=" & DatabaseHost & ";" & _ "Port=" & DatabasePort & ";" & _ "Uid=" & DatabaseUsername & ";" & _ "Pwd=" & DatabasePassword & ";" If Err.Number <> 0 Then ' If the error description mentions a driver, let the user ' know they are missing the mysql driver If InStr(Err.Description, "driver") Then Err.Clear printMessage "Unable to Connect to Database Server.", _ "We're sorry but we were unable to connect to your " & _ "database server. This script requires " & _ "the ""MySQL ODBC 3.51 Driver"" which we were unable " & _ "to locate on your server. Please contact your " & _ "administrator.", True, "" ' Otherwise Let the user know they have entered incorrect ' credentials Else Err.Clear printMessage "Unable to Connect to Database Server.", _ "We're sorry but we were unable to connect to your " & _ "database server. Please be sure you have entered " &_ "your database settings correctly.", True, "" End If End If ' Attempt to make a connection to the specified DB Dim command, results Set command = Server.CreateObject("ADODB.Command") command.ActiveConnection = connection command.CommandText = "USE `" & DatabaseName & "`" command.Execute ' If we still can't select the DB, let the user know If Err.Number <> 0 Then connection.Close Err.Clear printMessage "Unable to select Database.", _ "We're sorry but we were unable to select your " & _ "database. Please be sure that you have the proper " & _ "permissions to select it. If you are still " & _ "experiencing trouble, please contact your " & _ "server administrator.", True, "" End If ' Download the file if the user requested it. If Request.QueryString("action") = "download" And _ Trim(Request.QueryString("file")) <> "" Then ' Make sure we can select. command.CommandText = "SELECT `uploaded_file` FROM " & _ " `" & DatabaseTable & "` WHERE `uploaded_file_name` = ?" Set results = command.Execute( ,Array(Request.QueryString("file"))) If Err.Number <> 0 Then connection.Close Err.Clear printMessage "Unable to Query Database.", _ "We're sorry but we were unable to query your database " & _ "table. Please be sure that you have the proper " & _ "permissions to select from the " & DatabaseTable & " " & _ "table. If you are still experiencing trouble, " & _ "please contact your server administrator.", True, "" End If If results.EOF And results.BOF Then printMessage "Unknown File.", _ "We're sorry but the file you have requested does not exist.", _ TRUE, "" Else Response.Buffer = True Response.ContentType = "application/octet-stream" Response.AddHeader "Content-Disposition", "attachment;filename=" & _ Request.QueryString("file") Response.BinaryWrite(results.Fields.Item("uploaded_file")) Response.Flush connection.Close results.Close connection = Nothing command = Nothing results = Nothing Response.End End If End If ' Process any mass actions If Request.Form("mass_action") = "Go" And _ Request.Form("fields").Count > 0 Then Dim keys, keyItem, keyBound, keylist, rowsAffected keys = Array() ' Escape the keys For Each keyItem In Request.Form("fields") keyBound = UBound(keys) + 1 Redim Preserve keys(keyBound) keys(keyBound) = CInt(keyItem) Next keylist = Join(keys, ",") Select Case Request.Form("action") Case "Delete" ' Make sure we can delete command.CommandText = "DELETE FROM `" & DatabaseTable & "` WHERE" &_ " `id` IN (" & keylist & ")" Set results = command.Execute(rowsAffected) ' If for some reason we can't delete, let the user know If Err.Number <> 0 Then results.Close connection.Close printMessage "Unable to Delete From Database.", _ "We're sorry but we were unable to deelte from your " & _ "database table. Please be sure that you have the proper " & _ "permissions to delete from the $database_table " & _ "table. If you are still experiencing trouble, " & _ "please contact your server administrator.", TRUE, "" End If If rowsAffected = 1 Then extraMessage = "1 row was successfully deleted" Else extraMessage = rowsAffected & " rows were successfully deleted" End If End Select End If command.CommandText = "SHOW COLUMNS FROM `" & DatabaseTable & "`" Set results = command.Execute ' If for some reason we can't querty the DB, let the user know If Err.Number <> 0 Then results.Close connection.Close printMessage "Unable to Query Database.", _ "We're sorry but we were unable to query your database " & _ "table. Please be sure that you have the proper " & _ "permissions to select from the " & DatabaseTable & " " & _ "table. If you are still experiencing trouble, " & _ "please contact your server administrator.", TRUE, "" End If Dim columns, bound, sql columns = Array() ' Populate the columns array with the columns of the ' 'DatabaseTable' table Do Until results.EOF bound = UBound(columns) + 1 Redim Preserve columns(bound) If results.Fields.Item("Field") = "uploaded_file" Then sql = sql & "length(`uploaded_file`) AS filesize," columns(bound) = "filesize" Else sql = sql & "`" & results.Fields.Item("Field") & "`," columns(bound) = results.Fields.Item("Field") End If results.MoveNext Loop results.Close ' Initialize paginationa and sorting Dim perPage, page, orderBy, sortOrder, orderBySql, lastPage, _ recordCount, offset ' Get the number of results to show per page If inArray(Request.QueryString("per_page"), _ Array("10","20","50","100","150","200","300","500")) Then perPage = CInt(Request.QueryString("per_page")) Else perPage = 10 End If ' Get the current page in pagination If Request.QueryString("page") > 0 Then page = CInt(Request.QueryString("page")) Else page = 1 End If ' Get the sort order If inArray(Request.QueryString("order_by"), columns) Then orderBy = Request.QueryString("order_by") If Request.QueryString("sort_order") = "desc" Then sortOrder = "DESC" Else sortOrder = "ASC" End If orderBySql = " ORDER BY `" & orderBy & "` " & sortOrder End If ' Get the number of results. command.CommandText = "SELECT COUNT(1) AS count FROM `" & DatabaseTable & "`" Set results = command.Execute recordCount = CInt(results.Fields.Item("count")) If recordCount > 0 Then lastPage = -Int(-(recordCount / perPage)) Else lastPage = 1 End If results.Close ' Catch invalid page requests If page > lastPage Then page = lastPage End If offset = (page - 1) * perPage ' Get the form results. command.CommandText = "SELECT " & Mid(sql, 1, Len(sql) - 1) & " FROM `" & _ DatabaseTable & "`" & OrderBySql & " LIMIT " & offset & ", " & perPage Set results = command.Execute printMessage "Form Results", getTable(results, columns, orderBy, sortOrder, _ page, perPage, lastPage), False, extraMessage ' ' Creates a results table. ' ' @param resource results the results resource ' @param array columns the database columns ' @param string orderBy the column to order by ' @param string sortOrder the order to sort by ' @param integer page the current page in pagination ' @param integer perPage the number of results to display per page ' @param integer lastPage the last page in pagination ' @return string ' Private Function getTable(ByRef results, Byref columns, Byref orderBy, _ Byref sortOrder, Byref page, Byref perPage, Byref lastPage) On Error Resume Next Dim column, i, key, keys, item, rows, fields ' Get the number of rows and fields rows = 0 fields = results.Fields.Count getTable = "
" & VbCrLf & _ " " & VbCrLf & _ " " & VbCrLf & _ " " & VbCrLf & _ " " & VbCrLf & _ " " & VbCrLf & _ "
" & VbCrLf & VbCrLf & _ "
" & _ VbCrLf & VbCrLf & _ getPagination(page, perPage, lastPage) & _ VbCrLf & VbCrLf & _ " " & VbCrLf & _ " " & VbCrLf & _ " " For Each column in columns getTable = getTable & VbCrLf & " " Next getTable = getTable & VbCrLf & " " Do Until results.EOF rows = rows + 1 getTable = getTable & VbCrLf & " 0 Then getTable = getTable & "odd" Else getTable = getTable & "even" End If getTable = getTable & """>" & VbCrLf & _ " " For Each key in results.Fields getTable = getTable & VbCrLf & " " Next getTable = getTable & VbCrLf & " " results.MoveNext Loop ' If we have rows, add mass actions If rows > 0 Then getTable = getTable & VbCrLf & _ " " & VbCrLf & _ " " & VbCrLf & " " & VbCrLf End If getTable = getTable & VbCrLf & "
" & _ "" If Not orderBy = column Then getTable = getTable & "" & Server.HTMLEncode(column) & "" Else getTable = getTable & Server.HTMLEncode(column) End If getTable = getTable & "
" If key = "" Then getTable = getTable & " " Else If key.name = "uploaded_file_name" Then getTable = getTable & _ "" & Server.HTMLEncode(key) & "" ElseIf key.name = "filesize" Then getTable = getTable & Server.HTMLEncode(humanSize(key)) Else getTable = getTable & Server.HTMLEncode(key) End If End If getTable = getTable & "
" & VbCrLf & _ " " & VbCrLf & " " & _ "" & _ VbCrLf & "
" & _ VbCrLf & VbCrLf & _ getPagination(page, perPage, lastPage) & _ VbCrLf & VbCrLf & _ "
" & VbCrLf End Function ' ' Gets the human-readable size for a size in bytes. ' ' @param int $size the size in bytes ' @return string ' Private Function humanSize(ByRef size) On Error Resume Next size = Cdbl(size) humanSize = round(size) / 1048576 If humanSize > 1 Then humanSize = Round(humanSize, 1) & " MB" Else humanSize = size / 1024 If humanSize > 1 Then humanSize = Round(humanSize, 1) & " KB" Else humanSize = Round(size, 1) & " Bytes" End If End If End Function ' ' Creates pagination for the results ' ' @param integer page the current page in pagination ' @param integer perPage the number of results to display per page ' @param integer lastPage the last page in pagination ' @return string ' Private Function getPagination(ByRef page, ByRef perPage, ByRef lastPage) On Error Resume Next Dim baseUrl, previousPage, nextPage, regEx, value, endValue Set regEx = New RegExp regEx.Pattern = "($|&)page=\d+" ' Remove pages from query string baseUrl = Server.HTMLEncode(Request.ServerVariables("URL") & "?" & _ regEx.Replace(Request.ServerVariables("QUERY_STRING"), "")) ' Append the appropriate character to the ' query string If InStr(baseUrl, "?") < Len(baseUrl) Then baseUrl = baseUrl & "&" End If ' Get the previous and next page previousPage = page - 1 If Not page = lastPage Then nextPage = page + 1 Else nextPage = FALSE End If getPagination = "
" & VbCrLf & _ "

Page: " & page & "

" & VbCrLf ' Don't display pagination if only one page If lastPage = 1 Then getPagination = getPagination & "
" Exit Function End If getPagination = getPagination & "" & VbCrLf If previousPage Then getPagination = getPagination & "«" & VbCrLf & _ "Prev" & VbCrLf Else getPagination = getPagination & "" & _ "«" & VbCrLf & _ "Prev" & VbCrLf End If If page > 1 Then If page > 2 Then value = page - 2 Else value = 1 End If For value = value To page - 1 getPagination = getPagination & "" & value & "" & _ VbCrLf Next End If getPagination = getPagination & "" &_ page & "" & VbCrLf If page < lastPage Then If page + 2 > lastPage Then endValue = lastPage Else endValue = page + 2 End If For value = page + 1 To endValue getPagination = getPagination & "" & value & "" & _ VbCrLf Next End If If nextPage Then getPagination = getPagination & "Next" & VbCrLf & _ "»" & VbCrLf Else getPagination = getPagination & "" & _ "Next" & VbCrLf & _ "»" & VbCrLf End If getPagination = getPagination & "" & VbCrLf & "" End Function ' ' Checks if a string is in an array ' ' @param string $string The string to check for ' @param array $array The array to look in ' @return boolean ' Private Function inArray(ByRef string, ByRef array) On Error Resume Next Dim item For Each item In array If item = string Then inArray = TRUE Exit Function End If Next inArray = FALSE End Function ' ' Prints a message to the screen. ' ' NOTE: This function stops execution of the script. ' ' @param string title the title of the page ' @param string message the message to print to the screen ' @param boolean htmlEncode whether or not to encode the message ' @param string extraMessage an extra message ' Private Sub printMessage(ByRef title, ByRef message, ByRef htmlEncode, _ ByRef extraMessage) On Error Resume Next ' The title of the html-formatted page. Dim pageTitle ' Html-encode if necessary If htmlEncode Then message = "

" & Server.HTMLEncode(message) & "

" End If ' If the user has provided a title, format it for HTML If Not title = "" Then title = Server.HTMLEncode(title) pageTitle = title & " - " title = "

" & title & "

" End If If Not extraMessage = "" Then extraMessage = "

" & extraMessage & "

" End If Response.Write ("" & VbCrLf & _ "" & VbCrLf & _ "" & _ VbCrLf & VbCrLf & _ "" & VbCrLf & _ " " & pageTitle & "CoffeeCup Form Builder Manager" & VbCrLf & _ " " &_ VbCrLf & _ " " & VbCrLf & _ " " & VbCrLf & _ " " & VbCrLf & _ "" & VbCrLf & VbCrLf & _ "" & VbCrLf & _ "
" & VbCrLf & _ " " & title & VbCrLf & _ " " & extraMessage & VbCrLf & _ " " & message & VbCrLf & _ "
" & VbCrLf & _ "" & VbCrLf & VbCrLf & _ "") Response.End End Sub %>