<%@ Language=VBScript %> <% if Request("type")<>"" then set dbConnection = server.CreateObject ("ADODB.Connection") dbConnection.ConnectionString = strConnection dbConnection.Open strSQL = Session(strTableName & "SQL") sWhere = "" if Instr(lcase(strSQL), " where ") > 1 then sWhere = Mid(strSQL, Instr(lcase(strSQL), " where ")) strSQL="select " & AddWrappers("ID") & ", " & AddWrappers("Username") & ", " & AddWrappers("Password") & ", " & AddWrappers("accesso") & ", " & AddWrappers("lista") & ", " & AddWrappers("pin") & ", " if Right(strSQL,2)= ", " then strSQL = Left(strSQL, Len(strSQL)-2) strSQL = strSQL & " from " & strTableName & sWhere Set rs = server.CreateObject ("ADODB.Recordset") rs.Open strSQL, dbConnection if Request("records")="page" then ' Pagination: if NOT rs.EOF then mypage = Request("mypage") rs.PageSize = Request("pagesize") maxRecords = cdbl(rs.RecordCount) maxPages=cdbl(rs.PageCount) if cdbl(mypage) > cdbl(maxPages) then mypage = maxpages End IF rs.AbsolutePage = mypage maxrecs=cdbl(rs.pagesize) End IF end if Response.Expires=0 ' prevent caching Response.Buffer=True Server.ScriptTimeout = 120 if Request("type")="excel" then Call ExportToExcel elseif Request("type")="word" then Call ExportToWord elseif Request("type")="xml" then Call ExportToXML elseif Request("type")="csv" then Call ExportToCSV end if rs.Close set rs=Nothing dbConnection.Close set dbConnection = Nothing Response.Flush Response.End else %>
> >
Seleziona Formato uscita
Tutti i records
Solo questa pagina
Excel
Word
CSV (separati da virgolette)
XML
<% Response.End end if Sub ExportToExcel Response.ContentType = "application/vnd.ms-excel" Response.AddHeader "Content-Disposition", "attachment; Filename=Admins.xls" Response.Write "" Response.Write "" Call WriteTableData Response.Write "
" Response.Write "" Response.Write "" End Sub Sub ExportToWord Response.ContentType = "application/vnd.ms-word" Response.AddHeader "Content-Disposition", "attachment; Filename=Admins.doc" Response.Write "" Response.Write "" Call WriteTableData Response.Write "
" Response.Write "" Response.Write "" End Sub Sub ExportToXML Response.ContentType = "text/xml" Response.addheader "Content-Disposition", "attachment; Filename=Admins.xml" 'Const adPersistXML = 1 'rs.Save Response, adPersistXML if rs.eof then exit sub set xmlDocument = Server.CreateObject("MSXML.DOMDocument") set xmlRoot = xmlDocument.createElement(cXMLTopNode) ' write data rows iNumberOfRows = 0 DO UNTIL rs.eof OR ( iNumberOfRows>=CInt(Request("pagesize")) and _ Request("records")="page" ) Set xmlRow = xmlDocument.createElement(cXMLRowNode) call xmlRoot.appendChild(xmlRow) strData = GetData(rs.Fields("ID"), "") str = strData Set xmlField = xmlDocument.createElement(XMLNameEncode(Label(rs.Fields("ID").Name))) if str = "" or isNull(str) then str="" xmlField.Text = Replace(str, chr(149), "") Call xmlRow.AppendChild(xmlField) strData = GetData(rs.Fields("Username"), "") str = strData Set xmlField = xmlDocument.createElement(XMLNameEncode(Label(rs.Fields("Username").Name))) if str = "" or isNull(str) then str="" xmlField.Text = Replace(str, chr(149), "") Call xmlRow.AppendChild(xmlField) strData = GetData(rs.Fields("Password"), "") str = strData Set xmlField = xmlDocument.createElement(XMLNameEncode(Label(rs.Fields("Password").Name))) if str = "" or isNull(str) then str="" xmlField.Text = Replace(str, chr(149), "") Call xmlRow.AppendChild(xmlField) strData = GetData(rs.Fields("accesso"), "") str = strData Set xmlField = xmlDocument.createElement(XMLNameEncode(Label(rs.Fields("accesso").Name))) if str = "" or isNull(str) then str="" xmlField.Text = Replace(str, chr(149), "") Call xmlRow.AppendChild(xmlField) strData = GetData(rs.Fields("lista"), "") str = strData Set xmlField = xmlDocument.createElement(XMLNameEncode(Label(rs.Fields("lista").Name))) if str = "" or isNull(str) then str="" xmlField.Text = Replace(str, chr(149), "") Call xmlRow.AppendChild(xmlField) strData = GetData(rs.Fields("pin"), "") str = strData Set xmlField = xmlDocument.createElement(XMLNameEncode(Label(rs.Fields("pin").Name))) if str = "" or isNull(str) then str="" xmlField.Text = Replace(str, chr(149), "") Call xmlRow.AppendChild(xmlField) Response.Write vbCRLF rs.MoveNext iNumberOfRows = iNumberOfRows + 1 loop Response.Write "" & vbcrlf & xmlRoot.xml End Sub Sub ExportToCSV Response.ContentType = "application/csv" Response.addheader "Content-Disposition", "attachment; Filename=Admins.csv" if rs.eof then exit sub ' write header for i=0 to rs.Fields.Count-1 Response.Write """" & Label(rs.Fields(i).Name) & """" if i<>rs.Fields.Count-1 then Response.Write ", " next Response.Write vbCRLF ' write data rows iNumberOfRows = 0 DO UNTIL rs.eof OR ( iNumberOfRows>=CInt(Request("pagesize")) and _ Request("records")="page" ) i = 0 strData = GetData(rs.Fields("ID"), "") Response.Write """" & strData & """" if i" for i=0 to rs.Fields.Count-1 Response.Write "" & Label(rs.Fields(i).Name) & "" next Response.Write "" ' write data rows iNumberOfRows = 0 DO UNTIL rs.eof OR ( iNumberOfRows>=CInt(Request("pagesize")) and _ Request("records")="page" ) Response.Write "" strData = GetData(rs.Fields("ID"), "") if Request("type")="excel" and IfNeedQuotes(rs.Fields("ID").Type) and _ IsNumeric(GetData(rs.Fields("ID"), Format(rs.Fields("ID").Name))) then Response.Write "=""" & strData & """" else Response.Write "" & strData & "" end if strData = GetData(rs.Fields("Username"), "") if Request("type")="excel" and IfNeedQuotes(rs.Fields("Username").Type) and _ IsNumeric(GetData(rs.Fields("Username"), Format(rs.Fields("Username").Name))) then Response.Write "=""" & strData & """" else Response.Write "" & strData & "" end if strData = GetData(rs.Fields("Password"), "") if Request("type")="excel" and IfNeedQuotes(rs.Fields("Password").Type) and _ IsNumeric(GetData(rs.Fields("Password"), Format(rs.Fields("Password").Name))) then Response.Write "=""" & strData & """" else Response.Write "" & strData & "" end if strData = GetData(rs.Fields("accesso"), "") if Request("type")="excel" and IfNeedQuotes(rs.Fields("accesso").Type) and _ IsNumeric(GetData(rs.Fields("accesso"), Format(rs.Fields("accesso").Name))) then Response.Write "=""" & strData & """" else Response.Write "" & strData & "" end if strData = GetData(rs.Fields("lista"), "") if Request("type")="excel" and IfNeedQuotes(rs.Fields("lista").Type) and _ IsNumeric(GetData(rs.Fields("lista"), Format(rs.Fields("lista").Name))) then Response.Write "=""" & strData & """" else Response.Write "" & strData & "" end if strData = GetData(rs.Fields("pin"), "") if Request("type")="excel" and IfNeedQuotes(rs.Fields("pin").Type) and _ IsNumeric(GetData(rs.Fields("pin"), Format(rs.Fields("pin").Name))) then Response.Write "=""" & strData & """" else Response.Write "" & strData & "" end if Response.Write "" rs.MoveNext iNumberOfRows = iNumberOfRows + 1 loop End Sub Function XMLNameEncode(strValue) XMLNameEncode = Replace(strValue, " ", "") XMLNameEncode = Replace(XMLNameEncode, "#", "") XMLNameEncode = Replace(XMLNameEncode, "'", "") XMLNameEncode = Replace(XMLNameEncode, "/", "") XMLNameEncode = Replace(XMLNameEncode, "\", "") XMLNameEncode = Replace(XMLNameEncode, "(", "") XMLNameEncode = Replace(XMLNameEncode, ")", "") XMLNameEncode = Replace(XMLNameEncode, ",", "") XMLNameEncode = Replace(XMLNameEncode, "[", "") XMLNameEncode = Replace(XMLNameEncode, "]", "") XMLNameEncode = Replace(XMLNameEncode, "+", "") XMLNameEncode = Replace(XMLNameEncode, """", "") XMLNameEncode = Replace(XMLNameEncode, "-", "") XMLNameEncode = Replace(XMLNameEncode, "_", "") XMLNameEncode = Replace(XMLNameEncode, "|", "") XMLNameEncode = Replace(XMLNameEncode, "}", "") XMLNameEncode = Replace(XMLNameEncode, "{", "") End Function %>