Thameera Nawaratna Ответов: 0

Crystal reports 9.0 экспорт в PDF VB6


Привет,

Начиная с последнего обновления Windows 10, наши отчеты crystal не отображаются в IE. Ниже приведен наш код, и я хочу создать PDF вместо просмотра в CR. Код написан на VB6 и использует crystal reports 9. Как я могу экспортировать PDF-файл без просмотра в crystal reports? Было бы здорово, если бы вы могли мне в этом помочь.

мой отчет звоните через "report.asp"

<%@ LANGUAGE="VBSCRIPT" %>

<%
dim d1,d2,d3,d4,d5,d6,d7,d8,d9,d10,d11,d12,d13,d14,d15,d16,rpt
d1= request.querystring("P1")
d2= request.querystring("P2")
d3= request.querystring("P3")
d4= request.querystring("P4")
d5= request.querystring("P5")
d6= request.querystring("P6")
d7= request.querystring("P7")
d8= request.querystring("P8")
d9= request.querystring("P9")
d10= request.querystring("P10")

d11= datevalue(request.querystring("P11"))
d12= datevalue(request.querystring("P12"))
d13= datevalue(request.querystring("P13"))
d14= datevalue(request.querystring("P14"))
d15= datevalue(request.querystring("P15"))
d16= datevalue(request.querystring("P16"))

rpt= request.querystring("rpt")

%>

<% 

reportname = "report/" & rpt & ".rpt"
%>

<%                                                          
If Not IsObject (session("oApp")) Then                              
  Set session("oApp") = Server.CreateObject("CrystalRuntime.Application.9")
End If                                                               

