zoukankan      html  css  js  c++  java
  • 水晶报表

    <%
    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&quot;" 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>

  • 相关阅读:
    什么是理想?
    leetcode 62. 不同路径-动态规划及优化,双100%
    使用双指针暴力解决力扣28题《实现 strStr()》
    使用双指针解决力扣27题《移除元素》
    SQL SERVER 数据库日志已满时清理日志的方法
    修改git提交的名字和邮箱
    React Native运行出现Could not find "iPhone X" simulator
    eosio 编译与部署
    恢复经常写博客的习惯
    MAC OS系统替换homebrew使用阿里云或中科大的镜像源
  • 原文地址:https://www.cnblogs.com/qiao198/p/4512.html
Copyright © 2011-2022 走看看