水晶报表web

水晶报表web

Function GetParamName(byval Str)
if Str="" then Exit Function
if Instr(1,Str,"?Pm-") then exit Function
Dim TempValue
TempValue=Mid(Str,3,Len(Str)-3)
GetParamName=TempValue
End Function
'on error resume next
If Not IsObject (session("oApp")) Then
Set session("oApp") = Server.CreateObject("CrystalRuntime.Application")
End If

If IsObject(session("oRpt")) then
Set session("oRpt") = nothing
End if
Set session("oRpt") = session("oApp").OpenReport(Server.MapPath("Orders.RPT"), 1)
if Err.number<>0 then
Response.Write err.number & "
"
Response.Write Err.Description
Response.End
end if
session("oRpt").MorePrintEngineErrorMessages = False
session("oRpt").EnableParameterPrompting = False
'on error goto 0

set oConn=Server.CreateObject("ADODB.Connection")
Set oADORecordset = Server.CreateObject("ADODB.Recordset")
Set rs = Server.CreateObject("ADODB.Recordset")
Set rs2 = Server.CreateObject("ADODB.Recordset")
set xmldoc=Server.CreateObject("MSXML2.DOMDocument")
set xmldoc2=Server.CreateObject("MSXML2.DOMDocument")
oConn.Open "driver={SQL Server};server=127.0.0.1;uid=sa;pwd=;database=Northwind"
strSQL="SELECT * FROM Orders"
oADORecordset.Open strSQL,oConn
oADORecordset.Save xmldoc,1
oADORecordset.Close
rs.Open xmldoc

strSQL="SELECT * FROM [Order Details]"
oADORecordset.Open strSQL,oConn
oADORecordset.Save xmldoc2,1
oADORecordset.Close
oConn.Close
rs2.Open xmldoc2
'xmldoc.loadXML ReportData
'oADORecordset.Open xmldoc
Set oRptTable = session("oRpt").Database.Tables.Item(1)

oRptTable.SetDataSource rs, 3

'set Params = Session("oRpt").Parameterfields
'For each Param in Params
'Select Case Param.Name
'Case "{?UNIT_NAME}" Param.SetCurrentValue CStr(unit_name), 7
'Case "{?DATE_FROM}" Param.SetCurrentValue CDate(date_from), 10
'Case "{?DATE_TO}" Param.SetCurrentValue CDate(date_to), 10
'End Select
'Next
'set Params=nothing

set Params = Session("oRpt").Parameterfields
For each Param in Params
ParamType=Param.valuetype
ParamName=GetParamName(Param.Name)
ParamValue=Eval(ParamName)
Select Case ParamType
Case 7 Call Param.SetCurrentValue (dfVntToInt(ParamValue), 7) 'Number
Case 8 Call Param.SetCurrentValue (Cdbl(ParamValue), 8) 'Currency
Case 10 Call Param.SetCurrentValue (CDate(ParamValue), 10) 'Date
Case 12 Call Param.SetCurrentValue (CStr(ParamValue), 12) 'String
End Select
Next
set Params=nothing

'************************************
Set CRXSections = Session("oRpt").Sections
For Each CRXSection In CRXSections
'In each section, you get all the objects in the section.
Set CRXReportObjects = CRXSection.ReportObjects
'You cycle through the objects.
For Each CRXReportObject In CRXReportObjects
'1---Text Object 2---Fields Object 3---Line 4---Box 5---Sub Report
If CRXReportObject.Kind = 5 Then
Set CRXSubreportObj = CRXReportObject
Set CRXSubreport = CRXSubreportObj.OpenSubreport
'************************************
'Set The Sub Reports Parameters'Value
Set Params=CRXSubreport.Parameterfields
For each Param in Params
ParamType=Param.valuetype
ParamName=GetParamName(Param.name)
ParamValue=Eval(ParamName)
if Instr(1,ParamName,"?Pm-")=0 then
Select Case ParamType
Case 7 Call Param.SetCurrentValue (CInt(ParamValue), 7) 'Number
Case 8 Call Param.SetCurrentValue (CDbl(ParamValue), 8) 'Currency
Case 10 Call Param.SetCurrentValue (CDate(ParamValue), 10) 'Date
Case 12 Call Param.SetCurrentValue (CStr(ParamValue), 12) 'String
End Select
end if
Next
set Params=nothing
'************************************
Set subReportOneTablesCollection = CRXSubreport.Database.Tables
For Each Table in subReportOneTablesCollection
Table.SetDataSource rs2, 3
DatabaseName=Table.Name
Response.Write DatabaseName
Next
End If
Next
Next

'on error resume next
session("oRpt").ReadRecords
If Err.Number <> 0 Then
Response.Write "An Error has occured on the server in attempting to access the data source" & "
"
Response.Write Err.number & "
"
Response.Write Err.Description
Else
If IsObject(session("oPageEngine")) Then
set session("oPageEngine") = nothing
End If
set session("oPageEngine") = session("oRpt").PageEngine
End If
'on error goto 0
'Response.End
%>

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/54654/viewspace-425463/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/54654/viewspace-425463/