>Hi Nadya,
>tell me the results.
>
>But, my impression is that you want to obtain what VFP cannot gives to you.
>Shooting to a rule + a trigger for every record,
>I doubt that you can arrive more than 10000 record/s with direct code.
sec.
With the latest code it is 110 sec. per 50000 replacements. It was ~90 before I switched to InsCommand/etc.

**__RI_HEADER!@ Do NOT REMOVE or MODIFY this line!!!! @!__RI_HEADER**
* Steve Sawyer - Updated 11/22/1999
* Carl Karsten - Updated 12/15/1999
* Doug Hennig  - Updated 02/18/2000

*  Program...........: NEWRI.PRG
*  Author............: Jzanus Dev Team
*  Project...........: Visual Collections
*  Created...........: 04/04/2005  14:28:19
*  Modified..........: by NN - April 18, 2005 - 12:36:58
*  Copyright.........: (c) Jzanus LTD, 2005
*  Description.......: Generic RI Handler routine version 20
*  Calling Samples...:
*  Parameter List....:
*  Major change list.: Switched from scanning array of relations to table based

* Known limitations:
*	- Cascading updates and deletes for self-joins cause an "illegal recursion"
*		error because the RI code tries to update or delete records in the same
*		table the trigger is fired for, which VFP doesn't allow (all other
*		rules for self-joins are handled correctly)
*	- Compound keys aren't supported

function __RI_Handler
lparameters tcTriggerType

**-- CHANGE - NN - April 04, 2005 - 14:30:12 - added a new global variable
if vartype(m.glDontUseTriggers)="L" and m.glDontUseTriggers
	return && Don't do any validations
endif

local lcTable, ;
	lcAlias, ;
	lnTriggerType, llReturn

* Get the name of the table the trigger was fired for and determine what type
* of trigger was fired.

lcTable       = upper(cursorgetprop('SourceName'))
lcAlias       = alias()
llReturn = .t.

** These commands are not supported by Ole DB
#define cnERR_TRIGGER_FAILED 1539 && Trigger failed error number
#define cnDeleteCode 10
#define cnInsertCode 20
#define cnUpdateCode 30
#define cL_USE_AGAIN _triggerlevel > 1
*#define lNoSwitch m.lcKeyExp == chrtran(m.lcKeyExp,"+(-","   ") && Simple field
#define cRIAlias iif(not cL_USE_AGAIN, "RIDefinitions", m.lnSelRIDefi)

* If the trigger was passed, use it.
if vartype(m.tcTriggerType) = 'C' and not empty(m.tcTriggerType)
*!*		lnTriggerType = ICASE( ;
*!*				upper(m.tcTriggerType)="DELETE", cnDeleteCode, ;
*!*				upper(m.tcTriggerType)="INSERT", cnInsertCode, ;
*!*				upper(m.tcTriggerType)="UPDATE", cnUpdateCode )
	lnTriggerType = iif( ;
		upper(m.tcTriggerType)="DELETE", cnDeleteCode, ;
		iif(upper(m.tcTriggerType)="INSERT", cnInsertCode, ;
		cnUpdateCode ))
else
	local lcRecordState
	lcRecordState = getfldstate(-1)
* If the deletion status was changed and the record is deleted, this is a
* "DELETE" trigger.
* Define some constants that'll make the code easier to read.
	local ccFLDSTATE_UNCHANGED, ccFLDSTATE_EDITDEL, ccFLDSTATE_NEWUNCHANGED, ccFLDSTATE_NEWCHANGED
	ccFLDSTATE_UNCHANGED	=   '1'
* GETFLDSTATE() 1 = the field is unchanged
	ccFLDSTATE_EDITDEL		=   '2'
* GETFLDSTATE() 2 = the record was edited or deletion status changed
	ccFLDSTATE_NEWUNCHANGED	 =  '3'
* GETFLDSTATE() 3 = a new unchanged field or new undeleted record
	ccFLDSTATE_NEWCHANGED	=   '4'
* GETFLDSTATE() 3 = a new changed field or new deleted record
	do case
	case left(m.lcRecordState, 1) = ccFLDSTATE_EDITDEL and deleted()
		lnTriggerType = cnDeleteCode

* If the deletion status was changed and the record is not deleted, it was
* just recalled, so this is an "INSERT" trigger.

	case left(m.lcRecordState, 1) = ccFLDSTATE_EDITDEL
		lnTriggerType = cnInsertCode

* If this is a new record, this is an "INSERT" trigger.

	case ccFLDSTATE_NEWUNCHANGED $ m.lcRecordState or ;
			ccFLDSTATE_NEWCHANGED $ m.lcRecordState
		lnTriggerType = cnInsertCode

