⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 share-script.asp

📁 AspMaker调用的自定义包
💻 ASP
📖 第 1 页 / 共 3 页
字号:
		<!--##~Script##-->
<!--##
	End If
	End If
Next
##-->

		' Call updating event
		If Recordset_Updating(rsold, rs) Then

			' clone new rs object
			Set rsnew = CloneRs(rs)

			rs.Update
			If Err.Number <> 0 Then
				Session(ewSessionMessage) = Err.Description
				<!--##=sFunctionName##--> = False
			Else
				<!--##=sFunctionName##--> = True
			End If
		Else
			rs.CancelUpdate
			<!--##=sFunctionName##--> = False
		End If
	End If
<!--##
If ewCond_HasFileField() And InStr(1,DB.DBDBMSName,"ORA",vbTextCompare) > 0 Then
	For i = 1 to TABLE.Fields.Count
		Set FIELD = TABLE.Fields.Seq(i)
		If FIELD.FldGenerate Then
		If FIELD.FldHtmlTag = "FILE" AND TABLE.TblType = "TABLE" Then
##-->
	' For Oracle DB Table, remove Blob field using EmptyBlob() if remove option specifed
	If a_<!--##=FIELD.FldVar##--> = "2" Then
		sSql = "UPDATE <!--##=Quote(DB.DBQuoteS & TABLE.TblName & DB.DBQuoteE)##--> SET <!--##=Quote(DB.DBQuoteS & FIELD.FldName & DB.DBQuoteE)##--> = Empty_Blob() WHERE " & sWhere
		conn.execute(sSql)
	End If
<!--##
		End If
		End If
	Next
End If
##-->
	
	' Call updated event
	If <!--##=sFunctionName##--> Then
		Call Recordset_Updated(rsold, rsnew)
	End If
	rs.Close
	Set rs = Nothing
	rsold.Close
	Set rsold = Nothing
	rsnew.Close
	Set rsnew = Nothing

End Function

'-------------------------------------------------------------------------------
' Recordset updating event

Function Recordset_Updating(rsold, rsnew)
	On Error Resume Next
	' Please enter your customized codes here
	Recordset_Updating = True
End Function

'-------------------------------------------------------------------------------
' Recordset updated event

Sub Recordset_Updated(rsold, rsnew)
	On Error Resume Next
	Dim table
	table = "<!--##=TABLE.TblName##-->"

<!--## If TABLE.TblAuditTrail Or TABLE.TblSendMailOnEdit Then ##-->
	' Get key value
	Dim sKey
	sKey = ""
	<!--##
	For i = 1 to TABLE.Fields.Count
		Set FIELD = TABLE.Fields.Seq(i)
		If FIELD.FldIsPrimaryKey Then
			sFldName = FIELD.FldName
	##-->
	If sKey <> "" Then sKey = sKey & ","
	sKey = sKey & rsnew.Fields("<!--##=sFldName##-->")
	<!--##
		End If
	Next
	##-->
<!--## End If ##-->

<!--## If TABLE.TblAuditTrail Then ##-->
	' Write Audit Trail
	Dim filePfx, curDate, curTime, id, user, action, field, keyvalue, oldvalue, newvalue
	Dim i
	filePfx = "event"
	curDate = ewZeroPad(Year(Date), 4) & "/" & ewZeroPad(Month(Date), 2) & "/" & ewZeroPad(Day(Date), 2)
	curTime = ewZeroPad(Hour(Time), 2) & ":" & ewZeroPad(Minute(Time), 2) & ":" & ewZeroPad(Second(Time), 2)
	id = Request.ServerVariables("SCRIPT_NAME")
	user = CurrentUserID
	action = "U"
	For i = 0 to rsold.Fields.Count - 1
		If rsold.Fields(i).Type <> 205 Then ' Ignore Blob Field
			If rsold.Fields(i).Type = 201 Or rsold.Fields(i).Type = 203 Then ' Memo Field
				oldvalue = "<MEMO>"
				newvalue = "<MEMO>"
			Else
				oldvalue = ewConv(rsold.Fields(i).Value, rsold.Fields(i).Type)
				newvalue = ewConv(rsnew.Fields(i).Value, rsnew.Fields(i).Type)
			End If
			If oldvalue <> newvalue Then
				field = rsold.Fields(i).Name
				keyvalue = sKey
				Call ewWriteAuditTrail(filePfx, curDate, curTime, id, user, action, table, field, keyvalue, oldvalue, newvalue)
			End If
		End If
	Next
