404 lines
18 KiB
Plaintext
404 lines
18 KiB
Plaintext
Function NDW_Web_Accounts_Events(CtrlEntId, Event, Param1, Param2, Param3, Param4, Param5, Param6, Param7, Param8, Param9, Param10, Param11, Param12, Param13, Param14, Param15)
|
|
/***********************************************************************************************************************
|
|
|
|
This program is proprietary and is not to be used by or disclosed to others, nor is it to be copied without written
|
|
permission from SRP Computer Solutions, Inc.
|
|
|
|
Name : NDW_Web_Accounts_Events
|
|
|
|
Description : This function acts as a commuter module for all events related to this window.
|
|
|
|
Notes : Commuter Modules are automatically called from the Promoted_Events function which is called by the
|
|
application-specific promoted event handler. This makes it possible to add QuickEvents that need to
|
|
execute Basic+ logic without having use the Form Designer to make the association, although this is
|
|
limited to the events which are currently promoted.
|
|
|
|
If the form needs to call the commuter module directly then the QuickEvent parameters should be
|
|
formatted like this:
|
|
|
|
'@SELF','@EVENT',['@PARAM1','@PARAMx']
|
|
|
|
Parameters :
|
|
CtrlEntId [in] -- The fully qualified name of the control calling the promoted event
|
|
Event [in] -- The event being executed. See the Notes section regarding "PRE" events
|
|
Param1-15 [in] -- Additional event parameter holders
|
|
EventFlow [out] -- Set to 1 or 0 so the calling event knows whether or not to chain forward. See comments in
|
|
EVENT_SETUP insert
|
|
|
|
History (Date, Initials, Notes)
|
|
10/24/18 dmb Initial development.
|
|
11/21/18 dmb [SRPFW-257] Finish core functionality.
|
|
|
|
***********************************************************************************************************************/
|
|
|
|
#pragma precomp SRP_PreCompiler
|
|
#window NDW_WEB_ACCOUNTS
|
|
|
|
$insert LOGICAL
|
|
$insert MSG_EQUATES
|
|
$insert WEB_ACCOUNTS_EQUATES
|
|
|
|
Equ EVENT_CONTINUE$ to 1
|
|
Equ EVENT_STOP$ to 0
|
|
Equ SetupTable$ to 'SYSENV'
|
|
|
|
Declare subroutine WebAccounts_Services, Set_Property, PlaceDialog, End_Dialog, Msg, Send_Event, Send_Message
|
|
Declare subroutine Error_Services, HTTP_Authentication_Services
|
|
Declare function WebAccounts_Services, Get_Property, Memory_Services, HTTP_Authentication_Services, Error_Services
|
|
Declare function RTI_CreateGUID, Popup
|
|
|
|
// Get the design time name of the window in case this is a multi-instance window.
|
|
Window = @Window[1, 'F*']
|
|
|
|
// Always get the CtrlClassID since we are not passing it through the event parameters.
|
|
CtrlClassId = Get_Property(CtrlEntId, 'TYPE')
|
|
|
|
// Get the name of the control on the window based on the CtrlClassId.
|
|
Begin Case
|
|
Case CtrlClassId EQ 'WINDOW'
|
|
Control = Window
|
|
Case CtrlClassId EQ 'RADIOBUTTON'
|
|
Debug
|
|
* Control = Field(CtrlEntId, '.', 2, 2)
|
|
Control = Field(CtrlEntId, '.', 2, 1)
|
|
Case CtrlClassId EQ 'MENU'
|
|
Control = CtrlEntId[-1, 'B.']
|
|
Case 1
|
|
Control = Field(CtrlEntId, '.', 2, 1)
|
|
End Case
|
|
|
|
If Event EQ 'OLE' then GoSub TransferParams
|
|
GoToEvent Event for CtrlEntID
|
|
If Event EQ 'OLE' then GoSub RestoreParams
|
|
|
|
Return EventFlow OR EVENT_CONTINUE$
|
|
|
|
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
// Events
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
|
|
Event WINDOW.CREATE(CreateParam)
|
|
|
|
GoSub SetupOLEControls
|
|
|
|
PlaceDialog(-2, -2)
|
|
|
|
end event
|
|
|
|
|
|
Event EDL_ID.LOSTFOCUS(Flag, FocusID)
|
|
|
|
GotFocusID = Get_Property(CtrlEntId, 'GOTFOCUS_VALUE')
|
|
ID = Get_Property(CtrlEntId, 'TEXT')
|
|
If GotFocusID NE ID then
|
|
WebAccountRow = WebAccounts_Services('GetWebAccounts', ID)
|
|
If Error_Services('NoError') then
|
|
GoSub UpdateForm
|
|
end
|
|
end
|
|
|
|
end event
|
|
|
|
|
|
Event EDL_ID.OPTIONS()
|
|
|
|
ID = Popup(@Window, '', 'WEB_ACCOUNTS')
|
|
If ID NE '' AND ID NE Char(27) then
|
|
Set_Property(CtrlEntId, 'GOTFOCUS_VALUE', '')
|
|
Set_Property(CtrlEntId, 'TEXT', ID)
|
|
Send_Event(CtrlEntId, 'LOSTFOCUS')
|
|
end
|
|
|
|
end event
|
|
|
|
|
|
Event OLE_ACTION_BAR.OnClick(Group, Item, Point, Button, Shift, Ctrl)
|
|
|
|
ResetAttempts = False$
|
|
|
|
Begin Case
|
|
Case Group EQ 1
|
|
Begin Case
|
|
Case Item EQ 1
|
|
// Clear Form
|
|
ID = ''
|
|
WebAccountRow = ''
|
|
GoSub UpdateForm
|
|
Set_Property('SYSTEM', 'FOCUS', @Window : '.EDL_ID')
|
|
Set_Property(@Window : '.EDL_ID', 'GOTFOCUS_VALUE', '')
|
|
|
|
Case Item EQ 2
|
|
// Close Form
|
|
Set_Property(@Window, 'TIMER', 1 : @FM : 1)
|
|
End Case
|
|
Case Group EQ 2
|
|
Begin Case
|
|
Case Item EQ 1
|
|
// New Account
|
|
GoSub CreateNewWebAccount
|
|
Case Item EQ 2
|
|
// Save Account
|
|
GoSub UpdateWebAccount
|
|
End Case
|
|
Case Group EQ 3
|
|
Begin Case
|
|
Case Item EQ 1
|
|
// Reset Password
|
|
ID = Get_Property(@Window : '.EDL_ID', 'TEXT')
|
|
If ID NE '' then
|
|
CurrentPassword = HTTP_Authentication_Services('GetWebAccountPassword', ID, False$)
|
|
Password = HTTP_Authentication_Services('ResetWebAccountPassword', ID, CurrentPassword)
|
|
If Error_Services('NoError') then
|
|
WebAccountRow = WebAccounts_Services('GetWebAccounts', ID)
|
|
If Error_Services('NoError') then
|
|
GoSub UpdateForm
|
|
end
|
|
end else
|
|
MsgStruct = ''
|
|
MsgStruct<MTEXT$> = Error_Services('GetMessage')
|
|
MsgStruct<MTYPE$> = 'BO'
|
|
MsgStruct<MICON$> = 'H'
|
|
MsgStruct<MCAPTION$> = 'SRP HTTP Framework'
|
|
Msg(@Window, MsgStruct)
|
|
end
|
|
end
|
|
Case Item EQ 2
|
|
// Reset Attempts
|
|
ResetAttempts = True$
|
|
GoSub UpdateWebAccount
|
|
If Error_Services('NoError') then
|
|
Set_Property(@Window : '.EDL_INVALID_PASSWORD_ATTEMPTS', 'INVALUE', 0)
|
|
end
|
|
Case Item EQ 3
|
|
// Copy to Clipboard
|
|
AccountID = Get_Property(@Window : '.EDL_ID', 'INVALUE')
|
|
Name = Get_Property(@Window : '.EDL_NAME', 'INVALUE')
|
|
Password = Get_Property(@Window : '.EDL_CURRENT_PASSWORD', 'INVALUE')
|
|
Clipboard = 'Account ID: ' : AccountID : \0D0A\ : 'Name: ' : Name : \0D0A\ : 'Password: ' : Password
|
|
Set_Property('CLIPBOARD', 'TEXT', Clipboard)
|
|
End Case
|
|
End Case
|
|
|
|
end event
|
|
|
|
|
|
Event OLE_SUBCLASS.OnOptionClick(CtrlId)
|
|
|
|
Send_Event(CtrlId, 'OPTIONS')
|
|
|
|
end event
|
|
|
|
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
// Internal Gosubs
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
|
|
SetupOLEControls:
|
|
|
|
// All OLE controls can use this qualify configuration.
|
|
Qualify = ''
|
|
Qualify<1> = 1
|
|
Qualify<3> = ''
|
|
Qualify<4> = 0
|
|
|
|
//------------------------------------------------------------------------------------------------------------------
|
|
//
|
|
// SRP ShortcutBar Control
|
|
//
|
|
//------------------------------------------------------------------------------------------------------------------
|
|
Ctrl = @Window : '.OLE_ACTION_BAR'
|
|
Set_Property(Ctrl, 'OLE.Border', 'XP Flat')
|
|
Set_Property(Ctrl, 'OLE.Animation', 'Never')
|
|
Set_Property(Ctrl, 'OLE.Theme', 'Office2007Blue')
|
|
Set_Property(Ctrl, 'OLE.GroupFont', 'Segoe UI' : @SVM : 11 : @SVM : 400)
|
|
Set_Property(Ctrl, 'OLE.ItemFont', 'Segoe UI' : @SVM : 9 : @SVM : 400)
|
|
Set_Property(Ctrl, 'OLE.GroupCount', 3)
|
|
Set_Property(Ctrl, 'OLE.GroupCaption[1]', 'Form Actions')
|
|
Set_Property(Ctrl, 'OLE.GroupCaption[2]', 'Account Actions')
|
|
Set_Property(Ctrl, 'OLE.GroupCaption[3]', 'Password Actions')
|
|
Set_Property(Ctrl, 'OLE.GroupExpandable[All]', False$)
|
|
Set_Property(Ctrl, 'OLE.GroupSpecial[All]', True$)
|
|
Set_Property(Ctrl, 'OLE.GroupItemCount[1]', 2)
|
|
Set_Property(Ctrl, 'OLE.ItemCaption[1;1]', 'Clear Form')
|
|
Set_Property(Ctrl, 'OLE.ItemCaption[1;2]', 'Close Form')
|
|
Set_Property(Ctrl, 'OLE.GroupItemCount[2]', 2)
|
|
Set_Property(Ctrl, 'OLE.ItemCaption[2;1]', 'New Account')
|
|
Set_Property(Ctrl, 'OLE.ItemCaption[2;2]', 'Save Account')
|
|
Set_Property(Ctrl, 'OLE.GroupItemCount[3]', 3)
|
|
Set_Property(Ctrl, 'OLE.ItemCaption[3;1]', 'Reset Password')
|
|
Set_Property(Ctrl, 'OLE.ItemCaption[3;2]', 'Reset Attempts')
|
|
Set_Property(Ctrl, 'OLE.ItemCaption[3;3]', 'Copy to Clipboard')
|
|
Margins = 0 : @FM : 0 : @FM : 0 : @FM : 0 : @FM : 0
|
|
Set_Property(Ctrl, 'OLE.HotTrackStyle', 'Item')
|
|
Set_Property(Ctrl, 'OLE.ItemBold[All; All]', True$)
|
|
Send_Message(Ctrl, 'QUALIFY_EVENT', 'OLE.OnClick', Qualify)
|
|
|
|
//------------------------------------------------------------------------------------------------------------------
|
|
//
|
|
// SRP Subclass Control
|
|
//
|
|
//------------------------------------------------------------------------------------------------------------------
|
|
Ctrl = @Window : '.OLE_SUBCLASS'
|
|
EditCtrls = 'EDL_ID'
|
|
NumCtrls = DCount(EditCtrls, ',')
|
|
For EditCnt = 1 to NumCtrls
|
|
EditCtrl = Field(EditCtrls, ',', EditCnt, 1)
|
|
Handle = Get_Property(@Window : '.' : EditCtrl, 'HANDLE')
|
|
Send_Message(Ctrl, 'OLE.Subclass', Handle, @Window : '.' : EditCtrl)
|
|
Set_Property(Ctrl, 'OLE.OptionButton[' : @Window : ';' : EditCtrl : ']', True$)
|
|
Send_Message(Ctrl, 'QUALIFY_EVENT', 'OLE.OnOptionClick', Qualify)
|
|
Next EditCnt
|
|
|
|
return
|
|
|
|
|
|
TransferParams:
|
|
|
|
// ActiveX controls pass their own event names through Param1. Modify the parameter values so they conform to
|
|
// OpenInsight event parameter values. This will allow commuter modules to be structured the same for OpenInsight
|
|
// event and ActiveX (OLE) events.
|
|
Transfer Param1 to Event
|
|
Transfer Param2 to Param1
|
|
Transfer Param3 to Param2
|
|
Transfer Param4 to Param3
|
|
Transfer Param5 to Param4
|
|
Transfer Param6 to Param5
|
|
Transfer Param7 to Param6
|
|
Transfer Param8 to Param7
|
|
Transfer Param9 to Param8
|
|
Transfer Param10 to Param9
|
|
Transfer Param11 to Param10
|
|
Transfer Param12 to Param11
|
|
Transfer Param13 to Param12
|
|
Transfer Param14 to Param13
|
|
Transfer Param15 to Param14
|
|
|
|
return
|
|
|
|
|
|
RestoreParams:
|
|
|
|
// Restore the event parameters so the rest of the event chain will see the parameter values as they were originally
|
|
// created by OpenInsight. This will also prevent the parameter values from being transferred multiple times in case
|
|
// there are multiple OLE promoted event handlers (e.g. APPNAME*..OIWIN* and APPNAME*OLE..OIWIN*).
|
|
Transfer Param14 to Param15
|
|
Transfer Param13 to Param14
|
|
Transfer Param12 to Param13
|
|
Transfer Param11 to Param12
|
|
Transfer Param10 to Param11
|
|
Transfer Param9 to Param10
|
|
Transfer Param8 to Param9
|
|
Transfer Param7 to Param8
|
|
Transfer Param6 to Param7
|
|
Transfer Param5 to Param6
|
|
Transfer Param4 to Param5
|
|
Transfer Param3 to Param4
|
|
Transfer Param2 to Param3
|
|
Transfer Param1 to Param2
|
|
Transfer Event to Param1
|
|
Event = 'OLE'
|
|
|
|
return
|
|
|
|
|
|
UpdateForm:
|
|
|
|
Set_Property(@Window : '.EDL_ID', 'INVALUE', ID)
|
|
Set_Property(@Window : '.EDL_NAME', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.NAME$>)
|
|
Set_Property(@Window : '.COB_ACCOUNT_ENABLED', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.ACCOUNT_ENABLED$>)
|
|
Set_Property(@Window : '.EDL_CURRENT_PASSWORD', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD$>)
|
|
Set_Property(@Window : '.EDL_CURRENT_PASSWORD_CREATE_DATE', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD_CREATE_DATE$>)
|
|
Set_Property(@Window : '.EDL_CURRENT_PASSWORD_CREATE_TIME', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD_CREATE_TIME$>)
|
|
Set_Property(@Window : '.EDL_CURRENT_PASSWORD_EXPIRE_DATE', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD_EXPIRE_DATE$>)
|
|
Set_Property(@Window : '.EDL_CURRENT_PASSWORD_EXPIRE_TIME', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD_EXPIRE_TIME$>)
|
|
Set_Property(@Window : '.EDL_OLD_PASSWORD', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD$>)
|
|
Set_Property(@Window : '.EDL_OLD_PASSWORD_CREATE_DATE', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD_CREATE_DATE$>)
|
|
Set_Property(@Window : '.EDL_OLD_PASSWORD_CREATE_TIME', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD_CREATE_TIME$>)
|
|
Set_Property(@Window : '.EDL_OLD_PASSWORD_EXPIRE_DATE', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD_EXPIRE_DATE$>)
|
|
Set_Property(@Window : '.EDL_OLD_PASSWORD_EXPIRE_TIME', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD_EXPIRE_TIME$>)
|
|
Set_Property(@Window : '.EDL_INVALID_PASSWORD_ATTEMPTS', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.INVALID_PASSWORD_ATTEMPTS$>)
|
|
|
|
return
|
|
|
|
|
|
CreateNewWebAccount:
|
|
|
|
Send_Event(@Window : '.OLE_ACTION_BAR', 'OLE', 'OnClick', 1, 1)
|
|
ID = RTI_CreateGUID('B')
|
|
Convert '.,' to '' in ID
|
|
ID = ID[1, 6]
|
|
WebAccountRow = ''
|
|
WebAccountRow<WEB_ACCOUNTS.ACCOUNT_ENABLED$> = True$
|
|
WebAccountRow<WEB_ACCOUNTS.INVALID_PASSWORD_ATTEMPTS$> = 0
|
|
WebAccounts_Services('SetWebAccounts', ID, WebAccountRow)
|
|
If Error_Services('NoError') then
|
|
HTTP_Authentication_Services('ResetWebAccountPassword', ID)
|
|
If Error_Services('NoError') then
|
|
Set_Property(@Window : '.EDL_ID', 'INVALUE', ID)
|
|
WebAccountRow = WebAccounts_Services('GetWebAccounts', ID)
|
|
If Error_Services('NoError') then
|
|
GoSub UpdateForm
|
|
Set_Property(@Window : '.EDL_NAME', 'FOCUS', True$)
|
|
end else
|
|
MsgStruct = ''
|
|
MsgStruct<MTEXT$> = Error_Services('GetMessage')
|
|
MsgStruct<MTYPE$> = 'BO'
|
|
MsgStruct<MICON$> = 'H'
|
|
MsgStruct<MCAPTION$> = 'SRP HTTP Framework'
|
|
Msg(@Window, MsgStruct)
|
|
end
|
|
end else
|
|
MsgStruct = ''
|
|
MsgStruct<MTEXT$> = Error_Services('GetMessage')
|
|
MsgStruct<MTYPE$> = 'BO'
|
|
MsgStruct<MICON$> = 'H'
|
|
MsgStruct<MCAPTION$> = 'SRP HTTP Framework'
|
|
Msg(@Window, MsgStruct)
|
|
end
|
|
end else
|
|
MsgStruct = ''
|
|
MsgStruct<MTEXT$> = Error_Services('GetMessage')
|
|
MsgStruct<MTYPE$> = 'BO'
|
|
MsgStruct<MICON$> = 'H'
|
|
MsgStruct<MCAPTION$> = 'SRP HTTP Framework'
|
|
Msg(@Window, MsgStruct)
|
|
end
|
|
|
|
return
|
|
|
|
|
|
UpdateWebAccount:
|
|
|
|
ID = Get_Property(@Window : '.EDL_ID', 'INVALUE')
|
|
WebAccountRow = ''
|
|
WebAccountRow<WEB_ACCOUNTS.NAME$> = Get_Property(@Window : '.EDL_NAME', 'INVALUE')
|
|
WebAccountRow<WEB_ACCOUNTS.ACCOUNT_ENABLED$> = Get_Property(@Window : '.COB_ACCOUNT_ENABLED', 'INVALUE')
|
|
WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD$> = Get_Property(@Window : '.EDL_CURRENT_PASSWORD', 'INVALUE')
|
|
WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD_CREATE_DATE$> = Get_Property(@Window : '.EDL_CURRENT_PASSWORD_CREATE_DATE', 'INVALUE')
|
|
WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD_CREATE_TIME$> = Get_Property(@Window : '.EDL_CURRENT_PASSWORD_CREATE_TIME', 'INVALUE')
|
|
WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD_EXPIRE_DATE$> = Get_Property(@Window : '.EDL_CURRENT_PASSWORD_EXPIRE_DATE', 'INVALUE')
|
|
WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD_EXPIRE_TIME$> = Get_Property(@Window : '.EDL_CURRENT_PASSWORD_EXPIRE_TIME', 'INVALUE')
|
|
WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD$> = Get_Property(@Window : '.EDL_OLD_PASSWORD', 'INVALUE')
|
|
WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD_CREATE_DATE$> = Get_Property(@Window : '.EDL_OLD_PASSWORD_CREATE_DATE', 'INVALUE')
|
|
WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD_CREATE_TIME$> = Get_Property(@Window : '.EDL_OLD_PASSWORD_CREATE_TIME', 'INVALUE')
|
|
WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD_EXPIRE_DATE$> = Get_Property(@Window : '.EDL_OLD_PASSWORD_EXPIRE_DATE', 'INVALUE')
|
|
WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD_EXPIRE_TIME$> = Get_Property(@Window : '.EDL_OLD_PASSWORD_EXPIRE_TIME', 'INVALUE')
|
|
If ResetAttempts EQ True$ then
|
|
Attempts = 0
|
|
end else
|
|
Attempts = Get_Property(@Window : '.EDL_INVALID_PASSWORD_ATTEMPTS', 'INVALUE')
|
|
end
|
|
WebAccountRow<WEB_ACCOUNTS.INVALID_PASSWORD_ATTEMPTS$> = Attempts
|
|
WebAccounts_Services('SetWebAccounts', ID, WebAccountRow)
|
|
If Error_Services('HasError') then
|
|
MsgStruct = ''
|
|
MsgStruct<MTEXT$> = Error_Services('GetMessage')
|
|
MsgStruct<MTYPE$> = 'BO'
|
|
MsgStruct<MICON$> = 'H'
|
|
MsgStruct<MCAPTION$> = 'SRP HTTP Framework'
|
|
Msg(@Window, MsgStruct)
|
|
end
|
|
|
|
return
|