* Some field in the table has been changed, so this is an "UPDATE" trigger.

	case ccFLDSTATE_EDITDEL $ m.lcRecordState
		lnTriggerType = cnUpdateCode

* Carl Karsten found a weird bug in VFP: if you have a table with a memo field
* and delete a record such that the subsequent records have to be physically
* moved when you PACK, the "UPDATE" trigger for the table fires when you move
* the record pointer or close the table. In that case, we'll ignore it.

	case m.lcRecordState = replicate(ccFLDSTATE_NEWUNCHANGED, len(m.lcRecordState))
		return
	endcase
endif

* If we're at the top trigger level, start a transaction, create an error flag
* and array variables, get a snapshot of open tables, and set up the
* environment the way we need it.

if cL_USE_AGAIN
** Second or more level of the trigger
	select 0
	use RIDefinitions
	local lnSelRIDefi
	lnSelRIDefi = select()
else
	release gaErrors
	public gaErrors[1, 12]

	private paUsed[1], ;
		pcExact, ;
		pcANSI, ;
		pcDeleted, ;
		pcOnEscape, ;
		pcError, ;
		pcOldDBC, plError, pnSelRIDefi
	plError = .f.
	aused(paUsed)
	pcExact  = set('EXACT')
	pcANSI   = set('ANSI')
	pcDeleted = set('DELETED')
	pcError   = on('ERROR')
	pcOnEscape = on('escape')
	pcOldDBC = iif(empty(dbc()), '', '"' + dbc() + '"')

* this command is not supported in Ole Db
	on escape RICleanUp(.t.)

	set exact on
	set ansi on
	set deleted on
	on error plError = .t.
*!*		LogRIError(error(), ;
*!*			message(), message(1),"",.f.,"",.f.,"",0,"",.f.) &&

	if not used('RIDefinitions')
		use RIDefinitions in 0 && Open table with RI Definitions
	endif
	begin transaction
endif

if not m.plError

	local lcDBC, ;
		lcParentTag, ;
		lcChildTag, ;
		lcKeyExp, ;
		luOldKey, ;
		luNewKey, ;
		luKey, lcSearch

	lcDBC = cursorgetprop('Database')
	set database to (m.lcDBC)

	store "" to lcKeyExp, lcParentTag, lcChildTag

	lcSearch = padr(m.lcTable,128)

	select (cRIAlias)
	do case
	case m.lnTriggerType = cnUpdateCode && Update trigger

		scan for SearchTB = m.lcSearch and not empty(UpdCommand) and !m.plError&&and not empty(UpdCommand)
			lcParent = ParentTB
			lcChild = ChildTB
			if m.lcSearch = m.lcParent and m.lcParent <> m.lcChild
				if not m.lcParentTag = alltrim(ParentTag)
					lcParentTag  = alltrim(ParentTag)
					lcKeyExp = alltrim(ParentKey)
					luOldKey  = oldval(m.lcKeyExp, m.lcAlias)

*!*						if lNoSwitch && Simple expression
*!*							luNewKey = evaluate(m.lcAlias + "." + m.lcKeyExp)
*!*						else
					select (m.lcAlias)
					luNewKey       = evaluate(m.lcKeyExp )
					select (cRIAlias)
*endif
				endif
			else &&	 m.lcChild = m.lcSearch or very rare case of self-join
				if not m.lcChildTag = alltrim(ChildTag)
					lcChildTag  = alltrim(ChildTag)
					lcKeyExp = alltrim(ChildKey)
					luOldKey  = oldval(m.lcKeyExp, m.lcAlias)

					select (m.lcAlias)
					luNewKey       = evaluate(m.lcKeyExp )
					select (cRIAlias)
				endif
			endif

			if m.luNewKey <> m.luOldKey && Check for IsNull is embedded indirectly
				=evaluate(alltrim(UpdCommand))
			endif
		endscan

	case m.lnTriggerType = cnInsertCode  && Insert trigger

		scan for SearchTB = m.lcSearch and not empty(InsCommand) and !m.plError && and not empty(InsCommand)

			if vartype(m.pcCascadeParent) <> "C" or m.pcCascadeParent <> alltrim(ParentTB)

				if m.lcKeyExp <> alltrim(ChildKey) && we don't want to evaluate more times than needed
					lcKeyExp = alltrim(ChildKey)

					select (m.lcAlias)
					luKey       = evaluate(m.lcKeyExp )
					select (cRIAlias)
				endif

				if !isnull(m.luNewKey)
					=evaluate(alltrim(InsCommand))
				endif
			endif
		endscan

	case m.lnTriggerType = cnDeleteCode && Delete trigger