<!--## End If ##-->

<!--## If TABLE.TblSendMailOnEdit Then ##-->
	' Send Email
	Dim sSenderEmail, sReceiverEmail
	sSenderEmail = "<!--##=PROJ.SecSenderEmail##-->" ' sender email
	sReceiverEmail = "<!--##=PROJ.RecipientEmail##-->" ' receiver email
	If sSenderEmail <> "" And sReceiverEmail <> "" Then
		Call LoadEmail("notify.txt")
		sEmailFrom = Replace(sEmailFrom, "<!--$From-->", sSenderEmail) ' Replace Sender
		sEmailTo = Replace(sEmailTo, "<!--$To-->", sReceiverEmail) ' Replace Receiver
		sEmailSubject = Replace(sEmailSubject, "<!--$Subject-->", table & " record updated") ' Replace Subject
		sEmailContent = Replace(sEmailContent, "<!--table-->", table)
		sEmailContent = Replace(sEmailContent, "<!--key-->", sKey)
		sEmailContent = Replace(sEmailContent, "<!--action-->", "Updated")
		Call Send_Email(sEmailFrom, sEmailTo, sEmailCc, sEmailBcc, sEmailSubject, sEmailContent, sEmailFormat)
	End If
<!--## End If ##-->

End Sub
%>
<!--## End If ##-->
<!--## If CTRL.CtrlID = "add" Or CTRL.CtrlID = "register" Then ##-->
<%
'-------------------------------------------------------------------------------
' Function AddData
' - Add Data
' - Variables used: field variables

Function AddData()

	On Error Resume Next
	Dim rs, sSql, sFilter
	Dim rsnew
	Dim bCheckKey, sSqlChk, sWhereChk

	sFilter = ewSqlKeyWhere

<!--##
If bDynamicUserLevel And TABLE.TblName = DB.UserLevelTbl Then
	Set FIELD = TABLE.Fields(DB.UserLevelIdFld)
	sUserLevelIDFldVar = FIELD.FldVar
	Set FIELD = TABLE.Fields(DB.UserLevelNameFld)
	sUserLevelNameFldVar = FIELD.FldVar
