<% if SESSION("UserID")="" then SESSION("MyURL")=request.ServerVariables("SCRIPT_NAME")&"?"&request.ServerVariables("QUERY_STRING") response.Redirect "login.asp?message=expired" response.End end if if not CheckSecurity(SESSION("_" & strTableName & "_OwnerID"),"Export") then response.Write "

" & "Non hai il permesso per accedere a questa tabella" & "" & "Torna alla pagina di login" & "

" response.End end if dbConnection="" db_connect() DoEvent "BeforeProcessExport dbConnection" options ="1" if request("a")<>"" then sWhere = "1=0" options ="" 'process selection set selected_recs = CreateObject("Scripting.Dictionary") if request("mdelete[]").Count>0 then for ind=1 to request("mdelete[]").Count set keys = CreateObject("Scripting.Dictionary") AddDict keys,"titolare",request("mdelete1[]").Item(request("mdelete[]").Item(ind)) AddDict selected_recs, ind, keys next elseif request("selection[]").Count>0 then for ind=1 to request("selection[]").Count set keys = CreateObject("Scripting.Dictionary") arr = split(request("selection[]").Item(ind) ,"&") if UBound(arr)-LBound(arr) = 1 - 1 then AddDict keys,"titolare", HTMLDecode(arr(0)) AddDict selected_recs, ind, keys end if next end if sr = selected_recs.Items for ind=1 to selected_recs.Count set keys = sr(ind-1) sWhere=sWhere & " or " sWhere=sWhere & KeyWhere(keys,"") next strSQL = gSQLWhereAdd(sWhere) strWhereClause=sWhere SESSION(strTableName & "_SelectedSQL") = strSQL SESSION(strTableName & "_SelectedWhere") = sWhere end if smarty.Add "options",options if SESSION(strTableName & "_SelectedSQL")<>"" and request.QueryString("records")="" then strSQL = SESSION(strTableName & "_SelectedSQL") strWhereClause=SESSION(strTableName & "_SelectedWhere") else strWhereClause=SESSION(strTableName & "_where") strSQL=gSQLWhereAdd(strWhereClause) end if mypage=1 if REQUEST("type")<>"" then Set rs = server.CreateObject("ADODB.Recordset") Set rss = server.CreateObject("ADODB.Recordset") strOrderBy=SESSION(strTableName & "_order") if strOrderBy="" then _ strOrderBy=gstrOrderBy strSQL= strSQL & " " & trim(strOrderBy) strSQLbak = strSQL DoEvent "BeforeQueryExport strSQL,strWhereClause,strOrderBy" ' Rebuild SQL if needed if strSQLbak <> strSQL then ' changed strSQL - old style numrows=GetRowCount(strSQL) else strSQL = gSQLWhereAdd(strWhereClause) strSQL= strSQL & " " & trim(strOrderBy) numrows=gSQLRowCount(strWhereClause) end if LogInfo(strSQL) '// pagination nPageSize=0 if REQUEST("records")="page" and numrows>0 then mypage=SESSION(strTableName & "_pagenumber") nPageSize=SESSION(strTableName & "_pagesize") if numrows<=(mypage-1)*nPageSize then mypage=int(numrows/nPageSize) end if if nPageSize="" then nPageSize=gPageSize if mypage="" then mypage=1 strSQL = AddTop(strSQL, mypage*nPageSize) end if rs.Open strSQL, dbConnection,1,2 if not rs.EOF then rs.Move(nPageSize*(mypage-1)) Server.ScriptTimeOut=300 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 elseif REQUEST("type")="pdf" then call ExportToPDF end if rs.Close response.End end if 'Response.AddHeader("Expires: Thu, 01 Jan 1970 00:00:01 GMT") smarty_display("titolare_export.htm") sub ExportToExcel() Response.ContentType = "application/vnd.ms-excel" Response.AddHeader "Content-Disposition", "attachment;Filename=titolare.xls" response.Write "" response.Write "" response.Write "" 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=titolare.doc" response.Write "" response.Write "" 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=titolare.xml" if rs.EOF then exit sub response.Write "" & vbcrlf response.Write "" & vbcrlf i=0 while (nPageSize=0 or i" & vbcrlf field=my_htmlspecialchars(XMLNameEncode("titolare")) response.Write "<" & field & ">" response.Write my_htmlspecialchars(GetData(rs,"titolare","")) response.Write "" & vbcrlf response.Write "" & vbcrlf i=i+1 rs.MoveNext wend response.Write "

