Hi Turkbear,
PickParamValues.asp
--------------------------
<%@ Language=VBScript codepage=1252 %>
<% Option Explicit %>
<%
Response.ContentType = "text/html"
Response.CharSet = "UTF-8"
Session.CodePage = 65001
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
%>
<!-- #include file="Utilities.asp" -->
<!-- #include file="Constants.asp" -->
<%
' 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
Response.Write vbCrLf & "<select Size=4 id='Drop" & CStr(key) & "' Name='Drop" & CStr(key) & _
"' onDblclick=""UpdateText(document.ParamForm.Drop" & _
CStr(key) & ".options[document.ParamForm.Drop" & _
CStr(key) & ".selectedIndex].text,document.ParamForm." & _
CStr(fieldName) & ")"" style='width:150px;'>"
For Each value in values
Response.Write vbCrLf & "<option>" & value.Value & "</option>"
Next
Response.Write vbCrLf & "</select>"
End Sub
' 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
If multivalue Then
Response.Write vbCrLf & "<table><tr><td>"
WriteDropDownBox parameter, parameter.Name, key, parameter.DefaultValues
Response.Write vbCrLf & "</td><td><img src='right-arrow.gif' onclick=""UpdateText(document.ParamForm.Drop" & _
CStr(key) & ".options[document.ParamForm.Drop" & _
CStr(key) & ".selectedIndex].text,document.ParamForm." & _
CStr(fieldName) & ")""><br><img src='left-arrow.gif' onClick=""document.ParamForm."&CStr(fieldName)&".options[document.ParamForm."&CStr(fieldName)&".selectedIndex] = null""></td><td>"
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
End Sub
' This subroutine places a calendar control on the page so that the user can select a date without a popup
Sub WriteCalendar(parameterName, key, orientation)
Response.Write vbCrLf & "<script>"
Response.Write vbCrLf & "function redirectCalendar" & CStr(key) & "() {"
Response.Write vbCrLf & " var cal = document.Calendar" & CStr(key)
Response.Write vbCrLf & " var year = document.all.Year" & CStr(key) & ".value"
Response.Write vbCrLf & " var month = document.all.Month" & CStr(key) & ".options[document.all.Month" & CStr(key) & ".selectedIndex].value"
Response.Write vbCrLf & " var dDate = new Date(document.all." & parameterName & ".value).getDate()"
Response.Write vbCrLf & " if ((dDate > 30) && ((month==4) || (month==6) || (month==9) || (month==11))) dDate = 1;"
Response.Write vbCrLf & " if ((dDate >= 29) && (month==2)) dDate = 1;"
Response.Write vbCrLf & " cal.location.href='Calendar.asp?parameter=" & parameterName & "&date='+month+'/'+dDate+'/'+year"
Response.Write vbCrLf & "}"
Response.Write vbCrLf & "function redirectCalendar" & CStr(key) & "Today() {"
Response.Write vbCrLf & " document.all.Year" & CStr(key) & ".value = " & Year(Date)
Response.Write vbCrLf & " document.all.Month" & CStr(key) & ".selectedIndex = " & (Month(Date)-1)
Response.Write vbCrLf & " redirectCalendar" & CStr(key) & "();"
Response.Write vbCrLf & "}"
Response.Write vbCrLf & "function advanceCalendar" & CStr(key) & "ByMonth() {"
Response.Write vbCrLf & " if (document.all.Month" & CStr(key) & ".selectedIndex == 11) {"
Response.Write vbCrLf & " document.all.Month" & CStr(key) & ".selectedIndex = 0;"
Response.Write vbCrLf & " document.all.Year" & CStr(key) & ".value++;"
Response.Write vbCrLf & " } else {"
Response.Write vbCrLf & " document.all.Month" & CStr(key) & ".selectedIndex++;"
Response.Write vbCrLf & " }"
Response.Write vbCrLf & " redirectCalendar" & CStr(key) & "();"
Response.Write vbCrLf & "}"
Response.Write vbCrLf & "function advanceCalendar" & CStr(key) & "ByYear() {"
Response.Write vbCrLf & " document.all.Year" & CStr(key) & ".value++;"
Response.Write vbCrLf & " redirectCalendar" & CStr(key) & "();"
Response.Write vbCrLf & "}"
Response.Write vbCrLf & "function retreatCalendar" & CStr(key) & "ByMonth() {"
Response.Write vbCrLf & " if (document.all.Month" & CStr(key) & ".selectedIndex == 0) {"
Response.Write vbCrLf & " document.all.Month" & CStr(key) & ".selectedIndex = 11;"
Response.Write vbCrLf & " document.all.Year" & CStr(key) & ".value--;"
Response.Write vbCrLf & " } else {"
Response.Write vbCrLf & " document.all.Month" & CStr(key) & ".selectedIndex--;"
Response.Write vbCrLf & " }"
Response.Write vbCrLf & " redirectCalendar" & CStr(key) & "();"
Response.Write vbCrLf & "}"
Response.Write vbCrLf & "function retreatCalendar" & CStr(key) & "ByYear() {"
Response.Write vbCrLf & " document.all.Year" & CStr(key) & ".value--;"
Response.Write vbCrLf & " redirectCalendar" & CStr(key) & "();"
Response.Write vbCrLf & "}"
Response.Write vbCrLf & "</script>"
Response.Write vbCrLf & "<input type='hidden' id='" & parameterName & "' name='" & parameterName & "' value='" & Date & "'>"
Response.Write vbCrLf & "<table border='0' cellspaing='0' cellpadding='0'><tr><td>"
' Create a hidden input field for the date value, just in case
' Next, display some header fields (i.e. Month, Year, navigation buttons)
Response.Write vbCrLf & "<select id='Month" & CStr(key) & "' name='Month" & CStr(key) & _
"' onChange='redirectCalendar" & CStr(key) & "();'>"
Dim I
For I = 1 To 12
If (Month(Date) = I) Then
Response.Write vbCrLf & " <option value='" & I & "' selected>" & MonthName(I)
Else
Response.Write vbCrLf & " <option value='" & I & "'>" & MonthName(I)
End If
Next
Response.Write vbCrLf & "</select>"
Response.Write vbCrLf & "<input type='text' value='" & Year(Date) & "' size='4' name='Year" & CStr(key) & "' onKeyUp='redirectCalendar" & CStr(key) & "();'><br>"
Response.Write vbCrLf & "<input type='button' value='<<' style='width:25px' onClick='retreatCalendar" & CStr(key) & "ByYear();'>"
Response.Write "<input type='button' value='<' style='width:25px' onClick='retreatCalendar" & CStr(key) & "ByMonth();'>"
Response.Write "<input type='button' value='Today' onClick='redirectCalendar" & CStr(key) & "Today();'>"
Response.Write "<input type='button' value='>' style='width:25px' onClick='advanceCalendar" & CStr(key) & "ByMonth();'>"
Response.Write "<input type='button' value='>>' style='width:25px' onClick='advanceCalendar" & CStr(key) & "ByYear();'>"
If (orientation = "Horizontal") Then
Response.Write vbCrLf & "</td><td>"
Else
Response.Write "<br>"
End If
Response.Write vbCrLf & "<iframe name='Calendar" & CStr(key) & "' width='145' height='120' border='0' src='Calendar.asp?parameter=" & parameterName & "&date=" & Date & "'></iframe>"
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
parameter.Name = originalParameterName + "LowerBound"
WriteCalendar parameter.Name, key, "Vertical"
Response.Write vbCrLf & "</td><td><i style='font-size=8pt'>To</i><br>"
key = key + 1
parameter.Name = originalParameterName + "UpperBound"
WriteCalendar parameter.Name, key, "Vertical"
Response.Write vbCrLf & "</td></tr></table>"
parameter.Name = originalParameterName
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.
Sub WriteRangeDiscreteParam(parameter, key)
Dim currentToValue, currentFromValue, currentDiscreteValue
currentToValue = ""
currentFromValue = ""
currentDiscreteValue = ""
' Gets the first current value.
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
Response.Write "<br>To:"
WriteTextBox parameter.Name, key+1, Not parameter.AllowCustomCurrentValues, currentToValue
WriteDropDownBox parameter, parameter.Name, key+1, 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 vbCrLf & "<h4>" & OpenReport.DisplayName & "</h4>" & vbCrLf
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>"
'Dim pField
'Set pField = .ParameterFields(1).Clone
'pField.Name = "ScheduleDate"
WriteCalendar "ScheduleDate", NameKey, "Vertical"
Response.Write vbCrLf & "<b>Time: <input type='text' name='ScheduleHour' size='2' value='00'>:"
Response.Write vbCrLf & "<input type='text' name='ScheduleMinute' size='2' value='00'>:"
Response.Write vbCrLf & "<input type='text' name='ScheduleSecond' size='2' value='00'></b><br>"
Response.Write vbCrLf & "<b>Destination: <select name='ScheduleDestination' id='ScheduleDestination' onChange='if (this.selectedIndex == 0) document.all.emailAddress.style.visibility = ""hidden""; else document.all.emailAddress.style.visibility = ""visible"";'>"
Response.Write vbCrLf & "<option value='Server'>Reporting Server</select>"
'Response.Write vbCrLf & "<option value='EMail'>EMail</b>"
'Response.Write vbCrLf & " <input type='text' name='emailAddress' style='visibility: hidden;' onBlur='validateEMail(this);' onKeyPress='validateEMail(this);' onChange='validateEMail(this);'>"
Response.Write vbCrLf & "</td>"
End If
Response.Write vbCrLf & "</table><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
%>
</body>
</html>