<% OPTION Explicit ' Generic Database - List Records in CSV format ' Notice: (c) 2000 Eli Robillard, All Rights Reserved. ' E-Mail: erobillard@ofifc.org ' URL: http://www.ofifc.org/Eli/ASP/ ' Revision History: ' 08 Jun 2000 - Excel view supported, use Session("dbExcel") = 1 ' 08 Feb 2000 - Proper variable declarations, Option Explicit ' Display an ascii text file (better for saving) ' 08 Feb 2000 - Translate < and > to < and > to remove embedded html security hole ' 05 Feb 2000 - Optimised based on suggestions of Koos Bezemer ' Strip CR's and LF's from strings ' 21 Jan 2000 - First created On Error Resume Next Response.Expires = 0 Response.Buffer = True ' Quick security check, make sure we have an active session If (Session("dbRs") & "x" = "x") AND ((Session("dbCSV") <> 1) OR (Session("dbExcel") <> 1)) OR (Request.QueryString("DISP").Count < 1) Then Response.Clear Response.Redirect "GenericError.asp" End If ' Declare vars DIM QUOTE, DELIMITER DIM curVal, iLine, sLine, xConn, xRs, x, y, z, xField DIM aFields(), arrFieldNames DIM strEditor, strType, strConn, strDisplay, strFormat, strSearchFields, strSearchPos, strsql, strFields, strTable, strWhere, strGroupBy, strHaving, strOrderBy, strFieldNames, strFont, strBorderColor, strMenuColor DIM intAllowSort, intCSVQuotes, intFieldCount, intFontSize, intOrderBy, intPrimary, intTotalRecs QUOTE = chr(34) select case Request.QueryString("DISP") case "EXCEL" Response.Clear Response.ContentType = "application/x-msexcel" DELIMITER = chr(ascB(" ")) intCSVQuotes = 0 case "CSV" Response.Clear Response.ContentType = "text/plain" DELIMITER = "," if Session("dbCSVQuotes") = 1 then intCSVQuotes = 1 end select ' Get the settings from the Config File strType = UCase(Session("dbType")) strConn = Session("dbConn") strDisplay = Session("dbDispList") strSearchFields = Session("dbSearchFields") strSearchPos = UCase(Trim(Session("dbSearchPos"))) strFields = Session("dbFields") strTable = Session("dbRs") strWhere = Session("dbWhere") strGroupBy = Session("dbGroupBy") strHaving = Session("dbHaving") strOrderBy = Session("dbOrderBy") strFieldNames = Session("dbFieldNames") intOrderBy = Session("dbOrder") intPrimary = Session("dbKey") Session("ErrorNumber") = 0 ' Is a field list provided If Trim(strFields) & "x" = "x" Then strFields = "*" Session("dbFields") = "*" End If ' Check for an Order parameter If Request.QueryString("ORDER").Count > 0 Then ' Check if an ASC/DESC toggle is required (- for desc, + for asc) if abs(intOrderBy) = abs(Request.QueryString("ORDER")) then intOrderBy = 0 - intOrderBy else intOrderBy = Request.QueryString("ORDER") end if Session("dbOrder") = intOrderBy End If ' Open Connection to the database set xConn = Server.CreateObject("ADODB.Connection") xConn.Open strConn ' Build query and open recordset strsql = "SELECT " & strFields & " FROM [" & strTable & "]" Select Case strType Case "UDF" strsql = "SELECT " & strFields & " FROM " & strTable Case "SQL" strsql = Replace(strsql,"[","") strsql = Replace(strsql,"]","") End Select If NOT Trim(strWhere) & "x" = "x" Then strsql = strsql & " WHERE " & strWhere If NOT Trim(strGroupBy) & "x" = "x" Then strsql = strsql & " GROUP BY " & strGroupBy If NOT Trim(strHaving) & "x" = "x" Then strsql = strsql & " HAVING " & strHaving If intOrderBy <> 0 Then ' Order selected by clicking on column header or with dbOrder if intOrderBy > 0 then strsql = strsql & " ORDER BY " & intOrderBy else strsql = strsql & " ORDER BY " & abs(intOrderBy) & " DESC" end if Else ' See if a dbOrderBy string was passed. If NOT Trim(strOrderBy) & "x" = "x" Then strsql = strsql & " ORDER BY " & strOrderBy End If ' Run query set xrs = Server.CreateObject("ADODB.Recordset") xrs.Open strsql, xConn, 1, 2 If Err.Number <> 0 Then ' Call Error Handler if query bombs Session("ErrNumber") = Err.Number Session("ErrDesc") = Err.Description Session("ErrSource") = Err.Source Session("ErrLine") = Err.Line Session("ErrMsg") = "Query: " & strsql Response.Clear Response.Redirect "GenericError.asp" End If intFieldCount = xrs.Fields.Count intTotalRecs = xrs.RecordCount ReDim aFields(intFieldCount,3) ' Get field info If Trim(Session("dbFieldNames")) & "x" = "x" Then ReDim arrFieldNames(intFieldCount) For x = 1 to intFieldCount aFields(x,1) = xrs.Fields(x-1).Name aFields(x,2) = xrs.Fields(x-1).Type aFields(x,3) = xrs.Fields(x-1).DefinedSize arrFieldNames(x-1) = xrs.Fields(x-1).Name Next Else For x = 1 to intFieldCount aFields(x,1) = xrs.Fields(x-1).Name aFields(x,2) = xrs.Fields(x-1).Type aFields(x,3) = xrs.Fields(x-1).DefinedSize Next arrFieldNames = Split(Session("dbFieldNames"), ",") End If %> <% ' Build the first line -- the list of field names sLine = "" For x = 1 to intFieldCount If Mid(strDisplay, x, 1) = "1" Then ' If field is to be displayed ' Add the field name to sLine sLine = sLine & LTrim(arrFieldNames(x-1)) & DELIMITER End If Next ' Get rid of the rightmost comma iLine = Len(sLine) sLine = mid(sLine, 1, iLine-Len(DELIMITER)) ' Display the line Response.Write sLine & chr(13) & chr(10) ' Display the records, one on each line. Note the similarity to the section above. Do While NOT xrs.EOF x = 0 sLine = "" For Each xField in xrs.Fields x = x + 1 curVal = xField.Value If Mid(strDisplay, x, 1) = "1" Then ' If Empty If IsNull(curVal) OR (Trim(curVal) & "x" = "x") Then curVal = "" ' Password If UCase(Left(aFields(x,1),8)) = "PASSWORD" Then curVal = "*****" if intCSVQuotes = 1 Then Select Case aFields(x,2) Case 129, 130, 200, 201, 202, 204 ' String curVal = QUOTE & curVal & QUOTE End Select End If ' Remove linefeeds Select Case aFields(x,2) Case 129, 130, 200, 201, 202, 204 ' String curVal = Replace(curVal,chr(10)," ") curVal = Replace(curval,chr(13)," ") End Select sLine = sLine & curVal & DELIMITER ' End If Next xrs.MoveNext iLine = Len(sLine) sLine = mid(sLine, 1, iLine-Len(DELIMITER)) Response.Write sLine & chr(13) & chr(10) Loop ' Close recordset and connection xrs.Close Set xrs = Nothing xConn.Close Set xConn = Nothing Response.Flush Response.End %>