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