水晶报表

<%
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 & "<BR>"
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" & "<BR>"
Response.Write Err.number & "<BR>"
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
%> <html>

</body>

</html>