* 
* 
* COMPONENT:  STD_FORM                             
* 
* 
FUNCTION OPTIONS(*DIRECT)

BEGIN_COM ROLE(*EXTENDS #PRIM_FORM) BORDERICONS(None) CAPTION('Log On') CLIENTHEIGHT(133) CLIENTWIDTH(492) FRAMESTYLE(Dialog) HEIGHT(167) LEFT(328) TOP(162)

DEFINE_COM CLASS(#USER.Visual) NAME(#USER) CAPTION('User') DISPLAYPOSITION(1) HEIGHT(25) LABELTYPE(Caption) LEFT(16) PARENT(#GPBX_CHGPWD) TABPOSITION(1) TOP(16) USEPICKLIST(False) WIDTH(280)
DEFINE_COM CLASS(#PWD_CUR.Visual) NAME(#PWD_CUR) CAPTION('Password') DISPLAYPOSITION(2) HEIGHT(25) LABELTYPE(Caption) LEFT(16) PARENT(#GPBX_CHGPWD) TABPOSITION(2) TOP(43) WIDTH(280)
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_CHGPWD) DISPLAYPOSITION(1) HEIGHT(105) LEFT(2) PARENT(#COM_OWNER) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(487)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#PHBN_LOGON) BUTTONDEFAULT(True) CAPTION('&Log On') DISPLAYPOSITION(3) ENABLED(False) LEFT(336) PARENT(#GPBX_CHGPWD) TABPOSITION(3) TOP(16) WIDTH(137)
DEFINE_COM CLASS(#PRIM_STBR) NAME(#STBR_1) DISPLAYPOSITION(2) HEIGHT(24) LEFT(0) MESSAGEPOSITION(1) PARENT(#COM_OWNER) TABPOSITION(2) TABSTOP(False) TOP(109) WIDTH(492)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#PHBN_Cancel) BUTTONCANCEL(True) CAPTION('&Cancel') DISPLAYPOSITION(4) LEFT(336) PARENT(#GPBX_CHGPWD) TABPOSITION(4) TOP(40) WIDTH(137)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#PHBN_ChangePwd) CAPTION('Change &Password') DISPLAYPOSITION(5) LEFT(336) PARENT(#GPBX_CHGPWD) TABPOSITION(5) TOP(66) WIDTH(137)
DEFINE_COM CLASS(#CHGPWDWIN) NAME(#CHGPWDWIN) COMPONENTVERSION(1)
DEFINE_COM CLASS(#VF_FP001) NAME(#uFramework)
DEFINE_COM CLASS(#VF_FP002) NAME(#uApplication)
DEFINE_COM CLASS(#VF_FP005) NAME(#uUser)
DEFINE_COM CLASS(#DSPUSRINF) NAME(#DSPUSRINF) COMPONENTVERSION(1)

DEFINE FIELD(#EXPIRED) REFFLD(#STD_BOOL)
DEFINE FIELD(#MAXSIGN) REFFLD(#STD_CODE6)

DEFINE_PTY NAME(upConnectionResult) DESC('Connection with iSeries') GET(*AUTO #RETCODE)
DEFINE_PTY NAME(upUserProfile) DESC('User profile connected') GET(*AUTO #USER)
DEFINE_PTY NAME(upPassword) DESC('Password') GET(*AUTO #PWD_CUR)

EVTROUTINE HANDLING(#com_owner.Initialize)
CHANGE FIELD(#USER) TO(*remembered_value_for_function)
ENDROUTINE

MTHROUTINE NAME(umOpenForm)
DEFINE_MAP FOR(*INPUT) CLASS(#VF_ELSRVN) NAME(#uServerLUName)

#USER.ShowError #PWD_CUR.ShowError := false
#SERVERNME := #uServerLUName

#COM_OWNER.Left := 330
#COM_OWNER.Top := 260

* Log-on as superuser
USE BUILTIN(DISCONNECT_SERVER) WITH_ARGS(#SERVERNME) TO_GET(#RETCODE)
USE BUILTIN(DEFINE_ANY_SERVER) WITH_ARGS(#SERVERNME #SERVERNME Y *default Y Y '20' QEBCDIC QASCII) TO_GET(#RETCODE)
USE BUILTIN(SET_SESSION_VALUE) WITH_ARGS('USER=' SUPERUSER)
USE BUILTIN(CONNECT_SERVER) WITH_ARGS(#SERVERNME SUPERPASWOORD) TO_GET(#retcode #STD_DESCS #STD_NUM10)

USE BUILTIN(CLR_MESSAGES)

IF COND(#RETCODE *EQ OK)
* Retrieve number of invalid sign-on attemps allowed
EXCHANGE FIELDS(#MAXSIGN)
USE BUILTIN(CALL_SERVER_FUNCTION) WITH_ARGS(#SERVERNME MAXSIGN Y Y) TO_GET(#IO$STS)
ELSE
* Connection not established
RETURN
ENDIF

IF (#USER = *blanks)
#PHBN_ChangePwd.Enabled := false
ELSE
#PHBN_ChangePwd.Enabled := true
ENDIF

#PWD_CUR.Setfocus

#COM_OWNER.ShowModalForm

ENDROUTINE

EVTROUTINE HANDLING(#PHBN_LOGON.Click)

DEFINE FIELD(#PRVSIGNON) TYPE(*CHAR) LENGTH(13)
DEFINE FIELD(#ATTEMPTS) TYPE(*CHAR) LENGTH(8)
DEFINE FIELD(#USRSTATUS) TYPE(*CHAR) LENGTH(10)
DEFINE FIELD(#PWDCHGDTE) TYPE(*CHAR) LENGTH(8)
DEFINE FIELD(#PWDEXPITV) TYPE(*CHAR) LENGTH(8)
DEFINE FIELD(#PWDEXPDTE) TYPE(*CHAR) LENGTH(8)
DEFINE FIELD(#PWDREMDAY) TYPE(*CHAR) LENGTH(8)
DEFINE FIELD(#USERNAME) TYPE(*CHAR) LENGTH(50)

GROUP_BY NAME(#UI_PARMS) FIELDS(#USER #PRVSIGNON #ATTEMPTS #USRSTATUS #PWDCHGDTE #PWDEXPITV #PWDEXPDTE #PWDREMDAY #USERNAME #MSGID #MSGT)

#RETCODE := ER

USE BUILTIN(CLR_MESSAGES) WITH_ARGS(N)

* Log-on as normal user
USE BUILTIN(DISCONNECT_SERVER) WITH_ARGS(#SERVERNME) TO_GET(#RETCODE)
USE BUILTIN(DEFINE_ANY_SERVER) WITH_ARGS(#SERVERNME #SERVERNME Y *default 'Z' Y '20' QEBCDIC QASCII) TO_GET(#RETCODE)
USE BUILTIN(SET_SESSION_VALUE) WITH_ARGS('USER=' #USER)
USE BUILTIN(CONNECT_SERVER) WITH_ARGS(#SERVERNME #PWD_CUR) TO_GET(#retcode #STD_DESCS #STD_NUM10)

USE BUILTIN(CLR_MESSAGES)

IF ('#RETCODE *EQ OK')

#RETCODE := OK

#COM_OWNER.UpdateDisplay
#COM_OWNER.CloseForm

ELSE

#USER.ShowError #PWD_CUR.ShowError := true

* Log-on as superuser
USE BUILTIN(DISCONNECT_SERVER) WITH_ARGS(#SERVERNME) TO_GET(#RETCODE)
USE BUILTIN(DEFINE_ANY_SERVER) WITH_ARGS(#SERVERNME #SERVERNME Y *default Y Y '20' QEBCDIC QASCII) TO_GET(#RETCODE)
USE BUILTIN(SET_SESSION_VALUE) WITH_ARGS('USER=' SUPERUSER)
USE BUILTIN(CONNECT_SERVER) WITH_ARGS(#SERVERNME SUPERPASWOORD) TO_GET(#retcode #STD_DESCS #STD_NUM10)

USE BUILTIN(CLR_MESSAGES)

IF COND(#RETCODE *EQ ER)

* Connection not established
MESSAGE MSGTXT('Connection failed. Contact Helpdesk.')

ELSE

* Retrieve user information
EXCHANGE FIELDS(#UI_PARMS)
USE BUILTIN(CALL_SERVER_FUNCTION) WITH_ARGS(#SERVERNME RTVUSRI Y Y) TO_GET(#IO$STS)

#USER := #USER.Trim
#PWD_CUR := #PWD_CUR.Trim

* Disconnect server
USE BUILTIN(DISCONNECT_SERVER) WITH_ARGS(#SERVERNME) TO_GET(#RETCODE)

USE BUILTIN(CLR_MESSAGES)

* Error found when retrieving user information
IF (#MSGID <> *blanks)

* Overwrite Message Text
CASE OF_FIELD(#MSGID)
WHEN VALUE_IS('= CPF9801' '= CPF9802' '= CPF9803')
#MSGT := 'User profile ' + #USER.Trim + ' does not exist.'
OTHERWISE
ENDCASE

MESSAGE MSGTXT(#MSGT)
#RETCODE := ER
RETURN

ENDIF

* User Disabled
IF (#USRSTATUS = '*DISABLED')
#MSGT := 'User profile ' + #USER.Trim + ' is disabled. Contact Helpdesk.'
MESSAGE MSGTXT(#MSGT)
#RETCODE := ER
RETURN
ENDIF

* Password Expired
IF (#PWDREMDAY.AsNumber = *zero)

#EXPIRED := TRUE
#MSGT := 'Password has expired. Password must be changed to continue.'
MESSAGE MSGTXT(#MSGT)

* Change password
#CHGPWDWIN.umOpenForm( #SERVERNME #USER #MSGT #EXPIRED #MAXSIGN )

IF COND('#CHGPWDWIN.upConnectionResult = OK')
* Password changed succesfully
#RETCODE := OK
#PWD_CUR := #CHGPWDWIN.upPassword
#COM_OWNER.CloseForm
ELSE
* Cancel is pressed in Change Password Window
#RETCODE := XP
ENDIF

RETURN

ENDIF

* Last Attempt before disabling user
IF ((#ATTEMPTS.AsNumber + 1) = #MAXSIGN.AsNumber)
MESSAGE MSGTXT('Password not correct. Next not valid sign-on disables user.')
#RETCODE := ER
RETURN
ENDIF

* Connection not established
MESSAGE MSGTXT('Password not correct. Connection failed.')

ENDIF

ENDIF

ENDROUTINE

EVTROUTINE HANDLING(#PHBN_ChangePwd.Click)

* Check if user profile is disabled
USE BUILTIN(DISCONNECT_SERVER) WITH_ARGS(#SERVERNME) TO_GET(#RETCODE)
USE BUILTIN(DEFINE_ANY_SERVER) WITH_ARGS(#SERVERNME #SERVERNME Y *default Y Y '20' QEBCDIC QASCII) TO_GET(#RETCODE)
USE BUILTIN(SET_SESSION_VALUE) WITH_ARGS('USER=' SUPERUSER)
USE BUILTIN(CONNECT_SERVER) WITH_ARGS(#SERVERNME SUPERPASWOORD) TO_GET(#retcode #STD_DESCS #STD_NUM10)

USE BUILTIN(CLR_MESSAGES)

IF COND(#RETCODE *EQ OK)

* Retrieve user information
EXCHANGE FIELDS(#UI_PARMS)
USE BUILTIN(CALL_SERVER_FUNCTION) WITH_ARGS(#SERVERNME RTVUSRI Y Y) TO_GET(#IO$STS)
#USER := #USER.Trim

* User does not exist
IF (#MSGID = CPF9801)
#MSGT := 'User profile ' + #USER.Trim + ' does not exist.'
MESSAGE MSGTXT(#MSGT)
#USER.ShowError := True
RETURN
ENDIF

* User is disabled
IF (#USRSTATUS = '*DISABLED')
#MSGT := 'User profile ' + #USER.Trim + ' is disabled. Contact Helpdesk.'
MESSAGE MSGTXT(#MSGT)
#USER.ShowError #PWD_CUR.ShowError := True
RETURN
ENDIF

ENDIF

* Change password
#CHGPWDWIN.umOpenForm( #SERVERNME #USER *blanks FALSE #MAXSIGN )

* Password changed succesfully
IF COND('#CHGPWDWIN.upConnectionResult = OK')
#RETCODE := OK
#PWD_CUR := #CHGPWDWIN.upPassword
#COM_OWNER.CloseForm
ENDIF

ENDROUTINE

EVTROUTINE HANDLING(#PHBN_Cancel.Click)
#RETCODE := ER
#COM_OWNER.Closeform
ENDROUTINE

EVTROUTINE HANDLING(#USER.Changed #PWD_CUR.Changed) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS)

IF ((#USER = *blanks) *Or (#PWD_CUR = *blanks))
#PHBN_LOGON.Enabled := false
ELSE
#PHBN_LOGON.Enabled := true
ENDIF

IF (#USER = *blanks)
#PHBN_ChangePwd.Enabled := false
ELSE
#PHBN_ChangePwd.Enabled := true
ENDIF

ENDROUTINE

EVTROUTINE HANDLING(#USER.Initialize) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS)
#USER := #USER.Trim
ENDROUTINE

END_COM