*	set order to DelTrig
		scan for SearchTB = m.lcSearch and not empty(DelCommand) and not m.plError &&and not empty(DelCommand)
			if not m.lcParentTag = alltrim(ParentTag)
				lcParentTag  = alltrim(ParentTag)
				lcKeyExp = alltrim(ParentKey)

				if lNoSwitch && Simple expression on one field
					luKey = evaluate(m.lcAlias + "." + m.lcKeyExp)
				else
					select (m.lcAlias)
					luKey       = evaluate(m.lcKeyExp )
					select (cRIAlias)
				endif
			endif

			if not isnull(m.luKey)
				=evaluate(alltrim(DelCommand))
			endif
		endscan
	endcase
endif

* If we're at the top trigger level, either end the transaction or roll it
* back, depending on whether the trigger succeeded or not, close any tables we
* opened, restore the things we changed, and return whether we succeeded or
* not.
if not cL_USE_AGAIN
	=RICleanUp(.f.)
* If we're not at the top trigger level, return .T. so we don't trigger an
* error yet.
	llReturn = not m.plError
endif _triggerlevel = 1
return m.llReturn

* CleanUp procedure
function RICleanUp
lparameters tlEscaped
if m.tlEscaped and ;
		messagebox("Are you sure you want to stop the trigger's execution?",4+16,"Stop execution") = 7
**
	retry
else
	if m.tlEscaped or not cL_USE_AGAIN
		local lnTables, laTables[1], lnI
		if not empty(m.pcOldDBC)
			set database to (m.pcOldDBC)
		endif

		if m.plError or m.tlEscaped
			rollback
		else
			end transaction
		endif plError

** Gregory Adam suggested in the thread #1002645 to only close tables in Default DS
		if set("Datasession") > 1 or vartype(m.glLeaveTablesOpen)="L" and m.glLeaveTablesOpen && we're dealing with private DS, don't need to close
		else
			lnTables = aused(laTables)
			for lnI = 1 to m.lnTables
				lcTable = laTables[m.lnI, 1]
				if not empty(m.lcTable) and ascan(paUsed, m.lcTable) = 0
					use in (m.lcTable)
				endif not empty(lcTable) ...
			next lnI

		endif

		if m.pcExact = "OFF"
			set exact off
		endif

		if m.pcANSI = "OFF"
			set ansi off
		endif

		if m.pcDeleted = "OFF"
			set deleted off
		endif
		on error &pcError
** this command is not supported in Ole Db
		on escape &pcOnEscape
	endif
endif
return

* Cascade update function: change the foreign key field in all child records
* that belong to the parent record.

function Cascade_Update
lparameters tuOldKey, tuNewKey, tcChildKey
* call 3. parameter with alltrim(ChildKey)

*-- necessary ? if so, replace further down with this private...
private pcCascadeParent
pcCascadeParent = alltrim(ParentTB)
* Do the cascading update. Log any error that occurred.
local tcChildTable

tcChildTable = alltrim(RIDefinitions.ChildTB)

update (m.tcChildTable) ;
	set &tcChildKey = m.tuNewKey ;
	where &tcChildKey = m.tuOldKey

if m.plError
	local laError[1]
	aerror(laError)

	LogRIError(laError[1], laError[2], 'Cascade Update', ;
		m.pcCascadeParent, .f., alltrim(ParentKey), m.tuNewKey, ;
		alltrim(ChildTB), 0, m.tcChildKey, m.tuOldKey)
endif && plError
return

* Cascade delete function: delete all child records that belong to the parent
* record.

function Cascade_Delete
lparameters tuOldKey, tcChildKey

delete ;
	from (alltrim(ChildTB)) ;
	where &tcChildKey = m.tuOldKey

if m.plError
	local laError[1]
	aerror(laError)

	LogRIError(laError[1], laError[2], 'Cascade Delete', ;
		alltrim(ParentTB), .f., alltrim(ParentKey), m.tuOldKey, ;
		alltrim(ChildTB), 0, m.tcChildKey, m.tuOldKey)
endif && plError
return

* Restrict delete function: see if there are any records in the specified child
* table matching the specified key in the parent table.

function Restrict_Delete
lparameters tuKey

local lcTable, tcChildTable
tcChildTable = alltrim(ChildTB)

lcTable = strtran(m.tcChildTable, ' ', '_')

if not used(m.lcTable)
	use (m.tcChildTable) again in 0 shared alias (m.lcTable)
endif &¬ used(lcTable)

if indexseek(m.tuKey, .f., m.lcTable, alltrim(ChildTag)) && Record exists
*	if keymatch(m.tuKey,tagno(m.tcTag, '', m.lcTable), m.lcTable) && Record exists
	plError = .t.
	LogRIError(cnERR_TRIGGER_FAILED, 'Trigger Failed', 'Restrict Delete', ;
		alltrim(ParentTB), .f., alltrim(ParentKey), m.tuKey, ;
		alltrim(ChildTB), 0, alltrim(ChildKey), m.tuKey)
