Dim reportClientDocument
Dim reportId, reportNumber, schedule
reportId = CLng(Request.QueryString("reportID"))
If (Request.QueryString("reportID").Count = 0) Then
reportId = Request.QueryString("id")
End If
schedule = cStr(Request.QueryString("schedule"))
If (Len(schedule) = 0) Then
schedule = "false"
Else
schedule = "true"
End If
'ref: crFieldValueTypeEnum - CE COM SDK
Dim crFieldValueTypeNumberField, crFieldValueTypeCurrencyField, crFieldValueTypeBooleanField, crFieldValueTypeDateField, crFieldValueTypeTimeField, crFieldValueTypeDateTimeField, crFieldValueTypeStringField
crFieldValueTypeNumberField = 6 'Number Type
crFieldValueTypeCurrencyField = 7 'Currency Type
crFieldValueTypeBooleanField = 8 'Boolean Type
crFieldValueTypeDateField = 9 'Date Type
crFieldValueTypeTimeField = 10 'Time Type
crFieldValueTypeDateTimeField = 15 'DateTime Type
crFieldValueTypeStringField = 11 'String Type
<%
' This subroutine places a text box on the page with a default value.
'
' Parameters:
'
' key [In]
' A Long number that uniquely identifies the text box. This is a number that is
' appended to the word 'Text'.
'
' hidden [In]
' A Boolean that is set to True if the text box is hidden and False otherwise.
'
' value [In]
' A String that specifies the default value for the text box.
Sub WriteTextBox(fieldName, key, hidden, value)
Dim ControlType
If hidden Then
ControlType = "Hidden"
Else
ControlType="text"
End If
Response.Write vbCrLf & "<input type='" & ControlType & "' name='" & CStr(fieldName) & "' size='20' value='" & value & "'>" & VBcrlf
End Sub
Sub WriteSelectBox(fieldName, key, hidden, value)
Dim ControlType
If hidden Then
ControlType = "Hidden"
Else
ControlType="text"
End If
Response.Write vbCrLf & "<br><select multiple name='" & CStr(fieldName) & "' size='4' value='" & value & "' onDblClick='this.options[this.selectedIndex]=null;' style='width:150px;'><option value='*'>*</select>" & VBcrlf
End Sub
Sub WriteComboBox(parameter, key)
Dim ControlType, value
Response.Write vbCrLf & "<select id='Drop" & CStr(parameter.Name) & "' name='" & CStr(parameter.Name) & "' style='width:150px;' onChange='document.ParamForm."&CStr(parameter.Name)&".value=this.value'>"
For Each value In parameter.DefaultValues
Response.Write vbCrLf & "<option value='"&value.Value&"'>"&value.Value
Next
Response.Write vbCrLf & "</select>"
End Sub
' Places a drop-down list on the page. When the user changes the value
' in the drop-down list, the text box that has the same key will reflect
' this change.
'
' Parameters:
'
' key [In]
' A Long number that uniquely identify the text box. This is a number that is
' appended to the word 'Drop'.
'
' values [In]
' A Values collection that specifies the parameter values that are entered into
' the drop-down list.
Sub WriteDropDownBox(parameter, fieldName, key, values)
Dim value
If (parameter.AllowCustomCurrentValues) Then
Response.Write vbCrLf & "<input Name='Text" & CStr(key) & "' style='width:150px;' " & _
"onKeyPress=""if (window.event.keyCode == 13) { document.ParamForm.Drop" & CStr(key) & _
".options[document.ParamForm.Drop" & CStr(key) & _
".options.length] = new Option(this.value.toUpperCase(), this.value); UpdateText(this.value.toUpperCase(), document.ParamForm." & _
CStr(fieldName) & "); this.value=''; return false; }""><br>"
End If
' This subroutine places controls on the page to allow the user to choose a
' new value for the discrete parameter. Two controls are placed on the page: the
' first is a text box, which allows the user to enter a custom value, and the
' second is a drop-down list, which lists the default values for the parameter.
' When the user chooses a value from the drop-down list, this value is placed
' in the text box, which is used by the script to contain the value. If the
' parameter does not allow custom values to be entered, the text box is hidden.
'
' Two controls are placed on the page because HTML does not support list boxes
' whose contents can be edited by the user.
'
' Parameters:
'
' parameter [In]
' A ParameterField object that specifies the parameter field whose current
' value will be chosen.
'
' key [In]
' A Long number that is used to uniquely identify the parameter.
Sub WriteDiscreteParam(parameter, key, multivalue)
Dim currentValue, fieldName
fieldName = parameter.Name
If parameter.CurrentValues.Count > 0 Then
currentValue = parameter.CurrentValues(0).Value
End If
Response.Write vbCrLf & "<i style='font-size:8pt'>Selected Parameters</i>"
WriteSelectBox parameter.Name, key, Not parameter.AllowCustomCurrentValues, currentValue
Response.Write vbCrLf & "</td></tr></table>"
Else
If ((parameter.Type = 15) Or (parameter.Type = 9)) Then
WriteCalendar parameter.Name, key, "Horizontal"
Else
If parameter.DefaultValues.Count > 0 Then
WriteComboBox parameter, key
Else
WriteTextBox parameter.Name, key, Not parameter.AllowCustomCurrentValues, currentValue
End If
End If
End If
Response.Write vbCrLf & "</td></tr></table>"
End Sub
' This subroutine places controls on the page that allow the user to select a current
' value for the range parameter. See the description of WriteDiscreteParam for details.
'
' Parameters:
'
' parameter [In]
' A ParameterField object that specifies the parameter field whose current value
' will be chosen.
'
' key [In]
' A Long number that is used to uniquely identify the parameter.
Sub WriteRangeParam(parameter, key)
Dim currentToValue, currentFromValue
If parameter.CurrentValues.Count > 0 Then
currentToValue = parameter.CurrentValues.Item(0).EndValue
currentFromValue = parameter.CurrentValues.Item(0).BeginValue
End If
If ((parameter.Type = crFieldValueTypeDateTimeField) Or (parameter.Type = crFieldValueTypeDateField)) Then
Response.Write vbCrLf & "<table><tr><td><i style='font-size=8pt'>From</i><br>"
Dim originalParameterName
originalParameterName = parameter.Name
Else
Response.Write "From:" & parameter.Type
WriteTextBox parameter.Name, key, Not parameter.AllowCustomCurrentValues, currentFromValue
WriteDropDownBox parameter, parameter.Name, key, parameter.DefaultValues
Response.Write "<br>To:"
WriteTextBox parameter.Name, key+1, Not parameter.AllowCustomCurrentValues, currentToValue
WriteDropDownBox parameter, parameter.Name, key+1, parameter.DefaultValues
End If
End Sub
' This subroutine places controls on the page that allow the user to select
' a current value for a parameter that may be ranged or discrete or both.
' See the description of WriteDiscreteParam for details.
'
' Parameters:
'
' parameter [In]
' A ParameterField object that specifies the parameter field whose current value
' will be chosen.
'
' key [In]
' A Long number that is used to uniquely identify the parameter.
If parameter.CurrentValues.Count > 0 Then
' Checks to see if the parameter value is ranged or discrete.
If parameter.CurrentValues(0).ClassName = "ParameterFieldRangeValue" Then
currentToValue = parameter.CurrentValues(0).EndValue
currentFromValue = parameter.CurrentValues(0).BeginValue
Else
currentDiscreteValue = parameter.CurrentValues(0).Value
End If
End If
' Places the controls on the page.
Response.Write "Enter a range value or a discrete value for this parameter." & _
"You must leave one of the values blank.<br>"
' Controls for a range value.
Response.Write "<b>Range Value</b><br>"
Response.Write "From:"
WriteTextBox parameter.Name, key, Not parameter.AllowCustomCurrentValues, currentFromValue
WriteDropDownBox parameter, parameter.Name, key, parameter.DefaultValues
' Controls for a discrete value.
Response.Write "<br><b>Discrete Value</b><br>"
WriteTextBox parameter.Name, key+2, Not parameter.AllowCustomCurrentValues, currentDiscreteValue
WriteDropDownBox parameter, parameter.Name, key+2, parameter.DefaultValues
End Sub
'Prints a table of controls that allows the user to specify new values
'for the parameters in the report.
'
'Parameters:
'
' openReport [In]
' A ReportClientDocument that specifies the report whose parameters will be changed.
Sub PrintParams(OpenReport)
With OpenReport.DataDefinition
If .ParameterFields.Count = 0 Then
Response.Write vbCrLf & "<br>"
Else
' NameKey assigns a unique key to each parameter control.
' Field is the current field being examined.
' Colour is used to make the table of parameters more readable.
Dim NameKey, Field, Colour, ParamNum
NameKey=0
ParamNum = 1
If (schedule = "true") Then
Response.Write "<form name='ParamForm' action='ScheduleReport.asp' method='GET'>"
Else
Response.Write "<form name='ParamForm' action='ViewReport.asp' method='GET'>"
End If
Response.Write "<table border=1 cellspacing=0 width=""100%"">"
' Prints each parameter in the report.
For Each Field in .ParameterFields
'For Each Field in .ResultFields
'If (Field.Kind <> 3) Then
If (true) Then
If ((ParamNum Mod 2) = 1) Then
Response.Write vbCrLf & "<tr>"
If Colour = "#FFFFFF" Then
Colour = "#D4D0C8"
Else
Colour = "#FFFFFF"
End If
Else
Response.Write vbCrLf
End If
Response.Write vbCrLf & "<td Bgcolor=" & Colour & " valign='top'>"
If (Len(Field.Description) > 0) Then
Response.Write vbCrLf & "<b>" & Field.Description & "</b><BR>"
Else
Response.Write vbCrLf & "<b>" & Field.DisplayName(0) & "</b><BR>"
End If
' Checks the kind of parameter field and prints
' the appropriate controls.
'
' Note: The NameKey is incremented by the number of pairs of
' controls a parameter will need. Each pair of controls consists
' of one text box and one drop-down list.
Select Case Field.ValueRangeKind
' Ranged parameter.
Case 0
WriteRangeParam Field,NameKey
NameKey = NameKey + 2
' Discrete parameter.
Case 1
WriteDiscreteParam Field,NameKey, field.AllowMultiValue
NameKey = NameKey + 1
' Discrete and ranged parameter.
' This means that you can supply either a range value
' or a discrete value for this parameter.
Case 2
WriteRangeDiscreteParam Field, NameKey
NameKey = NameKey + 3
End Select
ParamNum = ParamNum + 1
End If
Next
If (schedule = "true") Then
If ((ParamNum Mod 2) = 1) Then
Response.Write vbCrLf & "<tr>"
If Colour = "#FFFFFF" Then
Colour = "#D4D0C8"
Else
Colour = "#FFFFFF"
End If
Else
Response.Write vbCrLf
End If
Response.Write vbCrLf & "<td><b>Scheduling Options</b> <select name='RightNow' id='RightNow'><option value='true'>Now<option value='false'>Calendar<br>"
If (schedule = "true") Then
Response.Write vbCrLf & "<input type='submit' class='button' value='Schedule Report' name='cmdSaveParameters' id='cmdSaveParameters' onClick='this.style.visibility=""hidden""; document.all.emailAddress.value += ""@faa.gov""; selectAllOptionValues();'><br><br>"
Else
Response.Write vbCrLf & "<input type='submit' class='button' value='Generate Report' name='cmdSaveParameters' id='cmdSaveParameters' onClick='this.style.visibility=""hidden""; selectAllOptionValues();'><br><br>"
End If
Response.Write vbCrLf & "<input type='hidden' name='reportID' value='" & reportId & "'>"
Response.Write vbCrLf & "</form>"
End If
End With
End Sub
%>
<%
' Attempts to open the report and redirects to Error.asp if it fails.
If (IsNull(OpenReport(reportId)) Or Not(IsObject(OpenReport(reportId)))) Then
redirectWithError "Error.asp", "The following report could not be opened: <i>Report # " & reportId & "</i>"
End If
Dim Report
Set Report = OpenReport(reportId)
Dim eSession
'Logs the user onto Crystal Enterprise.
Set eSession = CreateObject("CrystalEnterprise.SessionMgr").Logon(Username, Password, CMS, Authtype)
Dim iStore
'Creates the InfoStore object.
Set iStore = eSession.Service("", "InfoStore")
Dim reportAppFactory
Set reportAppFactory = iStore.EnterpriseSession.Service("","RASReportFactory")
on error resume next
Set reportClientDocument = reportAppFactory.OpenDocument(Report)
%>
<html>
<head>
<script language="Javascript" src="../calendar.js"></script>
<script language="Javascript">
function UpdateText(NewText,TextBox) {
// If this is an asteriks, delete everything
if (NewText == "*") {
for (var i = 0; i < TextBox.options.length; i++) {
TextBox.options = null; i--;
}
} else {
for (var i = 0; i < TextBox.options.length; i++) {
// If this is a duplicate, return immediately
if (TextBox.options.text == NewText) return;
// Next, if we find an asteriks, then remove it
if (TextBox.options.text == "*") { TextBox.options = null; i--; }
}
}
// Finally, insert the new item
TextBox.options[TextBox.options.length] = new Option(NewText, NewText);
}
function selectAllOptionValues() {
for (var i = 0; i < document.ParamForm.elements.length; i++) {
if (eval("document.ParamForm.elements[" + i + "]").id.indexOf("Drop",0) == 0) continue;
if (eval("document.ParamForm.elements[" + i + "]").id.indexOf("Month",0) == 0) continue;
if (eval("document.ParamForm.elements[" + i + "]").id.indexOf("RightNow",0) == 0) continue;
if (eval("document.ParamForm.elements[" + i + "]").id.indexOf("ScheduleDestination",0) == 0) continue;
if (eval("document.ParamForm.elements[" + i + "].options") == null) continue;
var len = eval("document.ParamForm.elements[" + i + "].options.length");
for (var j = (len-1); j >= 0; j--) {
eval("document.ParamForm.elements[" + i + "].options[" + j + "].selected = true");
}
}
for (var i = 0; i < 1000; i++) {
if (eval("document.ParamForm.Drop" + i + "") == null) break;
var len = eval("document.ParamForm.Drop" + i + ".options.length");
eval("document.ParamForm.Drop" + i + ".options.selectedIndex = -1");
}
}
function validateEMail(txtField) {
var email = txtField.value;
if (email.indexOf("@") >= 0) {
txtField.value = email.substring(0,email.indexOf("@"));
}
}
function autoForwardIfNoParameters() {
if (document.forms.length == 0) {
window.location = 'ViewReport.asp?reportID=<%= reportID %>';
}
}
</script>
<title>NIMS Reporting - Parameter Selection</title>
</head>
<body onload="if (false) autoForwardIfNoParameters();">
<%
' If the report has already been scheduled and run successfully, then display it
If (Report.SchedulingInfo.Status =1) Then
Response.Redirect "/crystal/enterprise10/ePortfolio/en/nims_viewer/ViewReportInstance.asp?id=" + reportId
Else
PrintParams reportClientDocument
End If
if err.number <> 0 then
response.write "Failed to load report" & "</BR>"
response.write "error number: " & err.number & "</BR>"
response.write "error description: " & err.description
end if
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.