水晶报表
<%
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>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title><%=ReportTitle%></title>
</head>
<body onunload="CallDestroy();" bottommargin="0" topmargin="0" rightmargin="0" leftmargin="0">
<object id="CRViewer" classid="CLSID:2DEF4530-8CE6-41c9-84B6-A54536C90213" width="100%" height="100%" codebase="activexviewer.cab#Version=9,2,0,442"" viewastext>
<param name="EnableRefreshButton" value="1">
<param name="EnableGroupTree" value="0">
<param name="DisplayGroupTree" value="0">
<param name="EnablePrintButton" value="1">
<param name="EnableExportButton" value="1">
<param name="EnableDrillDown" value="1">
<param name="EnableSearchControl" value="1">
<param name="EnableAnimationControl" value="1">
<param name="EnableZoomControl" value="1">
<param name="LaunchHTTPHyperlinkInNewBrowser" value="1">
<param name="DisplayBackGroundEdge" value="0">
<param name="DisplayTabs" value="0">
<param name="EnablePopupMenu" value="0">
<param name="EnableCloseButton" value="0">
</object>
<script language="VBScript">
<!--
Sub Window_Onload
On Error Resume Next
Dim webBroker
Set webBroker = CreateObject("WebReportBroker9.WebReportBroker")
if ScriptEngineMajorVersion < 2 then
window.alert "IE 3.02 users on NT4 need to get the latest version of VBScript or install IE 4.01 SP1. IE 3.02 users on Win95 need DCOM95 and latest version of VBScript, or install IE 4.01 SP1. These files are available at Microsoft's web site."
else
Dim webSource
Set webSource = CreateObject("WebReportSource9.WebReportSource")
webSource.ReportSource = webBroker
webSource.URL = "rptserver.asp"
webSource.PromptOnRefresh = True
CRViewer.ReportSource = webSource
end if
CRViewer.ViewReport
End Sub
-->
</script>
<script language="javascript">
function CallDestroy()
{
window.open("Cleanup.asp","","toolbar=no,location=no,directories=no,status=no,menubar=no,scrollbars=no,resizable=no,width=0,height=0,top=0,left=0");
}
</script>
</body>
</html>
