314 lines
14 KiB
VB.net
314 lines
14 KiB
VB.net
Imports Microsoft.VisualBasic
|
|
Imports CrystalDecisions.CrystalReports.Engine
|
|
Imports CrystalDecisions.Shared
|
|
|
|
|
|
Public Class CrPdf
|
|
|
|
#Region "Get CR No param"
|
|
''' <summary>
|
|
''' Get Report with one parameter and Auto set Logo path, Logo.pdf must be in Reports folder.
|
|
''' </summary>
|
|
''' <param name="sender">e.g:Me</param>
|
|
''' <param name="reportName">Report name in Reports Folder</param>
|
|
''' <remarks></remarks>
|
|
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"
|
|
''' <summary>
|
|
''' Get Report with one parameter and Auto set Logo path, Logo.pdf must be in Reports folder.
|
|
''' </summary>
|
|
''' <param name="sender">e.g:Me</param>
|
|
''' <param name="reportName">Report name in Reports Folder</param>
|
|
''' <param name="pName">Parameter Name</param>
|
|
''' <param name="pVal">Parameter Value in String</param>
|
|
''' <remarks></remarks>
|
|
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"
|
|
''' <summary>
|
|
''' Get pdf report and send to browser
|
|
''' </summary>
|
|
''' <param name="sender">e.g:me</param>
|
|
''' <param name="reportName">Report name with Folder e.g: "../Reports/report1.rpt"</param>
|
|
''' <param name="param">Array of parameter seperate with "," e.g: p(0)= "ClassName,1/1" </param>
|
|
'''<param name="ReportType" >1(Default)=pdf, 2=Excel, 3=Word</param>
|
|
''' <remarks></remarks>
|
|
'''
|
|
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"
|
|
''' <summary>
|
|
''' Get local path.
|
|
''' </summary>
|
|
''' <param name="sender">sender=me</param>
|
|
''' <param name="PathName">../Folder/filename</param>
|
|
''' <returns>Local Path</returns>
|
|
''' <remarks></remarks>
|
|
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"
|
|
|
|
''' <summary>
|
|
'''Override the CrystalReportButton_Click and call DisplayReportAsPDF_CrystalReportButton function
|
|
''' </summary>
|
|
''' <param name="ReportType" ></param>
|
|
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
|