'Option Explicit


Public Function OnAddNewRecord(objApp, rs, lngRecordID, lngUserID)
	' DESCRIPTION:
	'   This function will set the default values for fields in a new record.
	' RETURN VALUE:
	'   Info: not used
	Call Mq_OnAddNewRecord(objApp, rs, lngRecordID, lngUserID)
End Function


Public Function OnCopyRecord(objApp, rs, lngRecordID, lngUserID, blnCopyAsChild, ByVal lngBaseRecordID, ByVal strTableName)
	' DESCRIPTION:
	'   This function will set the default values for fields in a copied record.
	' RETURN VALUE:
	'   Info: not used
	Call Mq_OnCopyRecord(objApp, rs, lngRecordID, lngUserID, blnCopyAsChild)
	
	Dim blnCopyTasks
	
	'Change to True if you want to copy tasks records when copying a record
	blnCopyTasks = False
	
	If blnCopyTasks Then
		'just do it once, not for every table we call OnCopyRecord for
		If LCase(strTableName) = LCase(objApp.strPrimaryTableName) Then
			Call CopyTasks(objApp, lngBaseRecordID, lngRecordID)
		End If
	End If
	
End Function


Public Function OnValidate(objApp, lngRecord, dctFldVals)
	' DESCRIPTION:
	'   This function will allow user to add custom validation before saving the record.
	'   Here you can do validation specific to your needs.
	' RETURN VALUE:
	'   Type: string
	'   Info: If the returned string is not empty, the save action is canceled and
	'	the string is displayed to the user.
	
	Dim strValidate
    strValidate = ""
    
    strValidate = Mq_OnValidate(objApp, lngRecord, dctFldVals)
    
    If strValidate = "" Then
        'if the general validation passed, add some custom validation
        'strValidate = ValidateUniqueValue(objApp, lngRecord, dctFldVals)
    End If
    
    OnValidate = strValidate

End Function


Public Function OnBeforeSave(objApp, lngRecord, dctFldVals)
	' DESCRIPTION:
	'   This function will allow user to add custom code before saving the record.
	'   Here you can add code specific to your needs.
	' RETURN VALUE:
	'   Type: string
	'   Info: You must return an empty string

	'Since we're creating new users, set the password to the default
	SetDefaultPwd dctFldVals
		
	'Lookup the company from the company contract
	SetDefaultCompany objApp, dctFldVals

	OnBeforeSave = Mq_OnBeforeSave(objApp, lngRecord, dctFldVals)
End Function


Public Function OnFieldSave(objApp, cfield, varCurrentValue, ByRef strChangedFields)
	' DESCRIPTION:
	'   This function will allow user to add custom code to further modify the record
	'	based on another field value. For example, in the Mq_OnFieldSave function, if
	'	we determine that the record was closed, we set the fields close date and close
	'	time.
	' RETURN VALUE:
	'   Type: boolean
	'   Info: return true if you changed the strChangedFields list
	'	Argument strChangedFields: a comma seperated list of changed fields. Add
	'	the related fields that you've changed.
	OnFieldSave = Mq_OnFieldSave(objApp, cfield, varCurrentValue, strChangedFields)
End Function


Public Function OnAfterSave(objApp, lngRecord, dctFldVals, ByRef strChangedFields)
	' DESCRIPTION:
	'   This function will allow user to add custom code after saving the record.
	'   Here you can add code specific to your needs.
	' RETURN VALUE:
	'   Info: not used
	'	Argument strChangedFields: a comma seperated list of changed fields
	Call Mq_OnAfterSave(objApp, lngRecord, dctFldVals, strChangedFields)
End Function

Public Function OnAfterCommitSave(objApp, lngRecord)
	' DESCRIPTION:
	'   This function will allow user to add custom code after completely saving the record.
	'   Here you can add code specific to your needs.
	' RETURN VALUE:
	'   Info: not used
	'	Argument strChangedFields: a comma seperated list of changed fields
	Call Mq_OnAfterCommitSave(objApp, lngRecord)

	AddUserToDefaultGroups objApp, lngRecord
	
	SendUserCreationEmail objApp, lngRecord

End Function

Public Function OnSubstateChange (objApp, objField, varSubState, rs, ByRef strChangedFields)
	' DESCRIPTION:
	'   This function allows customizing actions triggered after the Substate/Status/Progress 
	'   field has been modified. The event occurs server side during the saving of the record
	'   from a Web view. In particular, when saving the new value of this field to the database. 
	'		varSubState = new value of Substate/Status/Progress. It is in the process of being saved. 
	'		rs = recordset with the latest values of fields for the current record in the main table (e.g. tblDts).
	'		objField = definition of the field being saved, which in this case is the Substate/Status/Progress.
	' RETURN VALUE:
	'   Info: not used
	'	Argument strChangedFields: a comma seperated list of changed fields
	
End Function

