Well, seems like the changes I made didn't make the code run faster, but rather slower. Can you take one more look, please:

**__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
*  Copyright.........: (c) Jzanus LTD, 2005
*) Description.......:
*  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, ;
	lcRecordState, ;
	lcTriggerType, ;
	lcDBC, ;
	lcParent, ;
	lcChild, ;
	lcParentKeyExp, ;
	lcChildKeyExp, ;
	lnRIInfo, ;
	luOldKey, ;
	luNewKey, ;
	luOldFK, ;
	luNewFK, luKey, 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()
lcRecordState = getfldstate(-1)
llReturn = .t.

** This command is not supported by Ole DB
#define cnERR_TRIGGER_FAILED 1539
* Trigger failed error number

* If the trigger was passed, use it.
if vartype(m.tcTriggerType) = 'C' and not empty(m.tcTriggerType)
	lcTriggerType = upper(m.tcTriggerType)
else
* 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()
		lcTriggerType = 'DELETE'

* 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
		lcTriggerType = 'INSERT'

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

	case ccFLDSTATE_NEWUNCHANGED $ m.lcRecordState or ;
			ccFLDSTATE_NEWCHANGED $ m.lcRecordState
		lcTriggerType = 'INSERT'

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

	case ccFLDSTATE_EDITDEL $ m.lcRecordState
		lcTriggerType = 'UPDATE'

* 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 _triggerlevel = 1
	private plError
	plError = .f.
	release gaErrors
	public gaErrors[1, 12]

	private paUsed[1], ;
		pcExact, ;
		pcANSI, ;
		pcDeleted, ;
		pcOnEscape, ;
		pcError, ;
		pcOldDBC, plError

	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 LogRIError(error(),message()) &&plError = .t.
	if not used('RIDefinitions')
		use RIDefinitions in 0 && Open table with RI Definitions
	endif
	begin transaction
endif

if not m.plError
	lcDBC = cursorgetprop('Database')
	set database to (m.lcDBC)
	local lcParentTag, lcSearch
	store "" to lcParentKeyExp, lcChildKeyExp, lcParentTag

	lcSearch = padr(m.lcTable,128)
	lcParent = m.lcTable
	select RIDefinitions
	scan for upper(ParentTB) = m.lcSearch and alltrim(ParentTag)<> m.lcParentTag and not m.plError

		lcParentTag  = alltrim(ParentTag)

		do case

* If this is an update trigger and this relation has our table as the parent,
* let's process it. We'll ignore it if the RI rule is empty or "ignore".

		case m.lcTriggerType = 'UPDATE'
			lnRIInfo = UpdTrigger
			if m.lnRIInfo > 0 && not ignore
				if not alltrim(ParentKey) == m.lcParentKeyExp && So it would calculate it only once
					lcParentKeyExp = alltrim(ParentKey)
					select (m.lcAlias)
					luOldKey       = oldval(m.lcParentKeyExp, m.lcAlias)
					luNewKey       = evaluate(m.lcParentKeyExp)
					select RIDefinitions
				endif

* If this is a self-join, we may have an update trigger because the FK field
* in the "child" copy of the table was changed (which really is an insert
* trigger), so let's handle it if we have a restrict insert rule. The reason
* we don't handle it in a CASE below is that the user may have changed both
* the parent and foreign key fields.

				if m.lcParent ==  alltrim(ChildTB) && very rare case
					select (m.lcAlias)
					luOldFK = oldval(m.lcChildKeyExp, m.lcAlias)
					luNewFK = evaluate(m.lcChildKeyExp)
					select RIDefinitions
** Restrict ?

					if InsTrigger = 1 ;
							and not isnull(m.luOldFK) ;
							and not isnull(m.luNewFK) ;
							and m.luOldFK <> m.luNewFK
						Restrict_Insert(m.luNewFK, m.lcTriggerType)
					endif luOldFK <> luNewFK ...
				endif lcParent = lcChild

				do case

* The parent key wasn't changed or an error occurred, so we have nothing to do.

				case m.plError or m.luOldKey = m.luNewKey