##-->
	If <!--##=sUserLevelIDFldVar##--> = "" Or IsNull(<!--##=sUserLevelIDFldVar##-->) Then
		Session(ewSessionMessage) = "<!--##@MissingUserLevelID##-->"
	ElseIf <!--##=sUserLevelNameFldVar##--> = "" Or IsNull(<!--##=sUserLevelNameFldVar##-->) Then
		Session(ewSessionMessage) = "<!--##@MissingUserLevelName##-->"
	ElseIf Not IsNumeric(<!--##=sUserLevelIDFldVar##-->) Then
		Session(ewSessionMessage) = "<!--##@UserLevelIDInteger##-->"
	ElseIf CLng(<!--##=sUserLevelIDFldVar##-->) < -1 Then
		Session(ewSessionMessage) = "<!--##@UserLevelIDIncorrect##-->"
	ElseIf CLng(<!--##=sUserLevelIDFldVar##-->) = 0 And LCase(Trim(<!--##=sUserLevelNameFldVar##-->)) <> "anonymous" Then
		Session(ewSessionMessage) = "<!--##@UserLevelAnonymousName##-->"
	ElseIf CLng(<!--##=sUserLevelIDFldVar##-->) = -1 And LCase(Trim(<!--##=sUserLevelNameFldVar##-->)) <> "administrator" Then
		Session(ewSessionMessage) = "<!--##@UserLevelAdministratorName##-->"
	ElseIf CLng(<!--##=sUserLevelIDFldVar##-->) > 0 And (LCase(Trim(<!--##=sUserLevelNameFldVar##-->)) = "administrator" Or LCase(Trim(<!--##=sUserLevelNameFldVar##-->)) = "anonymous") Then
		Session(ewSessionMessage) = "<!--##@UserLevelNameIncorrect##-->"
	End If

	If Session(ewSessionMessage) <> "" Then
		AddData = False
		Exit Function
	End If
<!--##
End If
##-->

	' Check for duplicate key
	bCheckKey = True
<!--##
	For i = 1 to TABLE.Fields.Count
		Set FIELD = TABLE.Fields.Seq(i)
		If FIELD.FldIsPrimaryKey Then
			sFldVar = FIELD.FldVar
			sFldVar2 = Mid(sFldVar, 3)
##-->
	If <!--##=sFldVar##--> = "" Or IsNull(<!--##=sFldVar##-->) Then
		bCheckKey = False
	Else
		sFilter = Replace(sFilter, "@<!--##=sFldVar2##-->", AdjustSql(<!--##=sFldVar##-->)) ' Replace key value
	End If
<!--##
			If ewGetFieldType(FIELD.FldType) = 1 Then 'Numeric
##-->
	If Not IsNumeric(<!--##=sFldVar##-->) Then
		bCheckKey = False
	End If
<!--##
			End If
		End If
	Next
##-->
	If bCheckKey Then
		sSqlChk = ewBuildSql(ewSqlSelect, ewSqlWhere, ewSqlGroupBy, ewSqlHaving, ewSqlOrderBy, sFilter, "")
		Set rsChk = conn.Execute(sSqlChk)
		If Err.Number <> 0 Then
			Session(ewSessionMessage) = Err.Description
			rsChk.Close
			Set rsChk = Nothing
			AddData = False
			Exit Function
		ElseIf Not rsChk.Eof Then
			Session(ewSessionMessage) = "<!--##@DupKey##-->"
			rsChk.Close
			Set rsChk = Nothing
			AddData = False
			Exit Function
		End If
		rsChk.Close
		Set rsChk = Nothing
	End If

<!--##
	For i = 1 to TABLE.Fields.Count
		Set FIELD = TABLE.Fields.Seq(i)
		If (FIELD.FldUniqueIdx Or FIELD.FldCheckDuplicate) And Not (FIELD.FldAutoIncrement Or FIELD.FldHtmlTag = "FILE") Then
			sFldName = ewFieldName
			sFldQuoteS = FIELD.FldQuoteS
			sFldQuoteE = FIELD.FldQuoteE
			sFldVar = FIELD.FldVar
##-->
	If <!--##=sFldVar##--> = "" Or IsNull(<!--##=sFldVar##-->) Then ' Check field with unique index
		' Ignore
	Else
		sFilter = "(<!--##=Quote(sFldName)##--> = <!--##=sFldQuoteS##-->" & AdjustSql(<!--##=sFldVar##-->) & "<!--##=sFldQuoteE##-->)"
		sSqlChk = ewBuildSql(ewSqlSelect, ewSqlWhere, ewSqlGroupBy, ewSqlHaving, ewSqlOrderBy, sFilter, "")
		Set rsChk = conn.Execute(sSqlChk)
		If Err.Number <> 0 Then
			Session(ewSessionMessage) = Err.Description
			rsChk.Close
			Set rsChk = Nothing
			AddData = False
			Exit Function
		ElseIf Not rsChk.Eof Then
			Session(ewSessionMessage) = "<!--##@DupKey1##--><!--##=sFldName##-->, <!--##@DupKey2##--> " & <!--##=sFldVar##-->
			rsChk.Close
			Set rsChk = Nothing
			AddData = False
			Exit Function
		End If
		rsChk.Close
		Set rsChk = Nothing
	End If
<!--##
		End If
	Next
##-->

<!--##
If bMasterTableHasUserIDFld Then
##-->
	If CurrentUserID <> "-1" And CurrentUserID <> "" Then ' Non system admin
		sMasterUserIDQuery = GetMasterUserIDQuery(CurrentUserID)
		If sMasterUserIDQuery <> "" Then
	<!--##
	If Not bUseSubQuery Then
	##-->
			sTmpQuery = sMasterUserIDQuery
	<!--##
		For i = 0 to UBound(arMasterFldNames)
	##-->
			sTmpQuery = Replace(sTmpQuery, "#Key<!--##=i##-->", "<!--##=arMasterFldNames(i)##-->")
	<!--##
		Next
	##-->
			sFilter = sTmpQuery
	<!--##
	Else
	##-->
			sFilter = ""
	<!--##
		For i = 0 to UBound(arMasterFldNames)
	##-->
			If sFilter <> "" Then sFilter = sFilter & " AND "
			sTmpQuery = sMasterUserIDQuery
			sTmpQuery = Replace(sTmpQuery, "#MasterKey", "<!--##=arMasterFldNames(i)##-->")
			sTmpQuery = Replace(sTmpQuery, "#Key", "<!--##=arMasterFldNames(i)##-->")
			sFilter = sFilter & sTmpQuery
	<!--##
		Next
	End If
	##-->
		End If
		sSqlChk = ewBuildSql(ewSqlMasterSelect, ewSqlMasterWhere, ewSqlMasterGroupBy, ewSqlMasterHaving, ewSqlMasterOrderBy, sFilter, "")
		Set rsChk = conn.Execute(sSqlChk)
		If Err.Number <> 0 Then
			Session(ewSessionMessage) = Err.Description
			rsChk.Close
			Set rsChk = Nothing
			AddData = False
			Exit Function
		ElseIf rsChk.Eof Then
			Session(ewSessionMessage) = "<!--##@UnAuthorized##-->"
			rsChk.Close
			Set rsChk = Nothing
			AddData = False
			Exit Function
		End If
		rsChk.Close
		Set rsChk = Nothing
	End If
<!--##
End If
##-->

	' Add New Record
	sFilter = "(0 = 1)"
	sSql = ewBuildSql(ewSqlSelect, ewSqlWhere, ewSqlGroupBy, ewSqlHaving, ewSqlOrderBy, sFilter, "")

	Set rs = Server.CreateObject("ADODB.Recordset")
	rs.CursorLocation = <!--##=ewCursorLocation##-->
	rs.Open sSql, conn, 1, 2

	If Err.Number <> 0 Then
		Session(ewSessionMessage) = Err.Description
		rs.Close
		Set rs = Nothing
		AddData = False
		Exit Function
	End If

	rs.AddNew

<!--##
For i = 1 to TABLE.Fields.Count
	SET FIELD = TABLE.Fields.Seq(i)
	If FIELD.FldGenerate Then
		If (CTRL.CtrlID = "add" And FIELD.FldAdd) Or (CTRL.CtrlID = "register" And FIELD.FldRegister) Then
			If (CTRL.CtrlID = "register" And FIELD.FldName = DB.SecUserLevelFld) Then ' User Level Field
				' skip normal processing for User level Field in Register Page
			Else
##-->
	' Field <!--##=FIELD.FldName##-->
	<!--##~Script##-->
<!--##
			End If
		End If
	End If
	If (CTRL.CtrlID = "register" And FIELD.FldName = DB.SecUserLevelFld) Then ' User Level Field
		If FIELD.FldDefault <> "" And IsNumeric(FIELD.FldDefault) Then
			iUserLevel = FIELD.FldDefault
		Else
			iUserLevel = 0
		End If
##-->
	' Field <!--##=FIELD.FldName##-->
	rs("<!--##=FIELD.FldName##-->") = <!--##=iUserLevel##--> ' Set Default User Level
<!--##
	End If
Next
##-->

	' Call recordset inserting event
	If Recordset_Inserting(rs) Then

		' Clone new rs object
		Set rsnew = CloneRs(rs)

		rs.Update
		If Err.Number <> 0 Then
			Session(ewSessionMessage) = Err.Description
			AddData = False
		Else
			AddData = True
		End If
	Else
		rs.CancelUpdate
		AddData = False
	End If

	rs.Close
	Set rs = Nothing

	' Call recordset inserted event
	If AddData Then
		Call Recordset_Inserted(rsnew)
	End If
	rsnew.Close
	Set rsnew = Nothing

	<!--##
	If bDynamicUserLevel And TABLE.TblName = DB.UserLevelTbl Then
		Set FIELD = TABLE.Fields(DB.UserLevelIdFld)
		sUserLevelIDFldVar = FIELD.FldVar
	##-->
	' Add user level priv
	If x_ewPriv > 0 And IsArray(arTableName) Then
		For i = LBound(arTableName) To UBound(arTableName)
			sSql = "INSERT INTO " & ewUsrLvlPrivTbl & " (" & _
				ewUsrLvlPrivTblNameFld & ", " & ewUsrLvlPrivUsrLvlIdFld & ", " & _
				ewUsrLvlPrivPrivFld & ") VALUES ('" & AdjustSql(arTableName(i)) & _
				"', " & <!--##=sUserLevelIDFldVar##--> & ", " & x_ewPriv & ")"
			conn.Execute(sSql)
		Next
	End If
	<!--##
	End If
	##-->

End Function

'-------------------------------------------------------------------------------
' Recordset inserting event

Function Recordset_Inserting(rsnew)
	On Error Resume Next
	' Please enter your customized codes here
	Recordset_Inserting = True
End Function

'-------------------------------------------------------------------------------
' Recordset inserted event

Sub Recordset_Inserted(rsnew)
	On Error Resume Next
	Dim table

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -