Code Snippet
Public Sub Execute(ByVal strRPT As String, ByVal strTipo As String, ByVal ParamArray
strParam() As String)
Protected WithEvents rpt As New CrystalDecisions.CrystalReports.Engine.ReportDocument
Dim strStream As System.IO.Stream = Nothing
Dim strFileName As String = ""
rpt.Load(Server.MapPath("rpts/" & strRPT & ".rpt"))
SetaConexao() 'desconsidere esta rotina. apenas seta a conexao
If (Request("param") <> String.Empty) Then
SetaParametros(String.Join("|", strParam))
End If
If strTipo = "" Then strTipo = "1"
Select Case strTipo
Case "0" 'PDF
strStream = rpt.ExportToStream(ExportFormatType.PortableDocFormat)
strFileName = String.Format("{0}-{1:yyyyMMdd}.pdf", strRPT, Now)
Case "1" 'WORD
strStream = rpt.ExportToStream(ExportFormatType.WordForWindows)
strFileName = String.Format("{0}-{1:yyyyMMdd}.doc", strRPT, Now)
Case "2" 'EXCEL
strStream = rpt.ExportToStream(ExportFormatType.Excel)
strFileName = String.Format("{0}-{1:yyyyMMdd}.xls", strRPT, Now)
End Select
Dim oBuff(CInt(strStream.Length)) As Byte
strStream.Read(oBuff, 0, CInt(strStream.Length))
With Response
.ClearContent()
.ClearHeaders()
.Buffer = True
.BinaryWrite(oBuff)
.AppendHeader("Content-Disposition", String.Format("attachment;filename={0}", strFileName))
.Flush()
.Close()
End With
End Sub
Private Sub SetaConexao()
If rpt.Database.Tables.Count > 0 Then
Dim logOnInfo As New TableLogOnInfo
Dim crSections As Sections
Dim crSection As Section
Dim crReportObjects As ReportObjects
Dim crReportObject As ReportObject
Dim crSubreportObject As SubreportObject
Dim oSubRpt As New ReportDocument
Dim crDatabase As Database
Dim crTables As Tables
Dim crTable As Table
Dim connectionInfo As ConnectionInfo
For Each crTable In rpt.Database.Tables
connectionInfo = New ConnectionInfo
connectionInfo.ServerName = ConfigurationManager.AppSettings("RPT.ServerName")
connectionInfo.DatabaseName = ConfigurationManager.AppSettings("RPT.DatabaseName")
connectionInfo.UserID = ConfigurationManager.AppSettings("RPT.UserID")
connectionInfo.Password = ConfigurationManager.AppSettings("RPT.Password")
logOnInfo = crTable.LogOnInfo
logOnInfo.ConnectionInfo = connectionInfo
crTable.ApplyLogOnInfo(logOnInfo)
If crTable.Name = crTable.Location Then
crTable.Location = connectionInfo.DatabaseName & ".dbo." & crTable.Location.Substring(crTable.Location.LastIndexOf(".") + 1)
End If
Next
'Set the sections collection with report sections
crSections = rpt.ReportDefinition.Sections
'Loop through each section and find all the report objects
'Loop through all the report objects to find all subreport objects, then set the
'logoninfo to the subreport
For Each crSection In crSections
crReportObjects = crSection.ReportObjects
For Each crReportObject In crReportObjects
If crReportObject.Kind = ReportObjectKind.SubreportObject Then
'If you find a subreport, typecast the reportobject to a subreport object
crSubreportObject = CType(crReportObject, SubreportObject)
'Open the subreport
oSubRpt = crSubreportObject.OpenSubreport(crSubreportObject.SubreportName)
crDatabase = oSubRpt.Database
crTables = crDatabase.Tables
'Loop through each table and set the connection info
'Pess the connection info to the logoninfo object then apply the
'logoninfo to the subreport
For Each crTable In crTables
connectionInfo = New ConnectionInfo
connectionInfo.DatabaseName = ConfigurationManager.AppSettings("RPT.DatabaseName")
connectionInfo.ServerName = ConfigurationManager.AppSettings("RPT.ServerName")
connectionInfo.Password = ConfigurationManager.AppSettings("RPT.Password")
connectionInfo.UserID = ConfigurationManager.AppSettings("RPT.UserID")
logOnInfo = crTable.LogOnInfo
logOnInfo.ConnectionInfo = connectionInfo
crTable.ApplyLogOnInfo(logOnInfo)
If crTable.Name = crTable.Location Then
crTable.Location = connectionInfo.DatabaseName & ".dbo." & crTable.Location.Substring(crTable.Location.LastIndexOf(".") + 1)
End If
Next
End If
Next
Next
End If
End Sub
Private Sub SetaParametros(ByVal strParam As String)
Dim strQte As Integer
Dim strParametros(), strItensParametros() As String
Dim oPf As ParameterValues
Dim oPv As ParameterDiscreteValue
Dim i As Integer = 0
Dim j As Integer = 0
strQte = strParam.Split(CChar("|")).Length
'SETA OS PARÂMETROS
If strQte > 0 Then
strParametros = strParam.Split(CChar("|"))
For i = 0 To strQte - 1
strItensParametros = Split(strParametros(i), ",")
'parametros com multiplos valores
If False AndAlso strItensParametros.Length > 1 Then
oPf = New ParameterValues
For j = 0 To strItensParametros.Length - 1
oPv = New ParameterDiscreteValue
oPv.Value = strItensParametros(j)
' If oPv.Value = "" Then oPv.Value = "null"
oPf.Add(oPv)
Next
Else
oPf = New ParameterValues
oPv = New ParameterDiscreteValue
oPv.Value = strParametros(i)
'If oPv.Value = "" Then oPv.Value = "null"
oPf.Add(oPv)
End If
rpt.DataDefinition.ParameterFields(i).ApplyCurrentValues(oPf)
Next
End If
oPf = Nothing : oPv = Nothing
End Sub