* If the parent key has been changed, call the appropriate function, depending
* on whether this is a cascade or restrict rule.

				case m.lnRIInfo = 2 && 'Cascade'
					if not isnull(m.luOldKey)
						Cascade_Update(m.luOldKey, m.luNewKey)
					endif

				case m.lnRIInfo = 1 && Restrict
					Restrict_Update(m.luOldKey, m.luNewKey)
				endcase
			endif

* If this is a delete trigger and this relation has our table as the parent,
* let's process it. We'll ignore it if the RI rule is empty or "ignore".

		case m.lcTriggerType = 'DELETE'
			lnRIInfo = DelTrigger
			if m.lnRIInfo > 0
				if not alltrim(ParentKey) == m.lcParentKeyExp && So it would calculate it only once
					lcParentKeyExp = alltrim(ParentKey)
					select (m.lcAlias)
					luKey  = evaluate(m.lcParentKeyExp)
					select RIDefinitions
				endif

* Call the appropriate function, depending on whether this is a cascade or
* restrict rule.
				if not isnull(m.luKey) && We do nothing in NULL case
					do case
					case m.lnRIInfo = 2
						Cascade_Delete(m.luKey)
					case m.lnRIInfo = 1
						Restrict_Delete(m.luKey)
					endcase
				endif
			endif
		endcase
	endscan

** Now do the same for the child
	if inlist(m.lcTriggerType,"INSERT","UPDATE") && there are no restrictions on delete, if it's a child table
		select RIDefinitions
		lcChild = m.lcTable
		lcChildKeyExp = ""
		
		scan for upper(ChildTB) = m.lcSearch and InsTrigger = 1 and not m.plError
			
			if vartype(m.pcCascadeParent) = "C" and m.pcCascadeParent = alltrim(ParentTB)			
** In this case we do nothing - otherwise we're burried in recursion
			else

* If this relation has our table as the child, let's process it. We'll only
* process a "restrict" rule in either an insert or update trigger.
				if not m.lcChildKeyExp == alltrim(ChildKey) && we don't want to evaluate more times than needed
					lcChildKeyExp = alltrim(ChildKey)
					select (m.lcAlias)
					luNewKey     = evaluate(m.lcChildKeyExp)
					luOldKey = oldval(m.lcChildKeyExp, m.lcAlias)
					select RIDefinitions
				endif

* If this is an insert trigger or if it's an update trigger and the foreign key
* has changed, call the Restrict_Insert function to ensure the foreign key
* exists in the parent table.

				if m.lcTriggerType = 'INSERT' or m.luOldKey <> m.luNewKey
					Restrict_Insert(m.luNewKey, m.lcTriggerType)
				endif lcTriggerType <> 'UPDATE' ...
			endif
		endscan
	endif
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 _triggerlevel = 1
	=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(tlEscaped)
if m.tlEscaped and messagebox("Are you sure you want to stop the trigger's execution?",4+16,"Stop execution") = 7
**
	retry
else

	local lnTables, laTables[1], lnI
	if not empty(m.pcOldDBC)
		set database to (m.pcOldDBC)
	endif
	if _triggerlevel = 1
		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