Public Function OnUpdateSLA(objApp, lngRecord)
        ' DESCRIPTION:
        '   This function will allow user to add custom code for updating the SLA from the view.
        '   Here you can add code specific to your needs.
		' RETURN VALUE:
		'   Info: not used
		
End Function

Private Function ValidateUniqueValue(ByVal objApp, ByVal lngRecord, ByVal dctFldVals)
On Error Resume Next

    Dim strSQL
    Dim rsUniqueVal
    Dim strReturn
    Dim strCurrentValue
    
    Const TBL_DTS = "tblDts" 'table where the field is. This could change (e.g. tblFixInformation)
    Const FLD_DTS_ID = "nID"
    Const UNIQUE_FIELD_NAME = "<FIELD_tName>" 'tName of the field we are checking taken from tblDtsFields
    Const UNIQUE_FIELD_ID = "<FIELD_nID>" 'nID of the field we are checking taken from tblDtsFields
    Const UNIQUE_FIELD_CAPTION = "<FIELD_tCaption>" 'Caption of the field as displayed in the view
    strReturn = ""

    If Not dctFldVals Is Nothing Then
        If Not objApp Is Nothing Then
            If dctFldVals.Exists(UNIQUE_FIELD_ID) Then
                'Get the current value we are saving
                strCurrentValue = dctFldVals.Item(UNIQUE_FIELD_ID)
                'check if there is another record with the same value in that field
                strSQL = "SELECT [" & FLD_DTS_ID & "]" & _
                            " FROM [" & TBL_DTS & "]" & _
                            " WHERE [" & UNIQUE_FIELD_NAME & "]='" & _
                            Replace(strCurrentValue, "'", "''") & "'" & _
                            " AND " & [FLD_DTS_ID] & "<>" & lngRecord
                Set rsUniqueVal = objApp.DBConnections(cenDat).GetConnection(cenDSEnsureOpenConnection).Execute(strSQL)
            
                If Not rsUniqueVal Is Nothing Then
                    If Not rsUniqueVal.EOF Then
                        'There is another record with the same value already, return a message. The save won't happen.
                        strReturn = "Cannot save. There is already an issue with the same " & UNIQUE_FIELD_CAPTION & "."
                    End If
                    rsUniqueVal.Close
                End If
                Set rsUniqueVal = Nothing
            End If
        End If
    End If

    ValidateUniqueValue = strReturn
    
End Function

Private Function CopyTasks(ByVal objApp, ByVal lngBaseRecordID, ByVal lngNewRecordID)

	Const FLD_ID_TASKS = "<F.ID:Tasks>"
	
	Dim objSubRecMgr
	Dim blnReturn
	
	blnReturn = False
	
	If FLD_ID_TASKS <> "" Then
		If objApp.CensusApplication.CurrentProject.Fields.Exists(CLng(FLD_ID_TASKS)) Then
			Set objSubRecMgr = CreateObject("MqCenCore.VNSubRecMgr")
			
			objSubRecMgr.Initialize objApp.CensusApplication, objApp.CensusApplication.CurrentProject.Fields.Item(CLng(FLD_ID_TASKS))
			blnReturn = objSubRecMgr.Copy(lngBaseRecordID, lngNewRecordID)
			
		End If
	End If
	
	CopyTasks = blnReturn
	
	Set objSubRecMgr = Nothing
	
End Function


Private Sub SetDefaultPwd(ByVal dctFldVals)
	
	Const FLD_PASSWORD = "<F.ID:Password>"
	Const FLD_CONF_PWD = "<F.ID:Confirm Password>"
	
	Dim strDefPwd
	strDefPwd = ""
	
	strDefPwd = GenerateDefaultPwd()
	
	'Set the default password for the new user accounts that are created
	If dctFldVals.Exists(FLD_PASSWORD) Then
		dctFldVals.Item(FLD_PASSWORD) = strDefPwd
		
		If dctFldVals.Exists(FLD_CONF_PWD) Then
			dctFldVals.Item(FLD_CONF_PWD) = strDefPwd
		End If
	End If

End Sub


Private Function GenerateDefaultPwd()
	
    Randomize()

    Dim CharacterSetArray
    CharacterSetArray = Array(_
        Array(5, "abcdefghijklmnopqrstuvwxyz"), _
        Array(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), _
        Array(1, "0123456789"), _
        Array(1, "!@#$+-*&?:") _
    )

    Dim i
    Dim j
    Dim Count
    Dim Chars
    Dim Index
    Dim Temp

    For i = 0 To UBound(CharacterSetArray)

        Count = CharacterSetArray(i)(0)
        Chars = CharacterSetArray(i)(1)

        For j = 1 To Count

            Index = Int(Rnd() * Len(Chars)) + 1
            Temp = Temp & Mid(Chars, Index, 1)

        Next
    Next

    Dim strTempCopy

    Do Until Len(Temp) = 0

        Index = Int(Rnd() * Len(Temp)) + 1
        strTempCopy = strTempCopy & Mid(Temp, Index, 1)
        Temp = Mid(Temp, 1, Index - 1) & Mid(Temp, Index + 1)

    Loop

    GenerateDefaultPwd = strTempCopy

