Here is the code.
<%@ LANGUAGE="VBSCRIPT" %>
<%
' ProcessReport8.asp
Option Explicit
Response.Buffer = true
Response.Expires=-1441
Server.ScriptTimeout = 4000
' Querystring should contain:
' Name: is the name of the report
' RP: is the path from which the report was printed
' this is used to find the standard report subdirectory
' P#: parameters to be passed to the report
%>
<HTML>
<HEAD>
<TITLE>Process a Report</TITLE>
</HEAD>
<%
' Declare variables used
dim ErrNumber
dim rsReportLog
dim PathReportName
dim DB
dim SQL
dim DSN
dim DBNAme
dim UserID
dim Password
dim ReportName
dim i
dim j
dim m
dim Path
dim AppPath
dim oRptOptions
dim oOptions
dim CRTable
dim CRTables
dim CRTablesCnt
dim CRSections
dim CRSectionsCnt
dim CRSection
dim CRSubReport
dim CRReports
dim CRReport
dim CRReportsCnt
dim ReportObject
dim ReportDatabase
dim StoredProcParamCollection
dim Item
dim ObjectCnt
Dim SectionCnt
dim Temp
Set DB = Server.CreateObject ("ADODB.Connection"
DB.CommandTimeout = 240
DB.Open Application("Aware_ConnectionString"
' File System Object
Dim FSO
' Set the connection to the alternate if Alternate Server Flag is set
if Request.QueryString("S"
<> "" and _
ucase(Request.QueryString("S"
) <> "FALSE" then
' Set the Database name
DBName = Application("Second_Database"
DSN = Application("Second_DSN"
' Get the user id and password
UserID = Application("Second_RuntimeUserName"
Password = Application("Second_RuntimePassword"
' Set the connection to the same as the Aware system
else
' Set the Database name
DBName = Application("Database"
DSN = Application("DSN"
' Get the user id and password
UserID = Application("Aware_RuntimeUserName"
Password = Application("Aware_RuntimePassword"
end if
' Set the DSN to the same as the Database name
' DSN = DBName
' Get the name of the report to be printed
Reportname = Request.QueryString("Name"
' Remove subdirectory information from the reportname
do while instr(ReportName,"\"
> 0
ReportName = mid(ReportName, instr(ReportName,"\"
+ 1)
loop
' Read the parameters for use in the report
' Parameters must be contiguos, ex: p1=VR,p2=7002
i = 0
dim Parms()
redim Parms(0)
do while not(isempty(Request.QueryString("P" & i)))
redim preserve Parms(i+1)
Parms(i+1) = Request.QueryString("P" & i)
i = i + 1
loop
'==================================================================
' Create the report object for this session if it has not yet been created in this session
if not IsObject (session ("oApp"
) then
set session ("oApp"
= Server.CreateObject("CrystalRuntime.Application.8"
end if
' Create a File System Object
set FSO = Server.CreateObject("Scripting.FileSystemObject"
' Determine path to application server
AppPath = Request.ServerVariables("APPL_PHYSICAL_PATH"
dim LeftString
dim RightString
' BARTZ
' change the /s to For i = 1 to len(AppPath)
If Mid(AppPath,i,1) = "/" Then
LeftString = Mid(AppPath,1,i-1)
RightString = Mid(AppPath,i+1,Len(AppPath))
AppPath = LeftString & "\" & RightString
end if
next
' Make sure the path ends in if right(AppPath,1) <> "\" then
AppPath = AppPath & "\"
end if
' Determine path to datapage from which this report is being run
Path = Request.QueryString("RP"
if right(Path,1) <> "\" then
Path = Path & "\"
end if
' Hardcoded Report Name
' ---------------------
if Reportname <> Request.QueryString("Name"
then
Path = "c:\inetpub\
else
Path = Path & "Reports\"
end if
if right(Path,1) <> "\" then
Path = Path & "\"
end if
if Reportname <> Request.QueryString("Name"
then
' . . . . . . . . . . . . . . . . . . . . . . . . . added by -dh 9/14/2000
dim qsName
dim iSlash
qsName = Request.QueryString("Name"
ReportName = Path & Right(qsName,len(qsName) - 3)
Path = ""
' The directory was passed so check to make sure the report exists
if not(FSO.FileExists(Path & Reportname)) then
Response.Write ("Hard coded filename not valid.<BR>"
Response.Write ("Error: " & Path & Reportname & " not found.<BR>"
Response.Write ("Path = " & Path & "<BR>"
Response.Write ("ReportName = " & ReportName & "<BR>"
set FSO = nothing
' Everything is cool, set up variables for use when opening the report
else
'ReportName = Request.QueryString("Name"
'I cut this -dh +++++++++++++++
'Path = ""
end if
' Look for the report in the Xtend directory, this is first place to look if not hard coded
elseif FSO.FileExists(AppPath & "xtend\reports\" & ReportName) then
Path = AppPath & "xtend\reports\"
' Look for report in the common application directory
elseif FSO.FileExists(AppPath & "common\reports\" & ReportName) then
Path = AppPath & "common\reports\"
' Look for report in reports subdirectory under the page where the report was generated
' If not found, the report was not found and there is an error condition
elseif not(FSO.FileExists(Path & ReportName)) then
Response.Write ("Error: " & Path & Reportname & " not found.<BR>"
set FSO = nothing
Response.end
end if
' Clean up
Set FSO = nothing
'==================================================================
' Clear report session variable
if isobject(session("oRpt"
) then
set session("oRpt"
= nothing
end if
PathReportName = Path & ReportName
on error resume next
Set session("oRpt"
= session("oApp"
.OpenReport(path & ReportName, 1)
ErrNumber = Err.Number
on error goto 0
' BARTZ
' -----
SQL = "exec dbo.rpInsertReportLog "
SQL = SQL & "'" & PathReportName & "',"
SQL = SQL & "'Creating Session(oRpt)',"
SQL = SQL & Err.Number & ","
SQL = SQL & "'" & Session("Staff_Name"
& "'"
set rsReportLog = DB.execute(SQL)
set rsReportLog = nothing
if ErrNumber <> 0 Then
Response.Write "<BR>An Error has occurred on the server in attempting to access the following data source - " & DSN
Response.Write "<BR>Crystal Error: " & ErrNumber
Response.End
end if
' Check for errors when opening the report
if not isobject(Session("oRpt"
) then
Response.write("<BR>Unable to open report " & path & ReportName)
Response.End
end if
Session("oRpt"
.MorePrintEngineErrorMessages = False
Session("oRpt"
.EnableParameterPrompting = False
Set CRTables = Session("oRpt"
.Database.Tables
CRTablesCnt = CRTables.Count
For i = 1 to CRTablesCnt
Set CRTable = CRTables.Item(cint(i))
CRTable.SetLogOnInfo cstr(DSN), cstr(DBName), cstr(userid), cstr(password)
Next
Set CRTables = Nothing
Set CRSections = Session("oRpt"
.Sections
CRSectionsCnt = CRSections.Count
For i = 1 to CRSectionsCnt
Set CRReports = CRSections.Item(CInt(i)).ReportObjects
CRReportsCnt = CRReports.Count
For j = 1 to CRReportsCnt
If CRReports.Item(CInt(j)).Kind = 5 Then
Set CRSubreport = session("oRpt"
.OpenSubreport(CRReports.Item(CInt(j)).SubReportName)
Set CRTables = CRSubreport.Database.Tables
CRTablesCnt = CRTables.Count
For m = 1 to CRTablesCnt
CRTables.Item(m).SetLogOnInfo cstr(DSN), cstr(DBName), cstr(userid), cstr(password)
Next
End if
Next
Next
Set StoredProcParamCollection = Session("oRpt"
.ParameterFields
i = 0
For each Item in StoredProcParamCollection
i = i + 1
if ubound(Parms) >= i then
Temp = Parms(i)
select case Item.ValueType
case 7
' Number field
' Need to check to see if ANY of the parameters is blank
' If it's blank, set the value to 0 so it won't cause problems
if trim(Temp) = "" Then
Temp = 0
end if
Item.SetCurrentValue cdbl(Temp)
case 16,10
' Date & DateTime fields
Temp = trim(Temp)
if instr(temp,"/"
< 4 then
dim TempDate
dim strTemp
TempDate = left(Temp, instr(Temp, " "
)
if len(month(TempDate)) < 2 then
Temp = year(TempDate) & "/0" & month(TempDate)
else
Temp = year(TempDate) & "/" & month(TempDate)
end if
if len(day(TempDate)) < 2 then
Temp = Temp & "/0" & day(TempDate)
else
Temp = Temp & "/" & day(TempDate)
end if
'add time if type DateTime, otherwise leave as just date
if Item.ValueType = 16 then
Temp = Temp & " 00:00:00.000"
end if
end if
Temp= mid(Temp,6,2) & "/" & _
mid(Temp,9,2) & "/" & _
left(Temp,4)
Item.SetCurrentValue cdate(Temp)
case else
Item.SetCurrentValue cstr(Temp)
end select
else
Item.SetCurrentValue Item.DefaultValue,Item.ValueType
end if
next
Set CRTables = Nothing
Set CRTable = Nothing
Set CRSubreport = Nothing
Set CRReports = Nothing
Set CRSections = Nothing
'==================================================================
' Retrieve the Records
On Error Resume Next
session("oRpt"
.ReadRecords
ErrNumber = Err.Number
On Error GoTo 0
' BARTZ
' -----
SQL = "exec dbo.rpInsertReportLog "
SQL = SQL & "'" & PathReportName & "',"
SQL = SQL & "'Reading Records',"
SQL = SQL & Err.Number & ","
SQL = SQL & "'" & Session("Staff_Name"
& "'"
set rsReportLog = DB.execute(SQL)
set rsReportLog = nothing
if ErrNumber <> 0 Then
Response.Write "<BR>An Error has occurred on the server in attempting to access the following data source - " & DSN
Response.Write "<BR>Crystal Error: " & ErrNumber
if ErrNumber = 20534 then
Response.Write "<BR>The stored procedure may have returned an error."
elseif ErrNumber = 20599 then
Response.Write "<BR>There may be a security issue on the server."
end if
else
if isobject(session("oPageEngine"
) then
set session("oPageEngine"
= nothing
end if
Set session("oPageEngine"
= session("oRpt"
.PageEngine
end If
DB.Close
Set DB = nothing
'==================================================================
' Display the report using a smart viewer
%>
<BODY BGCOLOR=C6C6C6 LANGUAGE=VBScript ONLOAD="Page_Initialize">
<p align="left">
<BUTTON NAME=cmdClose ACCESSKEY=C><U>C</U>lose</BUTTON>
</p>
<p align="left">
<OBJECT ID="CRViewer"
CLASSID="CLSID:C4847596-972C-11D0-9567-00A0C9273C2A"
WIDTH=100% HEIGHT=95%
codebase="../../../../../../../../../../../../../../viewer/activeXViewer/activexviewer.cab#Version=8,0,0,224">
<PARAM NAME="EnableRefreshButton" VALUE=0>
<PARAM NAME="EnableGroupTree" VALUE=1>
<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>
</OBJECT>
</p>
<SCRIPT LANGUAGE="VBScript">
<!--
Sub Page_Initialize
dim Temp
Temp = location.href
Temp = left(Temp,instr(Temp,"?"
- 1)
Temp = left(Temp,instrRev(Temp,"/"
) & "rptserver.asp"
On Error Resume Next
Dim webBroker
Set webBroker = CreateObject("WebReportBroker.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."
CRViewer.ReportName = Temp
else
Dim webSource
Set webSource = CreateObject("WebReportSource.WebReportSource"
webSource.ReportSource = webBroker
webSource.URL = Temp
webSource.PromptOnRefresh = True
CRViewer.ReportSource = webSource
end if
CRViewer.ViewReport
End Sub
Sub cmdClose_OnClick
window.close
End Sub
-->
</SCRIPT>
<%
' Set Server Script Timout back to default
Server.ScriptTimeout = 90
%>
</BODY>
</HTML>