local tcChildTable, tcChildKey, tcParentTable
tcParentTable = alltrim(RIDefinitions.ParentTB)
tcChildTable = alltrim(RIDefinitions.ChildTB)
tcChildKey = alltrim(RIDefinitions.ChildKey)
private pcCascadeParent
pcCascadeParent = m.tcParentTable
* Do the cascading update. Log any error that occurred.
update (m.tcChildTable) ;
	set &tcChildKey = m.tuNewKey ;
	where &tcChildKey = m.tuOldKey

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

	tcParentKey = alltrim(RIDefinitions.ParentKey)

	LogRIError(laError[1], laError[2], 'Cascade Update', ;
		m.tcParentTable, iif(used(m.tcParentTable),recno(m.tcParentTable),0), ;
		m.tcParentKey, m.tuNewKey, ;
		m.tcChildTable, 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

local tcChildTable, tcChildKey
tcChildTable = alltrim(RIDefinitions.ChildTB)
tcChildKey = alltrim(RIDefinitions.ChildKey)

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

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

	tcParentTable = alltrim(RIDefinitions.ParentTB)
	tcParentKey = alltrim(RIDefinitions.ParentKey)

	LogRIError(laError[1], laError[2], 'Cascade Delete', ;
		m.tcParentTable, iif(used(m.tcParentTable),recno(m.tcParentTable),0), ;
		m.tcParentKey, m.tuOldKey, ;
		m.tcChildTable, 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
*!*	(tcParentTable, ;
*!*		tcChildTable, ;
*!*		tcParentKey, ;
*!*		tcChildKey, ;
*!*		tuKey, tcTag)

local lcTable, tcChildTable, tcChildTag
tcChildTable = alltrim(RIDefinitions.ChildTB)
tcChildTag = alltrim(RIDefinitions.ChildTag)
lcTable = strtran(m.tcChildTable, ' ', '_')

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

if indexseek(m.tuKey, .f., m.lcTable, m.tcTag) && Record exists
*	if keymatch(m.tuKey,tagno(m.tcTag, '', m.lcTable), m.lcTable) && Record exists
	plError = .t.
	local tcParentTable

	tcParentTable = alltrim(RIDefinitions.ParentTB)

	LogRIError(cnERR_TRIGGER_FAILED, 'Trigger Failed', 'Restrict Delete', ;
		m.tcParentTable, iif(used(m.tcParentTable),recno(m.tcParentTable),0), ;
		alltrim(RIDefinitions.ParentKey), m.tuKey, ;
		m.tcChildTable, 0, alltrim(RIDefinitions.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
*!*	(tcParentTable, ;
*!*		tcChildTable, ;
*!*		tcParentKey, ;
*!*		tcChildKey, ;
*!*		tuOldKey, ;
*!*		tuNewKey, tcTag)

if not isnull(m.tuOldKey)
	local lcTable, tcChildTable, lcTag
	tcChildTable = alltrim(RIDefinitions.ChildTB)
	lcTable = strtran(m.tcChildTable, ' ', '_')
	lcTag = alltrim(RIDefinitions.ChildTag)

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

	if indexseek(m.tuOldKey, .f., m.lcTable, m.lcTag) && Record exists
*	if keymatch(m.tuOldKey,tagno(m.tcTag, '', m.lcTable), m.lcTable) && Record exists
		plError = .t.
		local tcParentTable
		tcParentTable = alltrim(RIDefinitions.ParentTB)

		LogRIError(cnERR_TRIGGER_FAILED, 'Trigger Failed', 'Restrict Update', ;
			m.tcParentTable, iif(used(m.tcParentTable),recno(m.tcParentTable),0), ;
			alltrim(RIDefinitions.ParentKey), m.tuNewKey, ;
			m.tcChildTable, 0, alltrim(RIDefinitions.ChildKey), m.tuOldKey)
	endif
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.
if !isnull( m.tuKey )

	local lcTable, tcParentTable, lcTag
	tcParentTable = alltrim(RIDefinitions.ParentTB)
	lcTable = strtran(m.tcParentTable, ' ', '_')
	lcTag = alltrim(RIDefinitions.ParentTag)

	if not used(m.lcTable)
		use (m.tcParentTable) again in 0 shared alias (m.lcTable)
	endif not used(lcTable)

	if not indexseek(m.tuKey,.f.,m.lcTable,m.lcTag)
*	if not keymatch(m.tuKey,tagno(m.tcTag, '', m.lcTable), m.lcTable) && Record doesn't exist
		plError = .t.
		local tcChildTable
		tcChildTable = alltrim(RIDefinitions.ChildTB)
		LogRIError(cnERR_TRIGGER_FAILED, 'Trigger Failed', 'Restrict ' + ;
			proper(m.tcTriggerType), m.tcParentTable, 0, alltrim(RIDefinitions.ParentKey), 'Not Found', ;
			m.tcChildTable, iif(used(m.tcChildTable),recno(m.tcChildTable),0), ;
			alltrim(RIDefinitions.ChildKey), m.tuKey)
	endif
endif !isnull( tuKey )
return

* Log errors to the public gaError array.
procedure LogRIError(tnErrNo, ;
	tcMessage, ;
	tcCode, ;
	tcParentTable, ;
	tnParentRec, ;
	tcParentExp, ;
	tuParentKey, ;
	tcChildTable, ;
	tnChildRec, ;
	tcChildExp, ;
	tuChildKey)
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] = evl(tnParentRec,0)
gaErrors[lnErrorRows,  7] = evl(tuParentKey,"")
gaErrors[lnErrorRows,  8] = evl(tcParentExp,"")
gaErrors[lnErrorRows,  9] = evl(tcChildTable,"")
gaErrors[lnErrorRows, 10] = evl(tnChildRec,0)
gaErrors[lnErrorRows, 11] = evl(tuChildKey,"")
gaErrors[lnErrorRows, 12] = evl(tcChildExp,"")
return tnErrNo

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

>>I'm just going to believe you then... If I find a book, which describes it, I'll read it up, of course.
>DON'T! Remember the m.dot ;-)

>clea
>LOCAL lux, lcStr, lcVgl, llErg, ;
>lnAsc, lnVgl, lnCount, lnStart, lnRun, lnX
>lcStr = "x"
>lcVgl = "V"
>lnAsc = ASC(m.lcStr)
>lnVgl = ASC(m.lcVgl)
>lnCount = 1000000
>
>FOR lnx = 1 TO 5
>	lnStart = SECONDS()
>	FOR lnRun = 1 TO m.lnCount
>	NEXT
>	= timeIt(m.lnStart)
>
>	lnStart = SECONDS()
>	FOR lnRun = 1 TO m.lnCount
>		= m.lcStr == m.lcVgl
>	NEXT
>	= timeIt(m.lnStart)
>
>	lnStart = SECONDS()
>	FOR lnRun = 1 TO m.lnCount
>		= m.lnAsc = m.lnVgl
>	NEXT
>	= timeIt(m.lnStart)
>
>	lnStart = SECONDS()
>	FOR lnRun = 1 TO m.lnCount
>		lux = m.lcStr
>	NEXT
>	= timeIt(m.lnStart)
>
>	lnStart = SECONDS()
>	FOR lnRun = 1 TO m.lnCount
>		luX = m.lnAsc
>	NEXT
>	= timeIt(m.lnStart)
>
>	lnStart = SECONDS()
>	FOR lnRun = 1 TO m.lnCount
>		= partst(m.lcStr)
>	NEXT
>	= timeIt(m.lnStart)
>
>	lnStart = SECONDS()
>	FOR lnRun = 1 TO m.lnCount
>		= partst(m.lnAsc)
>	NEXT
>	= timeIt(m.lnStart)
>
>	lnStart = SECONDS()
>	FOR lnRun = 1 TO m.lnCount
>		= partst7(m.lcStr, m.lcStr, m.lcStr, m.lcStr, m.lcStr, m.lcStr, m.lcStr)
>	NEXT
>	= timeIt(m.lnStart)
>
>	lnStart = SECONDS()
>	FOR lnRun = 1 TO m.lnCount
>		= partst7(m.lnAsc, m.lnAsc, m.lnAsc, m.lnAsc, m.lnAsc, m.lnAsc, m.lnAsc)
>	NEXT
>	= timeIt(m.lnStart)
>	?
>NEXT
>
>
>FUNCTION partst(tux)
>FUNCTION partst7(tux1,tux2,tux3,tux4,tux5,tux6,tux7)
>FUNCTION timeit(tnStart)
>?? STR((SECONDS()-m.tnStart)*1000)

>
>>Well, for my tests I can run them with tables opened and without.
>Good start.
>
>regards
>
>thomas