endif &&_tally > 0
return

* Restrict update function: see if there are any records in the specified child
* table matching the specified key in the parent table.

function Restrict_Update
lparameters tuOldKey, tuNewKey

local lcTable
lcTable = strtran(alltrim(ChildTB), ' ', '_')

if not used(m.lcTable)
	use (alltrim(ChildTB)) again in 0 shared alias (m.lcTable)
endif && not used(lcTable)

if indexseek(m.tuOldKey, .f., m.lcTable, alltrim(ChildTag)) && Record exists
	plError = .t.
	LogRIError(cnERR_TRIGGER_FAILED, 'Trigger Failed', 'Restrict Update', ;
		alltrim(ParentTB), .f., alltrim(ParentKey), m.tuNewKey, ;
		alltrim(ChildTB), 0, alltrim(ChildKey), m.tuOldKey)
endif
return

* Restrict insert function: ensure a record in the parent table for the foreign
* key exists.
* CFK - 5/28
* Or if the foreign key is null, no parent record is needed.
* The logic is this:
*  if you specify in the dbc that a child cannot exist with out a parent,
*    you can laxly enforce that by allowing nulls in that feild
*    and this code will allow that setting to be overridden
*    by setting the foreign key to null
*  or,
*  you can strictly enforce it by not allowing nulls, and then it will
*    pass this test, but fail the "allow nulls" test that the
*    database engine enforces.

function Restrict_Insert
lparameters tuKey, tcTriggerType

* CFK - 5/28
* If the key is Null, don't check for a parent, let it pass.

local lcTable
lcTable = strtran(alltrim(ParentTB), ' ', '_')

if not used(m.lcTable)
	use (alltrim(ParentTB)) again in 0 shared alias (m.lcTable)
endif && not used(lcTable)

if not indexseek(m.tuKey,.f.,m.lcTable,alltrim(ParentTag))
	plError = .t.
	LogRIError(cnERR_TRIGGER_FAILED, 'Trigger Failed', 'Restrict ' + proper(m.tcTriggerType), ;
		alltrim(ParentTB), 0, alltrim(ParentKey), 'Not Found', ;
		alltrim(ChildTB), .f., alltrim(ChildKey), m.tuKey)
endif
return


* Log errors to the public gaError array.
procedure LogRIError(tnErrNo, ;
	tcMessage, ;
	tcCode, ;
	tcParentTable, ;
	tnParentRec, ;
	tcParentExp, ;
	tuParentKey, ;
	tcChildTable, ;
	tnChildRec, ;
	tcChildExp, ;
	tuChildKey)

if vartype(m.tnParentRec)!="N"
	tnParentRec = iif(used(m.tcParentTable),recno(m.tcParentTable), 0)
endif

if vartype(m.tnChildRec)!="N"
	tnChildRec = iif(used(m.tcChildTable),recno(m.tcChildTable), 0)
endif

local lnErrorRows, ;
	lnLevel

plError = .t.
* Add another row to the error array if necessary.

lnErrorRows = alen(gaErrors, 1)
if type('gaErrors[lnErrorRows, 1]') <> 'L'
	lnErrorRows = lnErrorRows + 1
	dimension gaErrors[lnErrorRows, alen(gaErrors, 2)]
endif type('gaErrors[lnErrorRows, 1]') <> 'L'

* Log the error information, including the parameters passed to us and the
* program stack.

gaErrors[lnErrorRows,  1] = tnErrNo
gaErrors[lnErrorRows,  2] = tcMessage
gaErrors[lnErrorRows,  3] = evl(tcCode,"")
gaErrors[lnErrorRows,  4] = ''
for lnLevel = 1 to program(-1)
	gaErrors[lnErrorRows,  4] = gaErrors[lnErrorRows, 4] + ',' + ;
		program(lnLevel)
next lnLevel
gaErrors[lnErrorRows,  5] = evl(tcParentTable,"")
gaErrors[lnErrorRows,  6] = tnParentRec
gaErrors[lnErrorRows,  7] = evl(tuParentKey,"")
gaErrors[lnErrorRows,  8] = evl(tcParentExp,"")
gaErrors[lnErrorRows,  9] = evl(tcChildTable,"")
gaErrors[lnErrorRows, 10] = tnChildRec
gaErrors[lnErrorRows, 11] = evl(tuChildKey,"")
gaErrors[lnErrorRows, 12] = evl(tcChildExp,"")
return tnErrNo

**__RI_FOOTER!@ Do NOT REMOVE or MODIFY this line!!!! @!__RI_FOOTER**