Path = Request.ServerVariables("PATH_TRANSLATED")                     
While (Right(Path, 1) <> "\" And Len(Path) <> 0)                      
iLen = Len(Path) - 1                                                  
Path = Left(Path, iLen)                                               
Wend                                                                  
                                                                      
If IsObject(session("oRpt")) then
	Set session("oRpt") = nothing
End if

On error resume next

Set session("oRpt") = session("oApp").OpenReport(path & reportname, 1)
If Err.Number <> 0 Then
  Response.Write "Error Occurred creating Report Object: " & Err.Description
  Set Session("oRpt") = nothing
  Set Session("oApp") = nothing
  Session.Abandon
  Response.End
End If

session("oRpt").MorePrintEngineErrorMessages = False
session("oRpt").EnableParameterPrompting = False
session("oRpt").DiscardSavedData
%>

<% 

Set mainReportTableCollection = Session("oRpt").Database.Tables

For Each mnTable in mainReportTableCollection
  With mnTable.ConnectionProperties
   .Item("user ID") = "username"
   .Item("Password") = "Pass"
  End With
Next

%>


<%
Session("oRpt").ParameterFields.GetItemByName("d1").AddCurrentValue(d1)
Session("oRpt").ParameterFields.GetItemByName("d2").AddCurrentValue(d2)
Session("oRpt").ParameterFields.GetItemByName("d3").AddCurrentValue(d3)
Session("oRpt").ParameterFields.GetItemByName("d4").AddCurrentValue(d4)
Session("oRpt").ParameterFields.GetItemByName("d5").AddCurrentValue(d5)
Session("oRpt").ParameterFields.GetItemByName("d6").AddCurrentValue(d6)
Session("oRpt").ParameterFields.GetItemByName("d7").AddCurrentValue(d7)
Session("oRpt").ParameterFields.GetItemByName("d8").AddCurrentValue(d8)
Session("oRpt").ParameterFields.GetItemByName("d9").AddCurrentValue(d9)
Session("oRpt").ParameterFields.GetItemByName("d10").AddCurrentValue(d10)

Session("oRpt").ParameterFields.GetItemByName("d11").AddCurrentValue(d11)
Session("oRpt").ParameterFields.GetItemByName("d12").AddCurrentValue(d12)
Session("oRpt").ParameterFields.GetItemByName("d13").AddCurrentValue(d13)
Session("oRpt").ParameterFields.GetItemByName("d14").AddCurrentValue(d14)
Session("oRpt").ParameterFields.GetItemByName("d15").AddCurrentValue(d15)
Session("oRpt").ParameterFields.GetItemByName("d16").AddCurrentValue(d16)

%>

<%

On Error Resume Next

session("oRpt").ReadRecords

If Err.Number <> 0 Then                                               
  Response.Write "Error Occurred Reading Records: " & Err.Description
  Set Session("oRpt") = nothing
  Set Session("oApp") = nothing
  Session.Abandon
  Response.End
Else
  If IsObject(session("oPageEngine")) Then                              
  	set session("oPageEngine") = nothing
  End If
  set session("oPageEngine") = session("oRpt").PageEngine
End If
%>

<OBJECT ID="CRViewer"
	CLASSID="CLSID:2DEF4530-8CE6-41c9-84B6-A54536C90213"
	WIDTH=100% HEIGHT=100%
	CODEBASE="/viewer9/activeXViewer/activexviewer.cab#Version=9,2,0,442" VIEWASTEXT>
<PARAM NAME="EnableRefreshButton" VALUE=1>
<PARAM NAME="EnableGroupTree" VALUE=1>
<PARAM NAME="DisplayGroupTree" VALUE=1>
<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>
</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
	'CRViewer.PrintReport 

End Sub
-->
</SCRIPT>


и код rptserver.asp, как показано ниже.

<%

'	This script assumes that the Session contains the following Crystal Report Engine
'	Objects:
'
'	"oApp" - Crystal Report Engine Application Object
'	"oRpt" - Crystal Report Engine Report Object
'	"oPageEngine - Crystal Report Engine Page Engine Object
'	HTML_FRAME viewer only
'	"tabArray" -  Array used to keep drilldown tab information
'	"CurrentPageNumber" - Current Page Number requested.
'	"lastknownpage" - Previous page number requested.
'	"LastPageNumber" - Last known page number requested.
'	Note:  Before creating the PageEngine object, call ReadRecords on the 
'	report object to that all the database records have been read.
'
'	Modifications
' 05/02/98
' Added the following features:
' Tab Query String Parameter
'	- This is the selected HTML_FRAME viewer tab's tabArray index value.  
' Page Expiry Time
'	-  The page will expire when downloaded by browser so that user is insured that all data
' will be current.
' DrillDown Tabs
'	- Added in the session("tabArray") object to keep track of the HTML_FRAME drill down tabs.
' RFSH Query String Parameter
'	- Database is refreshed and ErrorValue 0 is sent to Java and active X viewers on success.
'This causes viewers to NOT refresh browser window.
' SRCH Query String Parameter and HTML_FRAME Viewer
'	-  Added javascript window.alert function call to indicate when text is not found in rpt view.

' 09/08/98
' Added the following features:
'	- cmd handling for map_dd(Map Drill Down) and export(Exporting reports from viewers).
'	- PageGenerator object creation for Out of Place Subreports.  Modification was made to RetrieveObjects procedure.
'	- Modified the get_ttl handling to call the PageGenerator object's RenderTotallerETF method 
'		instead of the PageEngine's method.  This was done to support the group by feature.
' 08/03/99
' Added the following features
'	- cmd/rfsh handling for pages with and without place holders.
'	- cmd/rfsh handling for pages requiring and not requiring total page count.
' 08/08/00
' Added the following features
'   - Export to excel 7.0 and portable document format(.pdf).
'	- Removal of WCS dependency.  We are now using emfgen to send images to browser.


 On Error Resume Next

'  The oEMF object is a helper object to create EMFs (Ecapsulated Messages) for the viewers.
'  The viewers use EMFs to display errors and navigate to specific pages of the report.

 If Not IsObject(session("oEMF")) then
	Set session("oEMF") = Server.CreateObject("CREmfgen.CREmfgen.2")
	Call CheckForError
 End if



'	Initialize all Global variables
'	These will contain the page generator and page collection

	Dim goPageGenerator		' page generator object
	Dim goPageCollection	' page collection object
	Dim goPageGeneratorDrill' page generator object in Drill Down Context
	Dim goPage				' the page object
	Dim gvGroupPathDD		' drill down group path, this is an array.
	Dim gvGroupPath			' this is branch, aka Group Path converted from string passed on the QS, it is an Array
	Dim gvGroupLevel		' this is the Group level, converted from the string passed on the QS, it is an Array
	Dim gvMaxNode			' this represents the number of nodes to retrieve for the totaller, it is set to an empty array
	Dim gvTotallerInfo		' this represents the group path of the requested totaller.
	Dim glX					' this is the X Coordinate for a drill down on a graph or Map
	Dim glY					' this is the Y Coordinate for a drill down on a graph or Map
	Dim gvPageNumber		' holds the requested page number
	Dim gvURL				' URL to redirect to
	Dim gsErrorText			' holds the error text to be sent to the viewer.
	Dim ExportOptions		' Export Options Object 
	Dim slX					' this is the X Coordinate for a selection of Out of Place subreport
	Dim slY					' this is the Y Coordinate for a selection of Out of Place subreport
	Dim sessionError		' this is the variable that will contain the error text sent to the viewer when the session has expired.

' Vaiables that represent what was passed on the Query String
	Dim CMD					' This determines the main function to perform
	Dim PAGE				' the page to return
	Dim BRCH				' the branch is a mechanism to determine the drill down level.
							' A drill down level is like a view of the report, a new tab
							' is created to indicate that it is a new view
	Dim VIEWER				' This is the viewer that is calling the server
	Dim VFMT				' the format that the viewer understands
	Dim NODE				' Currently not used??
	Dim GRP					' this is a way of specifing the actual group
	Dim COORD				' these are the coordinates on the graph to process
	Dim DIR					' this is the search direction
	Dim CSE					' indicates if the search is case sensitive
	Dim TEXT				' this is the text to search for.
	Dim INIT				' used to build the frames for the html viewer
	Dim NEWBRCH				' used to keep track of when a new branch is to be viewed.
	Dim EXPORT_FMT			' used to hold the export format and type
	Dim SUBRPT				' used to hold the Out Of Place Subreport page, number,
							' and coordinates on the main report.
	Dim INCOMPLETE_PAGE		' used to indicate whether the page generated should contain placeholders.
	Dim INCOMPLETE_PAGE_COUNT ' used to indicate whether the page should contain the total page count if not yet generated.
	Dim PVERSION			' used to indicate the protocol version of the viewer.
	Dim TTL_INFO			' used to indicate the group path of the totaller request.
	Dim IMAGE				' used to specify the name of the image file for html viewers.
	Dim DEL					' used to specify whether to delete image file after it has been sent to client.
	
' Constant Values 
	Dim CREFTWORDFORWINDOWS
	Dim CREFTRICHTEXT
	Dim CREFTEXCEL21
	Dim CREFTEXCEL70
	Dim CREFTCRYSTALREPORT
	Dim CREFTPORTABLEDOCFORMAT
	Dim CREDTDISKFILE
	Dim EMFMIMETYPE		
	CREFTWORDFORWINDOWS = 14
	CREFTRICHTEXT = 4
	CREFTEXCEL21 = 18
	CREFTEXCEL70 = 27
	CREFTCRYSTALREPORT = 1
	CREFTCRYSTALREPORT7 = 33
	CREFTPORTABLEDOCFORMAT = 31 
	CREDTDISKFILE = 1
	crAllowPlaceHolders = 2
	crDelayTotalPageCountCalc = 1
	EMFMIMETYPe = "application/x-emf"
	EPFMIMETYPE = "application/x-epf"
	ETFMIMETYPE = "application/x-etf"
'	Initialize Arrays
	gvGroupPath = Array()
	gvGroupLevel = Array()
	gvMaxNode = Array() ' reteive all nodes
	gvTotallerInfo = Array()
	NEWBRCH	 = "0"
	sessionError = "An error has occurred."

'  To ensure that the browser does not cache the html pages for the group trees.
Response.Expires = 0
' Parse Query String for paramaters
Call ParseQS()


' If the request is for a image, we do not process the remainder of the page. Rather, we simply return 
' the image file.
if	IMAGE <> "" then
	Call session("oEMF").StreamImage(IMAGE, DEL)
	Response.End
end if 

' INIT is a special QS case, we only care about HTML viewer, if it is then save send page and branch info
' to the frame page

if INIT = "HTML_FRAME" then
	' build URL and send the QS
	if BRCH <> ""  and NEWBRCH	= "1" then
		' htmstart is the base page that creates the frames for the HTML viewer
		' if there is branch information it needs to be passed along.
			tmpArray = session("tabArray")
			if tmpArray(0) <> "EMPTY" then
				val = UBound(tmpArray, 1) + 1
				redim preserve tmpArray(val + 4)
			else
				val = 0
			end if
			tmpArray(val) = CStr(val)
			tmpArray(val + 1) = session("lastBrch")
			session("lastBrch") = BRCH
			tmpArray(val + 2) = session("CurrentPageNumber")
			tmpArray(val + 3) = session("lastknownpage")
			tmpArray(val + 4) = session("LastPageNumber") 
			session("tabArray") = tmpArray
		gvURL = "htmstart.asp?brch=" & BRCH & "&"
	else
		if BRCH <> "" then
			gvURL = "htmstart.asp?brch=" & BRCH
		else 
			gvURL = "htmstart.asp"
		end if
	end if
	response.redirect gvURL
end if


	
' If there is a BRCH then create the gvGroupPath array that represents it.

if BRCH <> "" then
	gvGroupPath = CreateArray(BRCH)
end if 

' If there is a GRP then create the gvGroupLevel array that represents it.

if GRP <> "" then
	gvGroupLevel = CreateArray(GRP)
end if

' If there is a TTL_INFO then create the gvTotallerInfo array that represents it.

if TTL_INFO <> "" then
	gvTotallerInfo = CreateArray(TTL_INFO)
end if



' If there are COORDs, then get them
if COORD <> "" then
	Call GetDrillDownCoordinates(COORD, glX, glY)
end if
	
' This case statement determines what action to perform based on CMD
' there are sub cases for each viewer type


		
Select Case CMD

Case "GET_PG"

	Call RetrieveObjects
	
	' create the actual page
	Set goPage = goPageCollection(PAGE)
	' check for an exception on the page number 
	Call ValidatePageNumber

	' 0 is for epf, 8209 is a SafeArray
	Select Case VFMT
	
		Case "ENCP"
			session("oPageEngine").PlaceHolderOptions = 0
			if(PVERSION > 2)then
				if INCOMPLETE_PAGE > 0 then
					session("oPageEngine").PlaceHolderOptions = crAllowPlaceHolders
				end if
				if INCOMPLETE_PAGE_COUNT > 0 then
					session("oPageEngine").PlaceHolderOptions = session("oPageEngine").PlaceHolderOptions + crDelayTotalPageCountCalc
				end if
			end if 				
			session("oPageEngine").ImageOptions = 1
			temp = goPage.Renderepf(8209)
			Response.AddHeader "CONTENT-LENGTH", lenb(temp)
			Response.ContentType = EPFMIMETYPE
			response.binarywrite temp
		
		Case "HTML_FRAME"
			session("oPageEngine").ImageOptions = 1
			response.binarywrite goPage.Renderhtml(1,2,1,request.ServerVariables("SCRIPT_NAME"),8209)
			' Need to know if it is the last page to construct the toolbar correctly
			if goPage.IsLastPage then
				session("LastPageNumber") = goPage.pagenumber
				session("CurrentPageNumber") = session("LastPageNumber")
			end if	
		Case "HTML_PAGE"
			session("oPageEngine").ImageOptions = 1
			response.binarywrite goPage.Renderhtml(1,3,3,request.ServerVariables("SCRIPT_NAME"),8209)
		
		end select
	
Case "GET_TTL"
	
	Call RetrieveObjects
	
	Select Case VFMT
	
		Case "ENCP"
			Response.ContentType = ETFMIMETYPE
			if(PVERSION > 2)then
				temp = goPageGenerator.RenderTotallerETF(gvTotallerInfo, 0, 1, gvMaxNode, 8209)
			else
				temp = goPageGenerator.RenderTotallerETF(gvGroupPath, 0, 0, gvMaxNode, 8209)
			end if
			Response.AddHeader "CONTENT-LENGTH", lenb(temp)
			response.binarywrite temp
		
		Case "HTML_FRAME"
			response.binarywrite goPageGenerator.RenderTotallerHTML(gvGroupPath, 1, 0, gvMaxNode, gvGroupLevel, 1, request.ServerVariables("SCRIPT_NAME"), 8209)
		
	end select


Case "RFSH"
	
	' This command forces the database to be read again.
	session("oRpt").DiscardSavedData
	If Err.Number <> 0 Then
		Call CheckForError
	Else
		session("oRpt").EnableParameterPrompting = False
		session("oRpt").ReadRecords
		Set session("oPageEngine") = session("oRpt").PageEngine
	End If
	Call RetrieveObjects
	Set goPage = goPageCollection(PAGE)
	Call ValidatePageNumber
	session("oPageEngine").ImageOptions = 1
	Select Case VFMT
	Case "ENCP"
	' Java and Active X Viewers will make a get page command when receiving 0 error msg value
		if VIEWER = "JAVA" then
			session("oPageEngine").PlaceHolderOptions = 0
			if(PVERSION > 2)then
				if INCOMPLETE_PAGE > 0 then
					session("oPageEngine").PlaceHolderOptions = crAllowPlaceHolders
				end if
				if INCOMPLETE_PAGE_COUNT > 0 then
					session("oPageEngine").PlaceHolderOptions = session("oPageEngine").PlaceHolderOptions + crDelayTotalPageCountCalc
				end if
			end if 
			temp = goPage.Renderepf(8209)
			Response.AddHeader "CONTENT-LENGTH", lenb(temp)
			Response.ContentType = EPFMIMETYPE
			response.binarywrite temp
		else
			Response.ContentType = EMFMIMETYPE
			session("oEMF").SendErrorMsg 0,""
		end if 
		
	Case "HTML_FRAME"
		InitializeFrameArray()
		gvURL = "htmstart.asp"
		response.redirect gvURL

	Case "HTML_PAGE"
	session("oPageEngine").ImageOptions = 1
	response.binarywrite goPage.Renderhtml(1,3,1,request.ServerVariables("SCRIPT_NAME"),8209)
		
	end select


Case "NAV"
	Call RetrieveObjects
	Call CheckForError
	' Get the page number that the group in on, for this particular branch
	gvPageNumber = goPageGenerator.GetPageNumberForGroup(gvGroupLevel)
			
	Select Case VFMT
	' 0 is for epf, 8209 is a SafeArray, 8 is a BSTR
	Case "ENCP"
		' Create a byte array for the EMF, which will contain the page number
		Response.ContentType = EMFMIMETYPE
		session("oEMF").sendpagenumberrecord(gvPageNumber)
	
	Case "HTML_FRAME"
		' for html browser send back the page
		dim appendQuery
		appendQuery = "?"
		session("CurrentPageNumber") = gvPageNumber
		if BRCH <> "" then
			appendQuery = appendQuery & "BRCH=" & BRCH & "&"
		end if
		if GRP <> "" then
				appendQuery = appendQuery & "GRP=" & GRP
		end if
		response.redirect "framepage.asp" & appendQuery
	
	end select


Case "CHRT_DD"
	' only supported in java and active X smart viewers
	Select Case VFMT

	Case "ENCP"

		'  Get page collection
		Call RetrieveObjects
		Call CheckForError
		' Pass the coordinates to the report engine to determine what
		' branch the drill down goes to.
		Set goPageGeneratorDrill = goPageGenerator.DrillOnGraph(PAGE, glX, glY)
		' Check for an exception because of coordinates
		if err.number <> 0 then
			gsErrorText = "Not part of the Graph "
			Response.ContentType = EMFMIMETYPE
			session("oEMF").SendErrorMsg 40, gsErrorText
			err.clear
			response.end
		end if
		' pass the group level and group path to helper function to create 
		' the EMF message, this tells the viewer where to get the page.

		gvGroupPathDD = goPageGeneratorDrill.grouppath
		gvGroupNameDD = goPageGeneratorDrill.groupname
		Response.ContentType = EMFMIMETYPE
		session("oEMF").GroupName = gvGroupNameDD		
		session("oEMF").sendbranchesemf(gvGroupPathDD)		
			

	end select

Case "GET_LPG"
	
	' only support in smart viewers
	Select Case VFMT

	Case "ENCP"
		' this command returns the page number of the last page
		' Get page collection
		Call RetrieveObjects
		Call CheckForError
		' Get the count from the Pages collection
		gvPageNumber = goPageCollection.Count

		' Send the EMF representing the page number
		Response.ContentType = EMFMIMETYPE
		session("oEMF").sendpagenumberrecord(gvPageNumber)
	end select

Case "SRCH"
	Call RetrieveObjects
	Call CheckForError
	' create page variable
	gvPageNumber = CInt(PAGE)
	
	Select Case VFMT
	Case "ENCP"
		if goPageGenerator.FindText(TEXT, 0, gvPageNumber) then
			Response.ContentType = EMFMIMETYPE
			session("oEMF").sendpagenumberrecord(gvPageNumber)
		else
			gsErrorText = "The specified text, '" & TEXT & "' was not found in the report"
			Response.ContentType = EMFMIMETYPE
			session("oEMF").SendErrorMsg 33, gsErrorText
		end if
					
	Case "HTML_FRAME"
		' We are being called by HTML viewer
		' need to get the text from the form post
		dim searchFound
		TEXT = request.form("text")
		' Now find out what page the text is on
		tempNumber = gvPageNumber + 1
		If(CBool(goPageGenerator.FindText(TEXT, 0, tempNumber))) then
			session("CurrentPageNumber") = tempNumber
			searchFound = 1
		else
			session("CurrentPageNumber") = gvPageNumber
			searchFound = 0
		End If
		if BRCH <> "" then
			gvURL = "framepage.asp?brch=" & BRCH & "&SEARCHFOUND=" & searchFound
		else
			gvURL = "framepage.asp?SEARCHFOUND=" & searchFound
		end if
		response.redirect gvURL

	Case "HTML_PAGE"
		' We are being called by HTML viewer
		' need to get the text from the form post
		TEXT = request.form("text")
		' Now find out what page the text is on
		tempNumber = gvPageNumber
		If(CBool(goPageGenerator.FindText(TEXT, 0, tempNumber))) then
			gvPageNumber = tempNumber
			Set goPage = goPageCollection(gvPageNumber)
			session("oPageEngine").ImageOptions = 1
			response.binarywrite goPage.Renderhtml(1,3,3,request.ServerVariables("SCRIPT_NAME"),8209)
		else
		' Send back an html page indicating the text was not found.
			Response.Write "<html><title>Seagate ASP Reports Server</title><body bgcolor='white'><center><h1>The text cannot be found in this report.</h1></center></body></html>"
		End If
		
	end select

				
Case "TOOLBAR_PAGE"
	
	' Redirect to the framepage, need to know if we are 
	' on the last page.

	if session("LastPageNumber") <> "" then
		if CInt(PAGE) > CInt(session("LastPageNumber")) then
			session("CurrentPageNumber") = session("LastPageNumber")
		else
			session("CurrentPageNumber") = PAGE
		end if
	else 
		Call RetrieveObjects
		Call CheckForError
		' create the actual page
		Set goPage = goPageCollection(PAGE)
		' check for an exception on the page number 
		Call ValidatePageNumber
		if goPage.IsLastPage then
			session("LastPageNumber") = goPage.pagenumber
			session("CurrentPageNumber") = session("LastPageNumber")	
		else
			session("CurrentPageNumber") = PAGE
		end if	
	end if
	if BRCH <> "" then
		gvURL = "framepage.asp?brch=" & BRCH
	else
		gvURL = "framepage.asp"
	end if

	response.redirect gvURL

Case "EXPORT"
	Set ExportOptions = Session("oRpt").ExportOptions
	Session("oRpt").DisplayProgressDialog = FALSE
	if(FillExportOptionsObject( EXPORT_FMT)) Then
		Call RetrieveObjects
		response.binarywrite goPageGenerator.Export(8209)
		Call CheckForError
	else
		Response.ContentType = EMFMIMETYPE
		session("oEMF").SendErrorMsg 1, "Invalid Export Type Specified"
	end if

Case "MAP_DD"
	' only supported in java and active X smart viewers
	Select Case VFMT

	Case "ENCP"

		'  Get page collection
		Call RetrieveObjects
		Call CheckForError
		' Pass the coordinates to the report engine to determine what
		' branch the drill down goes to.
		Set goPageGeneratorDrillonMap = goPageGenerator.DrillOnMap(PAGE, glX, glY)
		' Check for an exception because of coordinates
		if err.number <> 0 then
			gsErrorText = "No Values Exist for Selected Region of Map"
			Response.ContentType = EMFMIMETYPE
			session("oEMF").SendErrorMsg 40, gsErrorText		
			err.clear
			response.end
		end if
		' pass the group level and group path to helper function to create 
		' the EMF message, this tells the viewer where to get the page.

		gvGroupPathDD = goPageGeneratorDrillonMap.grouppath
		gvGroupNameDD = goPageGeneratorDrillonMap.groupname
		session("oEMF").GroupName = gvGroupNameDD	
		Response.ContentType = EMFMIMETYPE	
		session("oEMF").sendbranchesemf(gvGroupPathDD)		
			
	end select

end select



SUB RetrieveObjects() 
' This procedure simply retrieves the session objects into global variables.
' In the case of Out of Place Subreports, the SUBRPT parameter must be parsed and the
' Subreport page generator object must be created.
	Dim oRptOptions 'Report Options 
	Dim charIndexVal,tmpCharIndexVal
	Dim tmpStr
	Dim tmpPageGenerator
	Dim subPageGenerator 
	Dim OOPSSeqNo	'holds the page's OOPS sequence number
	Dim OOPSSubName	'holds the OOPS's name
	Dim subCoords 'holds the coordinates of the OOPS in the main report
	Dim subgvGroupPath 'holds the group path for the main report in subrpt parameter
	Dim mainRptPageNumber 'holds the page number for the main report in the subrpt parameter
	
	subgvGroupPath = Array()
	if IsObject(session("oPageEngine")) then
		' make sure dialogs have been disabled
		if SUBRPT <> "" Then
		' Obtain the subreport sequence number
			charIndexVal = findChar(SUBRPT, ":")
			if charIndexVal > 1 then
				OOPSSeqNo = Mid(SUBRPT,1,charIndexVal - 1)
			end if
		' Obtain the subreport's name
			tmpStr = Mid(SUBRPT,charIndexVal + 1)
			charIndexVal = findChar(tmpStr, ":")
			if charIndexVal > 1 then
				OOPSSubName = Mid(tmpStr,1,charIndexVal - 1)
			end if
			tmpStr = Mid(tmpStr,charIndexVal + 1)
			charIndexVal = findChar(tmpStr, ":")
		' Obtain the group path for the Out of Place Subreport
			if charIndexVal > 1 then
				subgvGroupPath = CreateArray(Mid(tmpStr, 1, charIndexVal - 1))
			end if
		'Obtain the main report page number after the fourth : character
			tmpStr = Mid(tmpStr,charIndexVal + 1)
		'Get the location of the fourth : seperator
			charIndexVal = findChar(tmpStr, ":")
			mainRptPageNumber = Mid(tmpStr, 1, charIndexVal - 1)
		'Get the coordinates portion of the SUBRPT parameter
			subCoords = Mid(tmpStr, charIndexVal + 1)
			Call GetDrillDownCoordinates(subCoords, slX, slY)
			' Get the main reports page generator for the view
			Set tmpPageGenerator = session("oPageEngine").CreatePageGenerator(subgvGroupPath)
			Set subPageGenerator = tmpPageGenerator.DrillOnSubreport(mainRptPageNumber, slX, slY)
			Set goPageGenerator = subPageGenerator.CreateSubreportPageGenerator(gvGroupPath)
		else
			Set goPageGenerator = session("oPageEngine").CreatePageGenerator(gvGroupPath)
			end if
		Set goPageCollection = goPageGenerator.Pages
	else
		' must have timed out return an error, you may wan to Append to the
		' IIS log here.
		if VFMT = "ENCP" then 
			Response.ContentType = EMFMIMETYPE
			session("oEMF").SendErrorMsg 1, sessionError
		else
			response.write sessionError
			
		end if
		response.end
	end if

END SUB

SUB ParseQS()
	DIM UTF8STR									' this is the string in UTF-8 format returned from the viewer
	' Parse the Query String 
	CMD = UCase(request.querystring("cmd"))		' This determines the main function to perform
	PAGE = UCase(request.querystring("page"))	' the page to return
	BRCH = UCase(request.querystring("BRCH"))	' the branch is a mechanism to determine the drill down level.
												' A drill down level is like a view of the report, a new tab
												' is created to indicate that it is a new view
	VIEWER = UCase(request.querystring("VIEWER"))	' This is the viewer that is calling the server
	VFMT = UCase(request.querystring("VFMT"))	' the format that the viewer understands
	NODE = UCase(request.querystring("NODE"))
	GRP = UCase(request.querystring("GRP"))		' this is a way of specifing the actual group
	COORD = UCase(request.querystring("COORD"))	' these are the coordinates on the graph to process
	DIR = UCase(request.querystring("DIR"))		' this is the search direction
	CSE = UCase(request.querystring("CASE"))	' indicates if the search is case sensitive
	UTF8STR = request.querystring("TEXT")		' this is the text to search for.
	TEXT = session("oEMF").DecodeUTF8String(UTF8STR) ' Convert to Unicode.
	INIT = UCase(request.querystring("INIT"))	' used to build the frames for the html viewer
	TAB = UCase(request.querystring("TAB"))		' used to keep track of TABS on drill down.
	EXPORT_FMT = UCase(request.querystring("EXPORT_FMT")) ' Used to specify export format and type.	
	UTF8STR = request.querystring("SUBRPT") ' The Out of Place Subreport coordinates.
	SUBRPT = UCase(session("oEMF").DecodeUTF8String(UTF8STR)) ' Convert to Unicode.
	INCOMPLETE_PAGE = CInt(request.querystring("INCOMPLETE_PAGE"))' Used to specify whether the page is to contain placeholders.
	INCOMPLETE_PAGE_COUNT = CInt(request.querystring("INCOMPLETE_PAGE_COUNT"))' Used to specify whether the page has to contain a total page count.
	PVERSION = CInt(request.querystring("PVERSION"))' Used to indicate the protocol version the viewer is utilizing.
	TTL_INFO = UCase(request.querystring("TTL_INFO"))'Used to indicate the group path of the totaller request.
	IMAGE = UCase(request.querystring("IMAGE"))
	DEL = Cint(request.querystring("DEL"))
	' Initialize variables to a default if they are not provided on the query string.
	' Check for Parameter Values that are passed by the HTTP Post Command.
	if CMD = "" then
		CMD = UCase(request.form("cmd"))	
		if CMD = "" then
			CMD = "GET_PG"
		end if
	end if
	
	if INIT = "" then
		INIT = UCase(request.form("INIT"))
	end if

	if BRCH = "" then
		BRCH = UCase(request.form("BRCH"))
	end if

	if BRCH = "" and INIT = "HTML_FRAME" then 
		Call InitializeFrameArray
	end if


	if BRCH <> "" and INIT = "HTML_FRAME"  then
		if session("lastBrch") <> BRCH then
			NEWBRCH	 = "1"
		end if
	end if 
			

	if VIEWER = "" then
		VIEWER = UCase(request.form("VIEWER"))
		if VIEWER = "" then
			VIEWER = "HTML"
		end if
	end if

	if VFMT = "" then 
		VFMT = UCase(request.form("VFMT"))
		if VFMT = "" then 
			VFMT = "HTML_PAGE"
		end if
	end if

	if GRP = "" then
		GRP = UCase(request.form("GRP"))	
	end if

	if TTL_INFO = "" then
		TTL_INFO = UCase(request.form("TTL_INFO"))
	end if

	if COORD = "" then
		COORD = UCase(request.form("COORD"))
	end if

	if NODE = "" then
		NODE = UCase(request.form("NODE"))
	end if

	if DIR = "" then
		DIR = UCase(request.form("DIR"))
		if DIR = "" then
			DIR = "FOR" ' forward
		end if
	End if

	if CSE = "" then
		CSE = UCase(request.form("CASE"))
		if CSE = "" then
			CSE = "0" ' case insensitive
		end if
	end if

	if TEXT = "" then
		UTF8STR = request.form("TEXT")
		TEXT = session("oEMF").DecodeUTF8String(UTF8STR) ' Convert to Unicode.
	end if

	if EXPORT_FMT = "" then
		EXPORT_FMT = UCase(request.form("EXPORT_FMT"))
	end if
	
	if SUBRPT = "" then
		UTF8STR = request.form("SUBRPT")
		SUBRPT = UCase(session("oEMF").DecodeUTF8String(UTF8STR)) ' Convert to Unicode.
	end if
	
	if request.form("INCOMPLETE_PAGE") <> "" then
		INCOMPLETE_PAGE = CInt(request.form("INCOMPLETE_PAGE"))
	end if
	
	if request.form("INCOMPLETE_PAGE_COUNT") <> "" then
		INCOMPLETE_PAGE_COUNT = CInt(request.form("INCOMPLETE_PAGE_COUNT"))
	end if
	
	if PVERSION = 0 then
		PVERSION = CInt(request.form("PVERSION"))
	end if
	
	if IMAGE = "" then
		IMAGE = request.form("IMAGE")
	end if
	
	if DEL = 0 then
		DEL = Cint(request.form("DEL"))
	end if
	
' Check to make sure there is a page requested, if not use 1 as a default
	if PAGE = "" then
		PAGE = UCase(request.form("page"))
		if PAGE = "" then
			PAGE = "1"
		end if
	end if
	
	if PAGE <> "" and NOT IsNumeric(PAGE) then
		PAGE = "1"
	end if
	
END SUB

Function CreateArray(ByVal vsStringArray)
' this function takes an string like 0-1-1-0 and converts
' it into an array of integers

    Dim lvArray
    Dim lvNewArray
    Dim liCount
    Dim liCurrentPos
    Dim lsBuf
    lvArray = Array()
    lvNewArray = Array()
    ReDim lvArray(256)
    
    liStringLength = Len(vsStringArray)
    liCount = 0
    liCurrentPos = 1
    lsBuf = ""
    
    While liCurrentPos <= liStringLength
         
         'ignore this character
        If Mid(vsStringArray, liCurrentPos, 1) <> "-" Then
            lsBuf = lsBuf & Mid(vsStringArray, liCurrentPos, 1)
            If liCurrentPos = liStringLength Then
                lvArray(liCount) = CInt(lsBuf)
                lsBuf = ""
                liCount = liCount + 1
            End If
            
        Else
            lvArray(liCount) = CInt(lsBuf)
            lsBuf = ""
            liCount = liCount + 1
        End If
        liCurrentPos = liCurrentPos + 1
    Wend
    
    ReDim lvNewArray(liCount - 1)
    
    For x = 0 To (liCount - 1)
        lvNewArray(x) = lvArray(x)
    Next
    
    
    CreateArray = lvNewArray

End Function

' Helper function to parse coordinates passed by viewers and place into independent variables.
SUB GetDrillDownCoordinates(ByVal strParam, ByRef xCoord, ByRef yCoord)
	Dim liStringLength
	Dim lbDone
	Dim lsBuf

	liStringLength = Len(strParam)
	lbDone = FALSE
	lsBuf = ""
	xCoord = ""
	yCoord = ""
	For x = 1 To liStringLength
		lsBuf = Mid(strParam, x, 1)
		
		'ignore this character
		If lsBuf = "-" Then
			lsBuf = ""
			lbDone = TRUE
		End if
		
		if lbDone then
			yCoord = yCoord + lsBuf
		else
			xCoord = xCoord + lsBuf
		end if
			
	Next
	
END SUB

' This helper procedure will check if the requested page number exists.
' If it does not, it will set it to the last available page.
SUB ValidatePageNumber()
	if err.number <> 0 then
		if err.number = 9 then 
			' just return the last page
			PAGE = goPageCollection.count
			Set goPage = goPageCollection(PAGE)
			' these session variables are used for the HTML Frame viewer
			session("LastPageNumber") = PAGE
			session("CurrentPageNumber") = PAGE
			err.clear
		else
			' A more serious error has occurred. Error message sent to browser.
			Call CheckForError
		end if
	end if
END SUB



'  This helper procedure will send an error msg to the browser based on what viewer is being used.
SUB CheckForError()
	If Err.Number <> 0 Then
		if VFMT = "ENCP" then
			Response.ContentType = EMFMIMETYPE
			session("oEMF").SendErrorMsg 1, "CRAXDRT Error Occured on Server. " & Err.Number  & " : " & Err.Description
		else
			Response.Write "CRAXDRT Error Occured on Server. Error Number: " & Err.Number & " Error Description: " & Err.Description
		end if
		Response.end
	End if
END SUB

SUB InitializeFrameArray()
'initialize the html_frame array
	set session("tabArray") = Nothing
	session("lastBrch") = ""
	dim tmpArray
	tmpArray = Array(4)
	redim tmpArray(4)
	'Initialize the sequence number
	tmpArray(0) = "EMPTY"
	session("tabArray") = tmpArray
END SUB

' Helper function to parse the EXPORT_FMT parameter and fill in the properties of the 
' Export object.
FUNCTION FillExportOptionsObject(export_fmt_options)
	dim charIndex 
	dim exportType
	dim exportDLLName
	charIndex = findChar(export_fmt_options,":")
	'Set session("ExportOptions") = Session("oRpt").ExportOptions
	if(charIndex > 0) Then
	'Get the export format type value
		exportType = Mid(export_fmt_options, charIndex + 1)
		exportDLLName = UCase(Mid(export_fmt_options, 1, charIndex - 1))
		Select Case exportDLLName
			Case "CRXF_WORDW"		
				ExportOptions.FormatType = 	CREFTWORDFORWINDOWS + CInt(exportType)
				Response.ContentType = "application/msword"
			Case "U2FWORDW"
				ExportOptions.FormatType = 	CREFTWORDFORWINDOWS + CInt(exportType)
				Response.ContentType = "application/msword"
			Case "CRXF_RTF"	
				ExportOptions.FormatType = 	CREFTRICHTEXT	+ CInt(exportType)
				Response.ContentType = "application/rtf"
			Case "U2FRTF"
				ExportOptions.FormatType = 	CREFTRICHTEXT	+ CInt(exportType)
				Response.ContentType = "application/rtf"
			Case "CRXF_XLS"
				ExportOptions.FormatType = 29 'Excel 8.0
				Response.ContentType = "application/vnd.ms-excel"
			Case "U2FXLS"
				if ((CREFTEXCEL21	+ CInt(exportType)) <= 22 ) then
					ExportOptions.FormatType = CREFTEXCEL21	+ CInt(exportType)
				else
					ExportOptions.FormatType = CREFTEXCEL70	+ (CInt(exportType) - 5)
				end if
				Response.ContentType = "application/vnd.ms-excel"
			Case "U2FCR"
				ExportOptions.FormatType = CREFTCRYSTALREPORT
				Response.ContentType = "application/x-rpt"
			Case "CRXF_PDF"			
				ExportOptions.FormatType = CREFTPORTABLEDOCFORMAT
				ExportOptions.PDFExportAllPages = TRUE
				Response.ContentType = "application/pdf"
			Case "U2FPDF"
				ExportOptions.FormatType = CREFTPORTABLEDOCFORMAT
				ExportOptions.PDFExportAllPages = TRUE
				Response.ContentType = "application/pdf"
			Case Else
				FillExportOptionsObject = False
				Exit Function
		End Select
		ExportOptions.DestinationType = CREDTDISKFILE
		FillExportOptionsObject = True
	else
		FillExportOptionsObject = False
	end if

end FUNCTION
		 
'  Helper function that returns the index of the character in the given string.
Function findChar(findStr, charToFind)
	dim lenStr 
	dim result 
	lenStr = len(findStr)
	result = -1
	if(lenStr > 0) Then
		charCounter = 1
		do While(charCounter <= lenStr)
			tmpChar = Mid(findStr,charCounter,1)
			if(tmpChar = charToFind) Then
				result = charCounter
				Exit Do
			end if
			charCounter = charCounter + 1
		loop
	end if
	
	findChar = result
End Function	

%>


Что я уже пробовал:

Я пробовал просмотр совместимости с наименьшей безопасностью в IE и т. д. Кроме того, я попытался добавить код, как предлагалось в нескольких постах, но получил ошибку сервера.

0 Ответов