" & vbcrlf end sub sub ExportToCSV Response.ContentType = "application/csv" Response.AddHeader "Content-Disposition", "attachment;Filename=titolare.csv" if rs.EOF then exit sub set totals = CreateObject("Scripting.Dictionary") '// write header outstr="" if outstr<>"" then outstr=outstr & "," outstr=outstr & """titolare""" response.Write outstr & vbcrlf '// write data rows iNumberOfRows = 0 while (nPageSize=0 or iNumberOfRows"" then outstr=outstr & "," fformat="" outstr=outstr & """" & my_htmlspecialchars(GetData(rs,"titolare",fformat)) & """" response.Write outstr & vbcrlf iNumberOfRows=iNumberOfRows+1 rs.MoveNext wend '// display totals first=true end sub sub WriteTableData if rs.EOF then exit sub '// write header response.Write "" if REQUEST("type")="excel" then response.Write "" & PrepareForExcel("titolare") & "" else response.Write "titolare" end if response.Write "" set totals = CreateObject("Scripting.Dictionary") '// write data rows iNumberOfRows = 0 while (nPageSize=0 or iNumberOfRows" if REQUEST("type")="excel" then response.Write "" else response.Write "" end if fformat="" if REQUEST("type")="excel" then response.Write PrepareForExcel(GetData(rs,"titolare",fformat)) else response.Write my_htmlspecialchars(GetData(rs,"titolare",fformat)) end if response.Write "" response.Write "" iNumberOfRows=iNumberOfRows+1 rs.MoveNext wend end sub function XMLNameEncode(strValue) dim arr(18) arr(0)=" " arr(1)="#" arr(2)="'" arr(3)="/" arr(4)="\\" arr(5)="(" arr(6)=")" arr(7)="," arr(8)="[" arr(9)="]" arr(10)="+" arr(11)="\""" arr(12)="-" arr(13)="_" arr(14)="|" arr(15)="}" arr(16)="{" arr(17)="=" dim strTemp strTemp=strValue for i=0 to ubound(arr) strTemp=replace(strTemp,arr(i),"") next XMLNameEncode = strTemp end function function PrepareForExcel(str) ret = my_htmlspecialchars(str) if mid(ret,1,1)= "=" then ret = "=" & mid(ret,2) PrepareForExcel = ret end function %> <% sub ExportToPDF Dim pdf Set pdf=CreateJsObject("FPDF") pdf.CreatePDF() pdf.SetPath("libs/fpdf/") pdf.SetFont "Courier","",8 pdf.Open() pdf.LoadModels("include/titolare_models.asp") pdf.AddPage() ' write data rows iNumberOfRows = 0 while (nPageSize=0 or iNumberOfRowspdf.maxheight then pdf.maxheight=pdf.GetY()-pdf.y0 end if ' draw lines x=pdf.leftmargin pdf.Rect x,pdf.y0,pdf.GetColWidth("titolare"),pdf.maxheight x=x+pdf.GetColWidth("titolare") pdf.y0 = pdf.y0+pdf.maxheight iNumberOfRows=iNumberOfRows+1 rs.MoveNext wend Response.ContentType = "application/pdf" Response.AddHeader "Content-Disposition", "attachment;Filename=titolare.pdf" pdf.Close() response.write pdf.buffer end sub sub OutputImage(img) response.binarywrite img end sub %>