<% '============================================================= '// '// Action Button Control '// '// version: 1.0 '// last modified: 06-Aug-2004 13:38 by Sasha Vukovic '============================================================= %> <% '--------------- Global Constants ---------------- Const enumABTNCTRL_ON_READONLY_HIDE = 1 Const enumABTNCTRL_ON_READONLY_DISABLE = 2 '------------------------------------------------- Class ActionButtonControl Private mArrAbtnDef() Private mobjNameDefMap ' Item can be accesed by name. Must be unique within one page Private mobjIdDefMap ' Item can be accesed by id. Must be unique within one page. If NULL, ubound is assigned to it Private mobjSeparator ' Has a name of item after separator is applied Private mnButtonSpacer Private mnButtonTextSpace Private mNumOfProperties Private mLastPropertyInx Private mbDisableAll Private mbIsReadonly Private mReadonlyActionBehaviour Private InxID Private InxName Private InxTxt Private InxLink Private InxEventHandler Private InxImg Private InxImgOff Private InxHint Private InxActive Private InxIsReadonlyAction Public Property Let AllActive ( cActive ) If cActive = enumDB_NO Then mbDisableAll = TRUE Else mbDisableAll = FALSE End If End Property Public Property Let ButtonSpacer ( nWidth ) mnButtonSpacer = nWidth End Property Public Property Let ButtonTextSpacer ( nWidth ) mnButtonTextSpace = nWidth End Property Public Property Let IsReadonlyAction ( IsReadonly ) If IsReadonly = enumDB_YES Then mbIsReadonly = TRUE ElseIf IsReadonly = enumDB_NO Then mbIsReadonly = FALSE Else mbIsReadonly = IsReadonly End If End Property Public Property Let ReadonlyActionBehaviour ( nEnum ) mReadonlyActionBehaviour = nEnum End Property '----------------------------------------------------------------------------------------------------------------- Private Sub SetItemPropertyByIndex ( nInx, nProperty, Value ) If nInx = "" OR nProperty = "" OR Value = "" Then Err.Raise 8, "Method SetItemPropertyByIndex", "Empty parameters found. nInx="& nInx &", nProperty="& nProperty &", Value="& Value mArrAbtnDef ( nProperty, nInx ) = Value 'Response.write "mArrAbtnDef ( "& nProperty &", "& nInx &" ) = "& Value &"
" End Sub '----------------------------------------------------------------------------------------------------------------- Private Function LastItemInx () LastItemInx = UBound ( mArrAbtnDef, 2 ) End Function '----------------------------------------------------------------------------------------------------------------- Public Sub AddActionButton ( sItemName, nItemID ) Dim newArrayDim If InStr( sItemName, " " ) > 0 Then Err.Raise 8, "Method AddActionButton", "Item Name '"& sItemName &"' cannot have spaces." If NOT mobjNameDefMap.Exists (CStr( sItemName )) Then newArrayDim = LastItemInx() + 1 ReDim Preserve mArrAbtnDef( mNumOfProperties, newArrayDim ) ' Store name Call SetItemPropertyByIndex ( newArrayDim, InxName, sItemName ) mobjNameDefMap.Add Cstr( sItemName ), CStr( newArrayDim ) If Not IsNull(nItemID) Then ' Store ID Call SetItemPropertyByIndex ( newArrayDim, InxdbID, nItemID ) mobjIdDefMap.Add Cstr( nItemID ), CStr( newArrayDim ) End If ' Set Defaults Call SetItemDefaults ( sItemName ) Else Err.Raise 8, "Method AddActionButton", "Item Name '"& sItemName &"' has been already defined." End If End Sub '----------------------------------------------------------------------------------------------------------------- Public Sub Render ( aAbtnList ) Dim itemInx, itemName, nLastItemInx, btnImage, ButtonStr, ButtonStrDisabled Response.write "" For Each itemName in aAbtnList itemInx = mobjNameDefMap.Item (Cstr(itemName)) 'If itemInx = "" Then Err.Raise 8, "Method Render", "Definition for item name '"& itemName &"' not found." '-- Define Image btnImage = "" If (mArrAbtnDef( InxImg, itemInx ) <> "") Then btnImage = "" End If '-- Define Button ButtonStr = _ "" '-- Define Disabled Button ButtonStrDisabled = _ "" If mbDisableAll OR ( mArrAbtnDef( InxActive, itemInx ) = enumDB_NO ) Then ' --- Display DISABLED Button Item --- Response.write ButtonStrDisabled Else ' --- Display Action Button Item --- If ( NOT mbIsReadonly ) OR _ ( mbIsReadonly AND mArrAbtnDef( InxIsReadonlyAction, itemInx ) = enumDB_YES ) Then If InStr( itemName, "width=" ) > 0 Then Response.write "" ElseIf InStr( itemName, "height=" ) > 0 Then Response.write "" Else '/* It is a button, i.e. Display Button */ Response.write ButtonStr If mnButtonSpacer > 0 Then Response.write "" End If End If ElseIf ( mbIsReadonly AND mArrAbtnDef( InxIsReadonlyAction, itemInx ) = enumDB_NO ) Then If mReadonlyActionBehaviour = enumABTNCTRL_ON_READONLY_DISABLE Then Response.write ButtonStrDisabled End If End If End If ' --- Separators added manually using method AddSeparator or AddSeparatorAfter --- If mobjSeparator.Exists ( Cstr(mArrAbtnDef( InxName, itemInx )) ) Then Response.write "" End If Next Response.write "
"&_ ""&_ btnImage & mArrAbtnDef( InxTxt, itemInx ) &""&_ ""&_ ""&_ ""&_ "
" End Sub '----------------------------------------------------------------------------------------------------------------- ' Return true if required_abtnName is one of the strings in the aAbtnList string array, else return false Private Function isAbtnRequired (aAbtnList, required_abtnName) Dim this_abtnName isAbtnRequired = FALSE For Each this_abtnName in aAbtnList If 0 = StrComp(this_abtnName, required_abtnName) Then isAbtnRequired = TRUE Exit Function End If Next End Function '----------------------------------------------------------------------------------------------------------------- Public Sub LoadActionButtons ( aAbtnList, ByRef objOraDatabase ) ' The following code is now used in place of the earlier code to acquire action button records. ' ' This code exploits the fact that in ADO 2.8 onwards, you can create ADO DB record sets ' without a connection to an actual database. So, to rid ourselves of the need for a DEF_ACTION_BUTTONS ' table in the database, we can simply take all of the table's rows and reproduce them here in row ' creation and field assignment statements. The rest of the website code will be ignorant of the fact ' that the data has not come from the actual database. ' ' Complicating factors: ' 1) Some action button fields (action_link and event_handler) are to be EVAL'ed later on when used ' to render the HTML page. This can lead to some very complex looking strings that are difficult to ' understand. EVAL allows things like parRtag_id used in a string to be converted to an actual ' number (in string form) at time of HTML rendering. We have to use EVAL. There is no other option. ' ' 2) The strings from the database must also be represented as VBScript strings in the assignments ' below. This means that where a string needs to have an embedded " char, two such chars must be ' used, and remember about EVAL mentioned above, meaning that sometimes """" has to be used to ' give a single " to the resulting string that pops out from EVAL. ' Remember also that whilst HTML doesn't care whether you use single or double quotes, javascript ' does (it must use single quotes) and VBScript does (it must use double quotes) ' ' Possible Future Roadmap ' 1) Rid the code of ABTN_ID - I dont think we need this field now that we are free of the database ' Dim rsQry Dim varFields Dim varValues ' Create the object and configure some of its properties Set rsQry = Server.CreateObject("ADODB.Recordset") rsQry.CursorLocation = adUseClient rsQry.CursorType = adOpenKeyset rsQry.LockType = adLockOptimistic ' Based upon the original DEF_ACTION_BUTTONS table DDL, define the fields (ie. table columns) being simulated rsQry.Fields.Append "ABTN_ID", adInteger rsQry.Fields.Append "ABTN_NAME", adVarChar, 64 rsQry.Fields.Append "TEXT", adVarChar, 128, adFldIsNullable rsQry.Fields.Append "ACTION_LINK", adVarChar, 512, adFldIsNullable rsQry.Fields.Append "EVENT_HANDLER", adVarChar, 512, adFldIsNullable rsQry.Fields.Append "IMG_ENABLED", adVarChar, 128, adFldIsNullable rsQry.Fields.Append "IMG_DISABLED", adVarChar, 128, adFldIsNullable rsQry.Fields.Append "HINT", adVarChar, 256, adFldIsNullable rsQry.Fields.Append "VISIBLE", adChar, 1 rsQry.Fields.Append "ACTIVE", adChar, 1 rsQry.Fields.Append "IS_READONLY_ACTION", adChar, 1 ' open the record set for updating rsQry.Open ' Specify the field order that we are going to use in our row creation statements varFields = Array("ABTN_ID", "ABTN_NAME", "TEXT",_ "ACTION_LINK",_ "EVENT_HANDLER",_ "IMG_ENABLED",_ "IMG_DISABLED",_ "HINT",_ "VISIBLE",_ "ACTIVE",_ "IS_READONLY_ACTION") ' Add the rows to the record set, but only for buttons specifed in the list supplied by the caller ' Remember, Field Ordering is... ID, name, text, link, event handler, en-img, dis-img, hint, visible, active, is readonly action If isAbtnRequired(aAbtnList, "btnNewRole") Then varValues = Array(1,"btnNewRole","New Role",_ """javascript:;""",_ """onClick=""""MM_openBrWindow('wAddRole.asp?rfile=RoleList.asp&""& objPMod.ComposeURL() &""','AddRole','scrollbars=yes,resizable=yes,width=600,height=350');""""""",_ "images/btn_new_role.gif",_ null,_ null,_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnRemoveRole") Then varValues = Array(2,"btnRemoveRole","Remove Role",_ """javascript:go_submit( document.FormName, """"btnRemoveRole"""" );ShowProgress();""",_ """onClick=""""return confirmAction('Are you sure you want to Remove Role(s) ?');""""""",_ "images/btn_remove.gif",_ null,_ null,_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnNewApplication") Then varValues = Array(3,"btnNewApplication","New Application",_ """javascript:;""",_ """onClick=""""MM_openBrWindow('wAddApplication.asp?rfile=ApplicationList.asp&""& objPMod.ComposeURL() &""','AddApplication','scrollbars=yes,resizable=yes,width=600,height=350');""""""",_ "images/btn_new_application.gif",_ null,_ null,_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnRemoveApplication") Then varValues = Array(4,"btnRemoveApplication","Remove Application",_ """javascript:go_submit( document.FormName, """"btnRemoveApplication"""" );ShowProgress();""",_ """onClick=""""return confirmAction('Are you sure you want to Remove Application(s) ?');""""""",_ "images/btn_remove.gif",_ null,_ null,_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnNewAccount") Then varValues = Array(5,"btnNewAccount","New Account",_ """javascript:;""",_ """onClick=""""MM_openBrWindow('wNewAccount.asp?rfile=UserAccounts.asp&""& objPMod.ComposeURL() &""','NewAccount','scrollbars=yes,resizable=yes,width=600,height=350');""""""",_ "images/btn_new_user.gif",_ null,_ null,_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnRemoveAccount") Then varValues = Array(6,"btnRemoveAccount","Remove Account",_ """javascript:go_submit( document.FormName, """"btnRemoveAccount"""" );ShowProgress();""",_ """onClick=""""return confirmAction('Are you sure you want to Remove selected User Account(s)?');""""""",_ "images/btn_remove.gif",_ null,_ null,_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If ' NOTE: This one doesn't seem to do anything useful - perhaps its implementation was never completed? If isAbtnRequired(aAbtnList, "btnDisableAccount") Then varValues = Array(7,"btnDisableAccount","Disable Account",_ """#""",_ null,_ null,_ null,_ null,_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnAddUser") Then varValues = Array(8,"btnAddUser","Add User",_ """javascript:;""",_ """onClick=""""MM_openBrWindow('wAddApplicationUser.asp?rfile=UserList.asp&""& objPMod.ComposeURL() &""','AddApplicationUser','scrollbars=yes,resizable=yes,width=650,height=800');""""""",_ "images/btn_add_user.gif",_ null,_ null,_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnSubUser") Then varValues = Array(9,"btnSubUser","Remove User",_ """javascript:go_submit( document.FormName, """"btnSubUser"""" );ShowProgress();""",_ """onClick=""""return confirmAction('Are you sure you want to Remove User(s) ?');""""""",_ "images/btn_sub_user.gif",_ null,_ null,_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnNewControl") Then varValues = Array(10,"btnNewControl","New Control",_ """javascript:;""",_ """onClick=""""MM_openBrWindow('wAddControl.asp?rfile=ControlList.asp&""& objPMod.ComposeURL() &""','AddControl','scrollbars=yes,resizable=yes,width=650,height=400');""""""",_ "images/btn_new_control.gif",_ null,_ null,_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnRemoveControl") Then varValues = Array(11,"btnRemoveControl","Remove Control",_ """javascript:go_submit( document.FormName, """"btnRemoveControl"""" );ShowProgress();""",_ """onClick=""""return confirmAction('Are you sure you want to Remove Control(s) ?');""""""",_ "images/btn_remove.gif",_ null,_ null,_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnGrantRole") Then varValues = Array(14,"btnGrantRole","Grant Role",_ """javascript:;""",_ """onClick=""""MM_openBrWindow('wGrantRole.asp?rfile=User_Roles.asp&""& objPMod.ComposeURL() &""','GrantRole','scrollbars=yes,resizable=yes,width=650,height=700');""""""",_ "images/btn_add_role.gif",_ "images/btn_add_role_disabled.gif",_ "Grant Role to this User",_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnRevokeRole") Then varValues = Array(15,"btnRevokeRole","Revoke Role",_ """javascript:go_submit( document.FormName, """"btnRevokeRole"""" );ShowProgress();""",_ """onClick=""""return confirmAction('Are you sure you want to Revoke Role(s) ?');""""""",_ "images/btn_sub_role.gif",_ "images/btn_sub_role_disabled.gif",_ "Revoke Role from this User",_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnAddMember") Then varValues = Array(16,"btnAddMember","Add Member",_ """javascript:;""",_ """onClick=""""MM_openBrWindow('wAddRoleMember.asp?rfile=Role_Members.asp&""& objPMod.ComposeURL() &""','AddRoleMember','scrollbars=yes,resizable=yes,width=650,height=800');""""""",_ "images/btn_add_user.gif",_ null,_ "Add Memeber to this Role",_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnSubMember") Then varValues = Array(17,"btnSubMember","Remove Member",_ """javascript:go_submit( document.FormName, """"btnSubMember"""" );ShowProgress();""",_ """onClick=""""return confirmAction('Are you sure you want to Remove Member(s) ?');""""""",_ "images/btn_sub_user.gif",_ null,_ "Remove Member from this Role",_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnNewDataTable") Then varValues = Array(18,"btnNewDataTable","New Data Table",_ """javascript:;""",_ """onClick=""""MM_openBrWindow('wAddDataTable.asp?rfile=Role_DataFiltering.asp&""& objPMod.ComposeURL() &""','AddDataTable','scrollbars=yes,resizable=yes,width=650,height=400');""""""",_ "images/btn_new_datatable.gif",_ null,_ "Add New Data Table",_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnRemoveDataTable") Then varValues = Array(19,"btnRemoveDataTable",null,_ """_RemoveDataTable.asp?rfile=""& SCRIPT_NAME &""&dt_id=""& DtId &""&""& objPMod.ComposeURL()",_ """onClick=""""return confirmAction('Remove \'""& DataTableName &""\' from this list?');""""""",_ "images/i_remove.gif",_ null,_ "Remove this Data Table",_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnRoleMembers") Then varValues = Array(20,"btnRoleMembers","Show Members",_ """javascript:go_submit( document.FormName, """"btnRoleMembers"""" );ShowProgress();""",_ null,_ "images/i_user_lrg.gif",_ null,_ null,_ "Y",_ "Y",_ "Y") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnAddApplicationUser") Then varValues = Array(21,"btnAddApplicationUser","Add To Application",_ """javascript:;""",_ """onClick=""""MM_openBrWindow('wAddToApplication.asp?rfile=User_Applications.asp&""& objPMod.ComposeURL() &""','AddToApplication','scrollbars=yes,resizable=yes,width=450,height=350');""""""",_ "images/btn_add_application.gif",_ null,_ null,_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If If isAbtnRequired(aAbtnList, "btnSubApplicationUser") Then varValues = Array(22,"btnSubApplicationUser","Remove From Application",_ """javascript:;""",_ """onClick=""""MM_openBrWindow('wRemoveFromApplication.asp?rfile=User_Applications.asp&""& objPMod.ComposeURLWith(""user_id,tree"") &""','RemoveFromApplication','scrollbars=yes,resizable=yes,width=450,height=350');""""""",_ "images/btn_sub_application.gif",_ null,_ null,_ "Y",_ "Y",_ "N") rsQry.AddNew varFields, varValues End If ' NOTE: Jeremy may have intended to add another to allow access to the wEditAccount.asp ' file (on manager_suite_development_dump branch). It seemed like he never got around to it though. ' Move cursor to the first record If rsQry.RecordCount > 0 Then rsQry.MoveFirst If ((NOT rsQry.BOF) AND (NOT rsQry.EOF)) Then Call LoadButtons ( rsQry.GetRows() ) End If End If rsQry.Close Set rsQry = Nothing End Sub '----------------------------------------------------------------------------------------------------------------- Public Sub LoadButtons ( aRows ) Dim nProperty, newArrayDim, LastRow, rowNum LastRow = UBound( aRows, 2 ) For rowNum = 0 To LastRow ' Increase array by 1 newArrayDim = LastRowInx() + 1 ReDim Preserve mArrAbtnDef( mNumOfProperties, newArrayDim ) mobjNameDefMap.Item ( Cstr( aRows ( InxName, rowNum ) ) ) = newArrayDim For nProperty = 0 To mLastPropertyInx mArrAbtnDef ( nProperty, newArrayDim ) = aRows ( nProperty, rowNum ) Next Next End Sub '----------------------------------------------------------------------------------------------------------------- Private Function LastRowInx () LastRowInx = UBound ( mArrAbtnDef, 2 ) End Function '----------------------------------------------------------------------------------------------------------------- Public Sub AddSeparatorAfter ( sItemName, sSeparatorWidth ) If InStr( sItemName, " " ) > 0 Then Err.Raise 8, "Method AddSeparatorAfter", "Item Name '"& sItemName &"' cannot have spaces." mobjSeparator.Add (Cstr(sItemName)), CStr(sSeparatorWidth) End Sub '----------------------------------------------------------------------------------------------------------------- Public Sub AddSeparator ( sSeparatorWidth ) mobjSeparator.Add ( Cstr(mArrAbtnDef(InxName, LastItemInx())) ), CStr(sSeparatorWidth) End Sub '----------------------------------------------------------------------------------------------------------------- Private Sub SetItemDefaults ( sItemName ) ' Additional default setup Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxActive, enumDB_YES ) ' Default Active = enumDB_YES End Sub '----------------------------------------------------------------------------------------------------------------- Public Sub Text ( sItemName, Value ) Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxTxt, Value ) End Sub '----------------------------------------------------------------------------------------------------------------- Public Sub ItemID ( sItemName, Value ) Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxID, Value ) End Sub '----------------------------------------------------------------------------------------------------------------- Public Sub Image ( sItemName, Value ) Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxImg, Value ) Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxImgOff, Value ) ' Default image disable to be the same as image End Sub '----------------------------------------------------------------------------------------------------------------- Public Sub ImageOff ( sItemName, Value ) Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxImgOff, Value ) End Sub '----------------------------------------------------------------------------------------------------------------- Public Sub Link ( sItemName, Value ) Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxLink, Value ) End Sub '----------------------------------------------------------------------------------------------------------------- Public Sub EventHandler ( sItemName, Value ) Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxEventHandler, Value ) End Sub '----------------------------------------------------------------------------------------------------------------- Public Sub Hint ( sItemName, Value ) Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxHint, Value ) End Sub '----------------------------------------------------------------------------------------------------------------- Public Sub Active ( sItemName, Value ) 'Response.write sItemName &"here"& mobjNameDefMap.Item (Cstr(sItemName)) Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxActive, Value ) End Sub '----------------------------------------------------------------------------------------------------------------- Private Sub Class_Initialize() '// Perform action on creation of object. e.g. Set myObj = New ThisClassName Set mobjNameDefMap = CreateObject("Scripting.Dictionary") Set mobjIdDefMap = CreateObject("Scripting.Dictionary") Set mobjSeparator = CreateObject("Scripting.Dictionary") 'mbIsReadonly = FALSE ' Tell control that it should use only readonly action buttons (i.e. actions which will not alter database ) mReadonlyActionBehaviour = enumABTNCTRL_ON_READONLY_HIDE ' Tell control what to do by default if mbIsReadonly = TRUE mnButtonSpacer = 0 mnButtonTextSpace = 4 mNumOfProperties = 10 ' Number of properties in array which define one menu item. mLastPropertyInx = mNumOfProperties - 1 mbDisableAll = FALSE ReDim mArrAbtnDef ( mNumOfProperties, -1 ) InxID = 0 InxName = 1 InxTxt = 2 InxLink = 3 InxEventHandler = 4 InxImg = 5 InxImgOff = 6 InxHint = 7 InxActive = 8 InxIsReadonlyAction = 9 End Sub '----------------------------------------------------------------------------------------------------------------- Private Sub Class_Terminate() '// Perform action on object disposal. e.g. Set myObj = Nothing Set mobjNameDefMap = Nothing Set mobjIdDefMap = Nothing Set mobjSeparator = Nothing End Sub '----------------------------------------------------------------------------------------------------------------- End Class %>