<% '============================================================== ' TableEditoR 0.81 Beta ' http://www.2enetworx.com/dev/projects/tableeditor.asp '-------------------------------------------------------------- ' File: te_excel.asp ' Description: Displays all records from selected table in a spreadsheet ' Initiated By Pete Stucke on Apr 11, 2002 '-------------------------------------------------------------- ' Copyright (c) 2002, 2eNetWorX/dev. ' ' TableEditoR is distributed with General Public License. ' Any derivatives of this software must remain OpenSource and ' must be distributed at no charge. ' (See license.txt for additional information) ' ' See Credits.txt for the list of contributors. ' ' Change Log: '-------------------------------------------------------------- ' # Mar 26, 2001 by Hakan Eskici ' Added support for automatic primary key detection ' Added support for multiple primary keys ' # Mar 28, 2001 by Hakan Eskici ' Modified the recordset paging control ' # Mar 29, 2001 by Hakan Eskici ' Added support for SQL Server boolean values ' Modified request's to .form or .querystring ' Added support for deleting multiple records ' # May 22, 2002 By Rami Kattan ' Enabled response buffering, which increased performance by more then 2000% ' Made Server.ScriptTimeout dynamic, according to number of records to be exported. ' Check if browser is still connected, so not to use extra server resources ' Allow the functionality with non-javascript browsers ' Security check if user can export '============================================================== %> <% lConnID = request.querystring("cid") sTableName = request.querystring("tablename") sQuery = request.querystring("q") ExcelTableName = sTableName if instr(ucase(sTableName), "SELECT") then ExcelTableName = "QueryResult" end if sNoJscript = request.querystring("nojs") if sNoJscript = "1" then if not ValidSecurityID("Javaless_browser", request.querystring("SecID")) then response.write "Error: you must be logged on this site." response.end end if end if if not bAllowExport then %>

You have no permission to export data.

