'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
    
	If strValidate = "" Then
		strValidate = RunConfigScripts(objApp, 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
	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)
	
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 = "788"
	
	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 Function RunConfigScripts(ByVal objApp, ByVal dctFldVals)

	'Run the scripts for any that are selected
	
	Dim strConfigurationsSelected
	'Dim rs
	Dim objSQLServer
	Dim arrConfigs
	Dim lngCount
	Dim strScriptFile
	Dim strScriptContents
	Dim strScriptFolder
	Dim objFS
	Dim objUsersDB
	Dim strReturn
	
	'Const CONFIG_FIELD_ID = "<FIELD_Configuration>"
	Const CONFIG_FIELD_ID = "801"
	
	
	strReturn = ""
	strScriptContents = ""
	strConfigurationsSelected = ""
	
	Set objFS = CreateObject("Mqsysutils40.CMqFileSystem")

	'Set rs = objApp.DictDtsTablesForSave(objApp.strPrimaryTableName).rs
	'strConfigurationsSelected = IfNull(rs.Fields("Configuration").Value)
	
	If IsNumeric(CONFIG_FIELD_ID) Then
		If Not dctFldVals Is Nothing Then			
			If dctFldVals.Exists(CONFIG_FIELD_ID) Then
				strConfigurationsSelected = dctFldVals.Item(CONFIG_FIELD_ID)
			End If
		End If
	End If

	If strConfigurationsSelected <> "" Then
		
		arrConfigs = Split(strConfigurationsSelected, ";")
		
		Set objSQLServer = CreateObject("MqDBTools404.CMqSQLServer")
		
		Set objUsersDB = objApp.DBConnections.Item(CLng(cenUsers))
		
		If objSQLServer.LogIn(objUsersDB.UserName, objUsersDB.Password, objUsersDB.DataStoreName, objUsersDB.Location) Then
			
			'stop get path
			strScriptFolder = "C:\Program Files (x86)\Vector\ConnectServer\CensusWeb\Views\CensusWebVD\Configuration_Configuration\scripts\" 'objApp.CensusApplication.CurrentProject.ProjectName
			
			For lngCount = LBound(arrConfigs) To UBound(arrConfigs)
				'get the script file
				strScriptFile = GetAssociatedConfigFile(arrConfigs(lngCount), objApp.CensusApplication.CurrentProject.GetAllDataStores(64))
				
				If strScriptFile <> "" Then
					
					strScriptFile = objFS.ConcatenatePath(CStr(strScriptFolder), CStr(strScriptFile))
					
					'read the contents
					strScriptContents = GetBodyFromTextFile(strScriptFile)
					
					If strScriptContents <> "" Then
						'execute the script
						If objSQLServer.RunStoredProcedureNoResults(CStr(strScriptContents)) = False Then
							strReturn = "RunConfigScripts failed on script " & arrConfigs(lngCount)
						End If
					End If
				End If
			Next
		Else
			strReturn = "RunConfigScripts failed to log in to SQL"
		End If
		
		Set objSQLServer = Nothing
	End If
	
	RunConfigScripts = strReturn
	
	Set objFS = Nothing
	Set objUsersDB = Nothing
	
End Function

Private Function GetAssociatedConfigFile(ByVal strConfigName, ByVal dsDef)

	Dim strSQL
	Dim rsConfig
	Dim strFile
	
	strFile = ""
	
	strSQL = "SELECT [tAction] FROM [tblConfiguration] WHERE [tName]='" & Replace(strConfigName, "'", "''") & "'"
	
	Set rsConfig = dsDef.GetConnection(cenDSEnsureOpenConnection).Execute(CStr(strSQL))
	
	If Not rsConfig.EOF Then
		strFile = IfNull(rsConfig.Fields(0).Value)
	End If
	
	rsConfig.Close
	Set rsConfig = Nothing
	
	GetAssociatedConfigFile = strFile

End Function

Private Function GetBodyFromTextFile(ByVal strFileName)
        
    Dim fsObj
    Dim txtStreamObj
    Dim strText
    Dim objStrManip
	strText = ""
	
    'create a file system object
    Set fsObj = CreateObject("Scripting.FileSystemObject")
    Set objStrManip = CreateObject("Mqsysutils40.CMqStringManipulation")
	
	If fsObj.FileExists(CStr(strFileName)) Then
		'open the file for reading
		Set txtStreamObj = fsObj.OpenTextFile(CStr(strFileName))
		
		'read the text from the file
		strText = txtStreamObj.ReadAll
		
		'close the file system object
		txtStreamObj.Close
		Set txtStreamObj = Nothing
	Else
		LogMsg "GetBodyFromTextFile - file not found " & strFileName
	End If
	
    Set fsObj = Nothing
    
    'return the text from the file
    GetBodyFromTextFile = objStrManip.GetNullTerminatedString(CStr(strText))
    
	Set objStrManip = Nothing
	
End Function
