Imports Microsoft.VisualBasic
Imports CrystalDecisions.CrystalReports.Engine
Imports CrystalDecisions.Shared
Public Class CrPdf
#Region "Get CR No param"
'''
''' Get Report with one parameter and Auto set Logo path, Logo.pdf must be in Reports folder.
'''
''' e.g:Me
''' Report name in Reports Folder
'''
Sub GetCr(ByVal sender As System.Web.UI.Control, ByVal reportName As String)
Dim report As New ReportDocument
Dim pf As ParameterField
report.Load(sender.Page.MapPath("../Reports/" & reportName))
'report.SetParameterValue(pName, pVal)
For Each pf In report.ParameterFields
If pf.Name = "Logo" Then
'Set LogoPath
SetLogoPath(sender, report)
'Define Logon to DB
End If
Next
'Display report
DefineLogon(report)
DisplayReportAsPDF(sender, report)
End Sub
#End Region
#Region "Get CR 1 param"
'''
''' Get Report with one parameter and Auto set Logo path, Logo.pdf must be in Reports folder.
'''
''' e.g:Me
''' Report name in Reports Folder
''' Parameter Name
''' Parameter Value in String
'''
Sub GetCr(ByVal sender As System.Web.UI.Control, ByVal reportName As String, ByVal pName As String, ByVal pVal As String)
Dim report As New ReportDocument()
Dim pf As ParameterField
report.Load(sender.Page.MapPath("../Reports/" & reportName))
report.SetParameterValue(pName, pVal)
For Each pf In report.ParameterFields
If pf.Name = "Logo" Then
'Set LogoPath
SetLogoPath(sender, report)
'Define Logon to DB
End If
Next
'Display report
DefineLogon(report)
DisplayReportAsPDF(sender, report)
End Sub
#End Region
#Region "Get Cr Array param"
'''
''' Get pdf report and send to browser
'''
''' e.g:me
''' Report name with Folder e.g: "../Reports/report1.rpt"
''' Array of parameter seperate with "," e.g: p(0)= "ClassName,1/1"
'''1(Default)=pdf, 2=Excel, 3=Word
'''
'''
Sub GetCr(ByVal sender As System.Web.UI.Control, ByVal reportName As String, ByVal param As Array, Optional ByVal ReportType As Integer = 1)
Try
Dim report As New ReportDocument()
report.Load(sender.Page.MapPath(reportName))
'Apply Parameter
Dim i, L As Integer
Dim reportParam As ParameterField
For i = 0 To param.Length - 1
L = InStr(param(i), ",")
If param(i) <> Nothing Then
Dim pName As String = Left(param(i), L - 1)
Dim pVal = Mid(param(i), L + 1)
For Each reportParam In report.ParameterFields
If reportParam.Name = pName Then
Select Case report.ParameterFields(pName).ParameterValueType
Case Is = ParameterValueKind.StringParameter
pVal = CType(pVal, String)
Case Is = ParameterValueKind.NumberParameter
pVal = CType(pVal, Integer)
Case Is = ParameterValueKind.DateParameter
pVal = CType(pVal, Date)
End Select
report.SetParameterValue(pName, pVal)
End If
Next
End If
Next
'Define logon
DefineLogon(report)
'Display report
Select Case ReportType
Case 1
DisplayReportAsPDF(sender, report)
Case 2
DisplayReportAsExcel(sender, report)
Case 3
DisplayReportAsWord(sender, report)
End Select
Catch ex As Exception
Dim errMsg As String = ex.Message.Replace(Chr(13).ToString(), "").Replace(Chr(10).ToString(), "")
errMsg += " Please modify the button click function in your code-behind."
BaseClasses.Utils.MiscUtils.RegisterJScriptAlert(sender, "BUTTON_CLICK_MESSAGE", errMsg)
End Try
End Sub
#End Region
#Region "Set Logo Path"
Sub SetLogoPath(ByVal sender As System.Web.UI.Control, ByVal report As CrystalDecisions.CrystalReports.Engine.ReportDocument)
Dim path As String = sender.Page.MapPath("../Reports/")
For Each parameterField In report.ParameterFields
If parameterField.Name = "Logo" Then
path = path & "logo.jpg"
report.SetParameterValue("Logo", path)
End If
Next
End Sub
#End Region
#Region "Get Local Path"
'''
''' Get local path.
'''
''' sender=me
''' ../Folder/filename
''' Local Path
'''
Function GetLocalPath(ByVal sender As System.Web.UI.Control, ByVal PathName As String) As String
Dim path As String = sender.Page.MapPath(PathName)
Return path
End Function
#End Region
#Region "Define Logon DB_Old (Not Used)"
Sub DefineLogon_Old(ByVal report As ReportDocument)
''define and locate required objects for db login
Dim db As CrystalDecisions.CrystalReports.Engine.Database = report.Database
Dim tables As CrystalDecisions.CrystalReports.Engine.Tables = db.Tables
Dim tableLoginInfo As CrystalDecisions.Shared.TableLogOnInfo = New CrystalDecisions.Shared.TableLogOnInfo()
''define connection information
Dim dbConnInfo As CrystalDecisions.Shared.ConnectionInfo = New CrystalDecisions.Shared.ConnectionInfo()
dbConnInfo.UserID = "esp"
dbConnInfo.Password = "somchartpete"
'dbConnInfo.ServerName = "(local)" 'Environment.MachineName
'Replace ServerName by Web.config
Dim configString As String = System.Configuration.ConfigurationManager.AppSettings("DatabaseLibrary1").ToString
Dim SQLServerName As String = Mid(configString, InStr(configString, "=") + 1, InStr(configString, ";") - InStr(configString, "=") - 1)
dbConnInfo.ServerName = SQLServerName
''apply connection information to each table
Dim table As CrystalDecisions.CrystalReports.Engine.Table
For Each table In tables
tableLoginInfo = table.LogOnInfo
tableLoginInfo.ConnectionInfo = dbConnInfo
table.ApplyLogOnInfo(tableLoginInfo)
Next
End Sub
#End Region
#Region "Define Logon DB"
Sub DefineLogon(ByVal report As ReportDocument)
''define and locate required objects for db login
Dim db As CrystalDecisions.CrystalReports.Engine.Database = report.Database
Dim tables As CrystalDecisions.CrystalReports.Engine.Tables = db.Tables
Dim tableLoginInfo As CrystalDecisions.Shared.TableLogOnInfo = New CrystalDecisions.Shared.TableLogOnInfo()
''define connection information
Dim dbConnInfo As CrystalDecisions.Shared.ConnectionInfo = New CrystalDecisions.Shared.ConnectionInfo()
'Dim configString As String = System.Configuration.ConfigurationManager.AppSettings("DatabaseLibrary1").ToString
Dim configString As String = System.Configuration.ConfigurationManager.ConnectionStrings("DatabasePersons1").ToString
'For Each item In System.Configuration.ConfigurationManager.AppSettings
'Next
'dbConnInfo.UserID = "esp"
'dbConnInfo.Password = "somchartpete"
'dbConnInfo.ServerName = "(local)" 'Environment.MachineName
'configString = "Data Source=sqlcluster\obecdb1;Database=Library;Trusted_Connection=no;User Id=obeceis;Password=bopp@52"
Dim x() As String = configString.Split(";")
For Each y In x
If InStr(y, "Data Source") <> 0 Then
dbConnInfo.ServerName = Mid(y, InStr(y, "=") + 1)
End If
If InStr(y, "Database") <> 0 Then
dbConnInfo.DatabaseName = Mid(y, InStr(y, "=") + 1)
End If
If InStr(y, "User Id") <> 0 Then
dbConnInfo.UserID = Mid(y, InStr(y, "=") + 1)
End If
If InStr(y, "Password") <> 0 Then
dbConnInfo.Password = Mid(y, InStr(y, "=") + 1)
End If
Next
''apply connection information to each table
Dim table As CrystalDecisions.CrystalReports.Engine.Table
For Each table In tables
tableLoginInfo = table.LogOnInfo
tableLoginInfo.ConnectionInfo = dbConnInfo
table.ApplyLogOnInfo(tableLoginInfo)
Next
report.DataSourceConnections(0).SetConnection(dbConnInfo.UserID, dbConnInfo.Password, dbConnInfo.ServerName, dbConnInfo.DatabaseName)
End Sub
#End Region
#Region " ShowCrystalReport"
'''
'''Override the CrystalReportButton_Click and call DisplayReportAsPDF_CrystalReportButton function
'''
'''
Private Sub DisplayReportAsPDF(ByVal sender As System.Web.UI.Control, _
ByVal reportObject As CrystalDecisions.CrystalReports.Engine.ReportDocument)
Try
' Export as a stream
Dim stream As System.IO.Stream = reportObject.ExportToStream(CrystalDecisions.Shared.ExportFormatType.PortableDocFormat)
'Dim stream As System.IO.Stream = reportObject.ExportToStream(CrystalDecisions.Shared.ExportFormatType.WordForWindows)
'Dim stream As System.IO.Stream = reportObject.ExportToStream(CrystalDecisions.Shared.ExportFormatType.Excel)
Dim content() As Byte = New Byte(Convert.ToInt32(stream.Length)) {}
stream.Read(content, 0, content.Length)
'output as an attachment
' BaseClasses.Utils.NetUtils.WriteResponseBinaryAttachment(sender.Page.Response, "report.pdf", content, 0, True)
BaseClasses.Utils.NetUtils.WriteResponseBinaryAttachment(sender.Page.Response, "report.pdf", content, 0, True)
'BaseClasses.Utils.NetUtils.WriteResponseBinaryAttachment(sender.Page.Response, "report.xls", content, 0, True)
'BaseClasses.Utils.NetUtils.WriteResponseBinaryAttachment(sender.Page.Response, "report.doc", content, 0, True)
Catch ex As Exception
Dim errMsg As String = ex.Message.Replace(Chr(13).ToString(), "").Replace(Chr(10).ToString(), "")
errMsg += " Please modify the button click function in your code-behind."
BaseClasses.Utils.MiscUtils.RegisterJScriptAlert(sender, "BUTTON_CLICK_MESSAGE", errMsg)
End Try
End Sub
Private Sub DisplayReportAsExcel(ByVal sender As System.Web.UI.Control, _
ByVal reportObject As CrystalDecisions.CrystalReports.Engine.ReportDocument)
Try
' Export as a stream
Dim stream As System.IO.Stream = reportObject.ExportToStream(CrystalDecisions.Shared.ExportFormatType.Excel)
Dim content() As Byte = New Byte(Convert.ToInt32(stream.Length)) {}
stream.Read(content, 0, content.Length)
'output as an attachment
' BaseClasses.Utils.NetUtils.WriteResponseBinaryAttachment(sender.Page.Response, "report.pdf", content, 0, True)
BaseClasses.Utils.NetUtils.WriteResponseBinaryAttachment(sender.Page.Response, "report.xls", content, 0, True)
'BaseClasses.Utils.NetUtils.WriteResponseBinaryAttachment(sender.Page.Response, "report.doc", content, 0, True)
Catch ex As Exception
Dim errMsg As String = ex.Message.Replace(Chr(13).ToString(), "").Replace(Chr(10).ToString(), "")
errMsg += " Please modify the button click function in your code-behind."
BaseClasses.Utils.MiscUtils.RegisterJScriptAlert(sender, "BUTTON_CLICK_MESSAGE", errMsg)
End Try
End Sub
Private Sub DisplayReportAsWord(ByVal sender As System.Web.UI.Control, _
ByVal reportObject As CrystalDecisions.CrystalReports.Engine.ReportDocument)
Try
' Export as a stream
Dim stream As System.IO.Stream = reportObject.ExportToStream(CrystalDecisions.Shared.ExportFormatType.WordForWindows)
Dim content() As Byte = New Byte(Convert.ToInt32(stream.Length)) {}
stream.Read(content, 0, content.Length)
'output as an attachment
' BaseClasses.Utils.NetUtils.WriteResponseBinaryAttachment(sender.Page.Response, "report.pdf", content, 0, True)
'BaseClasses.Utils.NetUtils.WriteResponseBinaryAttachment(sender.Page.Response, "report.pdf", content, 0, True)
'BaseClasses.Utils.NetUtils.WriteResponseBinaryAttachment(sender.Page.Response, "report.xls", content, 0, True)
BaseClasses.Utils.NetUtils.WriteResponseBinaryAttachment(sender.Page.Response, "report.doc", content, 0, True)
Catch ex As Exception
Dim errMsg As String = ex.Message.Replace(Chr(13).ToString(), "").Replace(Chr(10).ToString(), "")
errMsg += " Please modify the button click function in your code-behind."
BaseClasses.Utils.MiscUtils.RegisterJScriptAlert(sender, "BUTTON_CLICK_MESSAGE", errMsg)
End Try
End Sub
#End Region
#Region "Export pdf"
Sub ExportPdf(ByVal report As ReportDocument)
End Sub
#End Region
' BaseClasses.Utils.MiscUtils.RegisterJScriptAlert(sender, "BUTTON_CLICK_MESSAGE", msg)
End Class