<% response.end end if if not te_debug then Response.ContentType = "application/vnd.ms-excel" else Response.ContentType = "text/html" end if if not te_debug then Response.AddHeader "content-disposition", "attachment; filename=" & ExcelTableName & ".xls" if sQuery <> "" then bQuery = True sTableName = replace(sTableName, """", "'") end if function isPrimaryKey(sFieldName) bPrimaryKey = False for iPK = 0 to ubound(aPrimaryKeys) if LCase(sFieldName) = LCase(aPrimaryKeys(iPK)) then bPrimaryKey = True exit for end if next isPrimaryKey = bPrimaryKey end function OpenRS arrConn(lConnID) 'Added by Hakan 'Find the primary key of the given table dim aPrimaryKeys if arrType(lConnID) = tedbAcess then set rsX = conn.openSchema(adSchemaPrimaryKeys) do while not rsX.eof if (rsX("table_name") = sTableName) then if sPrimaryKeyFieldName = "" then sPrimaryKeyFieldName = rsX("column_name") else sPrimaryKeyFieldName = sPrimaryKeyFieldName & "," & rsX("column_name") end if end if rsX.movenext loop rsX.close end if if (sPrimaryKeyFieldName = "") and (bQuery = False) then if arrType(lConnID) = tedbDsn then response.write "Automatic primary key detection is not possible for DSN Connections.

" else response.write "This table does not have any primary keys.

" end if else 'response.write "Primary key(s): " & sPrimaryKeyFieldName & "

" end if 'Set the primary key field to first field in the list by default if sPrimaryKeyFieldName = "" then sPrimaryKeyFieldName = 0 'Search Support Added by Kevin if request.form("cmdSearch") <> "" then bQuery = True 'Renamed cmdSubstring to chkSubstring if request.form("chkSubstring") <> "" then bSubstring = True end if 'For different data types, added enuming fields 'rather than form fields as Kevin did sSQL = "SELECT * FROM [" & sTableName & "] " on error resume next rs.Open sSQL,,,adCmdTable for each fld in rs.fields if request.form(fld.name) <> "" then sOP = " = " select case fld.type case adBoolean 'BUG: What if the user dont want to perform a distinction on the boolean field? 'Added by Hakan select case arrType(lConnID) case tedbSqlServer bTrue = "1" bFalse = "0" case else bTrue = "True" bFalse = "False" end select if len(request.form(fld.name))>0 then sFieldVal = bTrue else sFieldVal = bFalse case adLongVarBinary 'no search on OLE fields case adDate if isDate(request.form(fld.name)) then sFieldVal = "#" & request.form(fld.name) & "#" case adSmallInt, adInteger, adCurrency, adUnsignedTinyInt if isNumeric(request.form(fld.name)) then sFieldVal = request.form(fld.name) case else sFieldVal = "'" & replace(request.form(fld.name),"'", "") & "'" if bSubstring then sOp = " LIKE " sFieldVal = "'%" & request.form(fld.name) & "%'" else sFieldVal = "'" & request.form(fld.name) & "'" end if end select iSearchFieldCount = iSearchFieldCount + 1 if iSearchFieldCount = 1 then sWhere = " WHERE " & fld.name & " " & sOp & sFieldVal else sWhere = sWhere & " AND " & fld.name & " " & sOp & sFieldVal end if end if next sTableName = "SELECT * FROM [" & sTableName & "] " & sWhere rs.close end if if request.querystring("nojs") = "1" then sFieldValues = request.querystring("chkDel") sFieldNames = request.querystring("txtFieldName") sFieldTypes = request.querystring("txtFieldType") else sFieldValues = request.form("chkDel") sFieldNames = request.form("txtFieldName") sFieldTypes = request.form("txtFieldType") end if aFieldNames = split(sFieldNames, ";") aFieldTypes = split(sFieldTypes, ";") aFieldValues = split(sFieldValues, ",") select case arrType(lConnID) case tedbSQLServer sDateSeperator = "'" case else sDateSeperator = "#" end select if ubound(aFieldNames) >= 0 then sFieldName = aFieldNames(0) if ubound(aFieldTypes) >= 0 then lFieldType = CLng(aFieldTypes(0)) for iFld=0 to ubound(aFieldValues) sFieldValue = trim(aFieldValues(iFld)) select case lFieldType case adDate, adDBDate, adDBTime, adDBTimeStamp if isDate(sFieldValue) then sFieldValue = cDate(sFieldValue) sFieldValue = month(sFieldValue) & "/" & day(sFieldValue) & "/" & year(sFieldValue) end if if sWhereFields = "" then sWhereFields = "([" & sFieldName & "]=" & sDateSeperator & sFieldValue & sDateSeperator & ")" else sWhereFields = sWhereFields & " OR ([" & sFieldName & "]=" & sDateSeperator & sFieldValue & sDateSeperator & ")" end if case adTinyInt, adSmallInt, adInteger, adBigInt, adUnsignedTinyInt, adUnsignedSmallInt, adUnsignedInt, adUnsignedBigInt, adSingle, adDouble, adCurrency, adDecimal, adNumeric, adBoolean 'Added by Hakan 'Convert decimal point to dot if it's a comma sFieldValue = replace(sFieldValue, ",", ".") if sWhereFields = "" then sWhereFields = "([" & sFieldName & "]=" & sFieldValue & ")" else sWhereFields = sWhereFields & " OR ([" & sFieldName & "]=" & sFieldValue & ")" end if case else 'Added by Hakan 'Prepare SQL value by replacing single quote with two single quotes sFieldValue = replace(sFieldValue, "'", "''") if sWhereFields = "" then sWhereFields = "([" & sFieldName & "]='" & sFieldValue & "')" else sWhereFields = sWhereFields & " OR ([" & sFieldName & "]='" & sFieldValue & "')" end if end select next if sWhereFields <> "" then sWhere = " WHERE " & sWhereFields if request.form("excel_ordering") <> "" then sOrderBy = " ORDER BY [" & request.form("excel_ordering") & "] " select case request.form("excel_ordering_dir") case "DESC" sOrderBy = sOrderBy & " DESC" case else sOrderBy = sOrderBy & " ASC" end select end if if instr(lcase(sTableName), "order by") <> 0 then sOrderBy = "" end if 'Added by Danival 'Modified by Hakan bProc = request.querystring("proc") if instr(1, ucase(sTableName), "SELECT") then sSQL = sTableName & sOrderBy else if bProc <> "" then bRecAdd = False bRecEdit = False bRecDel = False sParamString = request.querystring("paramstring") sProcURL = "&proc=1¶mstring=" & sParamString sSQL = "EXEC [" & sTableName & "] " & sParamString else sSQL = "SELECT * FROM [" & sTableName & "]" & sWhere & sOrderBy end if end if on error resume next ' response.write "
" & sSQL & "
" rs.CursorLocation = adUseServer rs.Open sSQL, conn, adOpenStatic if err <> 0 then response.write "Error: " & err.description & "

" if bQuery then response.write "SQL : " & sSQL & "

" end if CloseRS response.end end if %> <% for each fld in rs.fields if fld.type <> adLongVarBinary then if request("orderby") = fld.name then if request("dir") = "asc" then sDirection = "desc" else sDirection = "asc" end if else sDirection = "asc" end if response.write "" else response.write "" end if 'Added by Hakan 'Support for automatic primary key detection 'Support for multiple primary keys aPrimaryKeys = split(sPrimaryKeyFieldName, ",") sPKFieldNames = "" sPKFieldValues = "" sPKFieldTypes = "" for iPK = 0 to ubound(aPrimaryKeys) if isNumeric(aPrimaryKeys(iPK)) then aPrimaryKeys(iPK) = 0 set fld = rs.fields(aPrimaryKeys(iPK)) if sPKFieldNames = "" then sPKFieldNames = fld.name else sPKFieldNames = sPKFieldNames & ";" & fld.name 'if sPKFieldValues = "" then sPKFieldValues = fld.value else sPKFieldValues = sPKFieldValues & ";" & fld.value if sPKFieldTypes = "" then sPKFieldTypes = fld.type else sPKFieldTypes = sPKFieldTypes & ";" & fld.type next next lRecs = rs.RecordCount TimeOutAfter = int(lRecs / 700) + 60 'on my computer (700 @ 889 MHz, 384 MB ram), it made 750 recs per second Server.ScriptTimeout = TimeOutAfter DoneLoops = 0 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' This column is necessary for the records to properly align with their respective column names... ' If anyone can figure something better out, please help. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ do while not rs.eof DoneLoops = DoneLoops + 1 if (DoneLoops MOD 100) = 0 then Response.Flush if not Response.IsClientConnected then exit do response.write "" for each fld in rs.fields response.write "" next response.write "" rs.movenext loop CloseRS %>
" response.write fld.name response.write "" response.write "" response.write fld.name response.write "
" select case fld.type case adSmallInt, adInteger response.write rs(fld.name) case adDate if isdate(rs(fld.name)) then response.write rs(fld.name) end if case adBoolean if rs(fld.name)=true then response.write "True" else response.write "False" end if case adLongVarBinary Response.write "EXCEL EXPORTER: Currently OLE Data not supported" case adVarWChar, adLongVarWChar 'Text, Memo sVal = rs(fld.name) if (bEncodeHTML) and (len(sVal) > 0)then response.write server.htmlencode(sVal) else response.write sVal end if case else response.write rs(fld.name) end select response.write "