End Function

Private Sub SetDefaultCompany(ByVal objApp, ByVal dctFldVals)
	
	Const FLD_COMPANY = "<F.ID:Organization Name (Person Tab)>"
	Const FLD_CONTRACT_NUM = "<F.ID:Company Contract Number>"
	
	Dim strContractNum
	strContractNum = ""
	
	Dim lngCompany
	lngCompany = 0
	
	'Find a company with the same contract number
	If dctFldVals.Exists(FLD_CONTRACT_NUM) Then
		strContractNum = IfNull(dctFldVals.Item(FLD_CONTRACT_NUM))
	End If

	If strContractNum <> "" Then
		lngCompany = GetDefaultCompanyID_NewUser(objApp, strContractNum)
		If dctFldVals.Exists(FLD_COMPANY) Then
			dctFldVals.Item(FLD_COMPANY) = lngCompany
		End If
	End If

End Sub

Private Function GetDefaultCompanyID_NewUser(ByVal objApp, ByVal strContractNum)
	Dim strSQL
	Dim rsCompany
	Dim lngCompany
	lngCompany = 0
	
	strSQL = "SELECT [nID] FROM [tblUser] WHERE [Security_Type]=3 AND [Company_Contract_Number]='" & Replace(strContractNum, "'", "''") & "'"
	
	Set rsCompany = objApp.CensusApplication.CurrentProject.GetAllDataStores(cenUsers).GetConnection(cenDSEnsureOpenConnection).Execute(strSQL)
	
	If Not rsCompany.EOF Then
		lngCompany = IfNullL(rsCompany.Fields(0).Value)
	End If
	
	GetDefaultCompanyID_NewUser = lngCompany
	
	rsCompany.Close
    Set rsCompany = Nothing
	
End Function

Private Function AddUserToDefaultGroups(ByVal objApp, ByVal lngRecord)

	Const DEFAULT_GROUPS = ""

	Dim objGrpMgr
	Dim objIGrpMgr
	Dim objCOMIntHlpr
	Dim arrGroups
	Dim lngCount
	Dim rs
	Dim strUserName
	strUserName = ""
	
	If DEFAULT_GROUPS <> "" Then
		Set objCOMIntHlpr = CreateObject("MqScrCOM.CMqCOMIntHpr")
		Set objGrpMgr = CreateObject("MqCenX20.CMqGroupMgr")
		
		Set objIGrpMgr = objCOMIntHlpr.GetInt(objGrpMgr, "IMqGroupMgr")
		
		If Not objIGrpMgr Is Nothing Then
			arrGroups = Split(DEFAULT_GROUPS, ";")
			
			objIGrpMgr.Initialize objApp.CensusApplication.CurrentProject.GetAllDataStores(cenUsers)
			
			Set rs = objApp.DictDtsTablesForSave(objApp.strPrimaryTableName).rs
	
			strUserName = IfNull(rs.Fields("tUserName").Value)
			
			For lngCount = LBound(arrGroups) To UBound(arrGroups)
				objIGrpMgr.AddUserToGroup strUserName, CStr(IfNull(arrGroups(lngCount)))
			Next
		End If
	End If
	
	Set objGrpMgr = Nothing
	Set objIGrpMgr = Nothing
	Set objCOMIntHlpr = Nothing
	
End Function

Private Function SendUserCreationEmail(ByVal objApp, ByVal lngRecord)

	'Trigger send email and treat like pwd reset so it's only valid for 24 hours
	
	Dim objVNUser
	Dim strUserName
	Dim strEmailAddress
	Dim blnRetVal
	Dim strErrMsg
	Dim rs
	
	strUserName = ""
	strEmailAddress = ""
	strErrMsg = ""
	
	blnRetVal = False
	
    Set rs = objApp.DictDtsTablesForSave(objApp.strPrimaryTableName).rs
	
	strUserName = IfNull(rs.Fields("tUserName").Value)
	strEmailAddress = IfNull(rs.Fields("tEmailName").Value)
	
	If strEmailAddress <> "" And strUserName <> "" Then
		Set objVNUser = CreateObject("MqCenCore.VNUser")
			
		blnRetVal = objVNUser.SendResetPassword(objApp.CensusApplication, CStr(strUserName), CStr(strEmailAddress), strErrMsg, "Account Created")
		
		If blnRetVal = False Then
			LogMsg "SendUserCreationEmail: " & strErrMsg
		End If
		
		Set objVNUser = Nothing
	End If
	
	SendUserCreationEmail = blnRetVal
	
End Function