IF NOT SEEK(m.lcTrans_Employees_Queues_pk,"updSchedules", "CEMPQUE_FK")
           TRY           
            INSERT INTO updSchedules (cTrans_Employees_Queues_fk, cDiary_Code_fk, tScheduled_Time, iActive_At_Day_Start_Flag) ;
                VALUES ;
                (m.lcTrans_Employees_Queues_pk, .NULL., m.ttTime, 1)
            CATCH
               llFailure = .T.               
            ENDTRY
                
        ELSE
* This account is already scheduled - should not happen
            lcError = "The account " + m.lcTrans_Employees_Queues_pk + " is already scheduled!"
        ENDIF

CREATE TABLE table1 (DateCreate T)

Function _trigger_test
Return .F.
ENDFUNC

try
    Insert into table3 (datecreate) values (Datetime())
catch
    ?'error'
endtry

Function _trigger_test
Try
    Return .F.
Catch
    Return .F.
EndTry
ENDFUNC

Function _trigger_test
Local llSuccess
llSuccess = .F.
Try
    Error 12
    llSuccess = .T.
Catch
    llSuccess = .F.
EndTry
Return m.llSuccess
ENDFUNC

Function _trigger_test  
Try  
    Return .T.  
Catch  
    Return .F.  
EndTry  
ENDFUNC

Try
    RETURN
Catch
    ?'error'
EndTry

**__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.:

* 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(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, ;
    laUsed[1], ;
    lcExact, ;
    lcANSI, ;
    lcDeleted, ;
    lcError, ;
    lcOldDBC, ;
    lcDBC, ;
    laRelations[1], ;
    lnRelations, ;
    lcRIInfo, ;
    lcParent, ;
    lcChild, ;
    lcParentKeyExp, ;
    lcChildKeyExp, ;
    luOldKey, ;
    luNewKey, ;
    luOldFK, ;
    luNewFK, ;
    laTables[1], ;
    lnTables

* Define some constants that'll make the code easier to read.

#define cnCHILDCOL                   1
* The column in the relations array for the child table
#define cnPARENTCOL                   2
* The column in the relations array for the parent table
#define cnCHILDKEYCOL               3
* The column in the relations array for the child tag
#define cnPARENTKEYCOL               4
* The column in the relations array for the parent tag
#define cnRIINFOCOL                   5
* The column in the relations array for the RI information
#define cnRIINFO_UPDATE               1
* The position in the RI information for the update rule
#define cnRIINFO_DELETE               2
* The position in the RI information for the delete rule
#define cnRIINFO_INSERT               3
* The position in the RI information for the insert rule
#define ccFLDSTATE_UNCHANGED       '1'
* GETFLDSTATE() 1 = the field is unchanged
#define ccFLDSTATE_EDITDEL           '2'
* GETFLDSTATE() 2 = the record was edited or deletion status changed
#define ccFLDSTATE_NEWUNCHANGED       '3'
* GETFLDSTATE() 3 = a new unchanged field or new undeleted record
#define ccFLDSTATE_NEWCHANGED       '4'
* GETFLDSTATE() 3 = a new changed field or new deleted record
#define cnERR_TRIGGER_FAILED    1539
* Trigger failed error number

* 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)

do case

* If the trigger was passed, use it.

case vartype(m.tcTriggerType) = 'C' and not empty(m.tcTriggerType)
    lcTriggerType = upper(m.tcTriggerType)

* If the deletion status was changed and the record is deleted, this is a
* "DELETE" trigger.

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


* 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
    begin transaction
    private plError
    plError = .f.
    release gaErrors
    public gaErrors[1, 12]
    aused(laUsed)
    lcExact   = set('EXACT')
    lcANSI    = set('ANSI')
    lcDeleted = set('DELETED')
    lcError   = on('ERROR')
    set exact on
    set ansi on
    set deleted on
    on error LogRIError(error(),message()) &&plError = .t.
endif

if vartype(m.plError) = "L" and m.plError
** Error occurred
else
* Select the database the table belongs to and get an array of relations.

    lcOldDBC = iif(empty(dbc()), '', '"' + dbc() + '"')
    lcDBC    = cursorgetprop('Database')
    set database to (m.lcDBC)
    lnRelations = adbobjects(laRelations, 'RELATION')

    local lnTParent, lnTChild, lnI, lcChildTag, lcParentTag
    store 0 to lnTParent, lnTChild
    store "" to lcParentKeyExp, lcChildKeyExp

** First search in the parent column
    lnTParent = ascan(laRelations, m.lcTable, m.lnTParent  + 1, ;
        m.lnRelations , cnPARENTCOL, 8)

    do while between(m.lnTParent,1,m.lnRelations)  and not m.plError
        lnI = m.lnTParent

        lcParent = laRelations[m.lnI, cnPARENTCOL]
        lcChild  = laRelations[m.lnI, cnCHILDCOL]
        lcRules  = upper(laRelations[m.lnI, cnRIINFOCOL])

        lcParentTag  = laRelations[m.lnI, cnPARENTKEYCOL]

        lcChildTag  = laRelations[m.lnI, cnCHILDKEYCOL]

        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' and m.lcParent = m.lcTable
            lcRIInfo = substr(m.lcRules, cnRIINFO_UPDATE, 1)
            if not empty(m.lcRIInfo) and m.lcRIInfo <> 'I'
                lcParentKeyExp = key(tagno(laRelations[m.lnI, cnPARENTKEYCOL], ;
                    '', m.lcAlias), m.lcAlias)
                lcChildKeyExp  = GetKeyIndexExp(m.lcChild, ;
                    laRelations[m.lnI, cnCHILDKEYCOL])
                luOldKey       = oldval(m.lcParentKeyExp)
                luNewKey       = evaluate(m.lcParentKeyExp)

* 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 == m.lcChild
                    luOldFK = oldval(m.lcChildKeyExp)
                    luNewFK = evaluate(m.lcChildKeyExp)
                    if m.luOldFK <> m.luNewFK and ;
                            substr(m.lcRules, cnRIINFO_INSERT, 1) = 'R'
                        Restrict_Insert(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
                            m.lcChildKeyExp, m.luNewFK, m.lcTriggerType, m.lcParentTag )
                    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.lcRIInfo = 'C'
                    Cascade_Update(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
                        m.lcChildKeyExp, m.luOldKey, m.luNewKey)
                case m.lcRIInfo = 'R'
                    Restrict_Update(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
                        m.lcChildKeyExp, m.luOldKey, m.luNewKey, m.lcChildTag)
                endcase
            endif not empty(lcRIInfo) ...

* 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' and m.lcParent == m.lcTable
            lcRIInfo = substr(m.lcRules, cnRIINFO_DELETE, 1)
            if not empty(m.lcRIInfo) and m.lcRIInfo <> 'I'
                lcParentKeyExp = key(tagno(laRelations[m.lnI, cnPARENTKEYCOL], ;
                    '', m.lcAlias), m.lcAlias)
                lcChildKeyExp  = GetKeyIndexExp(m.lcChild, ;
                    laRelations[m.lnI, cnCHILDKEYCOL])
                luKey          = evaluate(m.lcParentKeyExp)

* Call the appropriate function, depending on whether this is a cascade or
* restrict rule.

                do case
                case m.lcRIInfo = 'C'
                    Cascade_Delete(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
                        m.lcChildKeyExp, m.luKey)
                case m.lcRIInfo = 'R'
                    Restrict_Delete(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
                        m.lcChildKeyExp, m.luKey, m.lcChildTag)
                endcase
            endif not empty(lcRIInfo) ...
        endcase

        lnTParent = ascan(laRelations, m.lcTable, m.lnI + 1, ;
            m.lnRelations - (m.lnI + 1), cnPARENTCOL, 8)
    enddo

** Now do the same for the child column
    lnTChild = ascan(laRelations, m.lcTable, m.lnTChild  + 1, m.lnRelations , cnCHILDCOL, 8)

    do while m.lnTChild > 0  and not m.plError
        lnI = m.lnTChild
        lcParent = laRelations[m.lnI, cnPARENTCOL]
        lcChild  = laRelations[m.lnI, cnCHILDCOL]
        lcRules  = upper(laRelations[m.lnI, cnRIINFOCOL])

        lcParentTag  = laRelations[m.lnI, cnPARENTKEYCOL]

        lcChildTag  = laRelations[m.lnI, cnCHILDKEYCOL]

* 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.

*case lcChild = lcTable
        lcRIInfo = substr(m.lcRules, cnRIINFO_INSERT, 1)
        if m.lcRIInfo = 'R'
            lcParentKeyExp = GetKeyIndexExp(m.lcParent, ;
                laRelations[m.lnI, cnPARENTKEYCOL])
            lcChildKeyExp  = key(tagno(laRelations[m.lnI, cnCHILDKEYCOL], ;
                '', m.lcAlias), m.lcAlias)
            luKey          = evaluate(m.lcChildKeyExp)

* 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 <> 'UPDATE' or oldval(m.lcChildKeyExp) <> m.luKey
                Restrict_Insert(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
                    m.lcChildKeyExp, m.luKey, m.lcTriggerType, m.lcParentTag)
            endif lcTriggerType <> 'UPDATE' ...
        endif lcRIInfo = 'R'
        lnTChild = ascan(laRelations, m.lcTable, m.lnI + 1, ;
            m.lnRelations - (m.lnI + 1), cnCHILDCOL, 8)
    enddo

* 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.
endif
if not empty(m.lcOldDBC)
    set database to (m.lcOldDBC)
endif
if _triggerlevel = 1
    if m.plError
        rollback
    else
        end transaction
    endif plError
    lnTables = aused(laTables)
    for lnI = 1 to m.lnTables
        lcTable = laTables[m.lnI, 1]
        if not empty(m.lcTable) and ascan(laUsed, m.lcTable) = 0
            use in (m.lcTable)
        endif not empty(lcTable) ...
    next lnI
    if m.lcExact = "OFF"
        set exact off
    endif
    if m.lcANSI = "OFF"
        set ansi off
    endif
    if m.lcDeleted = "OFF"
        set deleted off
    endif
    on error &lcError

* If we're not at the top trigger level, return .T. so we don't trigger an
* error yet.
else

endif _triggerlevel = 1
return not m.plError

* Determine the key expression for the specified tag.

function GetKeyIndexExp(tcTable, ;
    tcTag)
local lcTable, ;
    lcIndexExp
lcTable = strtran(m.tcTable, ' ', '_')
if not used(m.lcTable)
    use (m.tcTable) again in 0 shared alias (m.lcTable)
endif not used(lcTable)
lcIndexExp = key(tagno(m.tcTag, '', m.lcTable), m.lcTable)
return m.lcIndexExp

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

function Cascade_Update(tcParentTable, ;
    tcChildTable, ;
    tcParentKey, ;
    tcChildKey, ;
    tuOldKey, ;
    tuNewKey)
local laError[1]

* Do the cascading update. Log any error that occurred.
if isnull(m.tuOldKey )
    update (m.tcChildTable) ;
        set &tcChildKey = m.tuNewKey ;
        where &tcChildKey is null
else
    update (m.tcChildTable) ;
        set &tcChildKey = m.tuNewKey ;
        where &tcChildKey = m.tuOldKey
endif

if m.plError
    aerror(laError)
    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(tcParentTable, ;
    tcChildTable, ;
    tcParentKey, ;
    tcChildKey, ;
    tuOldKey, ;
    tuNewKey)
local laError[1]

if isnull(m.tuOldKey)
    delete ;
        from (m.tcChildTable) ;
        where &tcChildKey is null
else
    delete ;
        from (m.tcChildTable) ;
        where &tcChildKey = m.tuOldKey
endif
if m.plError
    aerror(laError)
    LogRIError(laError[1], laError[2], 'Cascade Delete', ;
        m.tcParentTable, iif(used(m.tcParentTable),recno(m.tcParentTable),0), ;
        m.tcParentKey, m.tuNewKey, ;
        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(tcParentTable, ;
    tcChildTable, ;
    tcParentKey, ;
    tcChildKey, ;
    tuKey, tcTag)
*local laCount[1]
local lcTable

if not isnull(m.tuKey)
    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
*!*   select count(*), ;
*!*       recno() ;
*!*       from (tcChildTable) ;
*!*       where &tcChildKey = tuKey ;
*!*       into array laCount
*!*   if _tally > 0
        plError = .t.
        LogRIError(cnERR_TRIGGER_FAILED, 'Trigger Failed', 'Restrict Delete', ;
            m.tcParentTable, iif(used(m.tcParentTable),recno(m.tcParentTable),0), ;
            m.tcParentKey, m.tuKey, ;
            m.tcChildTable, 0, m.tcChildKey, m.tuKey)
    endif _tally > 0
endif
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(tcParentTable, ;
    tcChildTable, ;
    tcParentKey, ;
    tcChildKey, ;
    tuOldKey, ;
    tuNewKey, tcTag)
*local laCount[1]
local lcTable

if not isnull(m.tuOldKey)
    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.tuOldKey, .f., m.lcTable, m.tcTag) && Record exists

*!*   select count(*), ;
*!*       recno() ;
*!*       from (tcChildTable) ;
*!*       where &tcChildKey = tuOldKey ;
*!*       into array laCount
*!*   if _tally > 0

        plError = .t.
        LogRIError(cnERR_TRIGGER_FAILED, 'Trigger Failed', 'Restrict Update', ;
            m.tcParentTable, iif(used(m.tcParentTable),recno(m.tcParentTable),0), ;
            m.tcParentKey, m.tuNewKey, ;
            m.tcChildTable, 0, m.tcChildKey, m.tuOldKey)
    endif _tally > 0
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 forign 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(tcParentTable, ;
    tcChildTable, ;
    tcParentKey, ;
    tcChildKey, ;
    tuKey, ;
    tcTriggerType, tcTag)
*local laCount[1]
local lcTable

* CFK - 5/28
* If the key is Null, don't check for a parent, let it pass.
if !isnull( m.tuKey )

* If no rows in the parent table match the foreign key, SELECT COUNT(*) will
* always return one row, so _TALLY = 1; SELECT COUNT(*), (more fields) will not
* return a row. Therefore, we need to check laCount[1] rather than _TALLY.

*!*       select count(*) ;
*!*           from (tcParentTable) ;
*!*           where &tcParentKey = tuKey ;
*!*           into array laCount
*!*       if laCount[1] = 0
    lcTable = strtran(m.tcParentTable, ' ', '_')

    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.tcTag)
        plError = .t.
        LogRIError(cnERR_TRIGGER_FAILED, 'Trigger Failed', 'Restrict ' + ;
            proper(m.tcTriggerType), m.tcParentTable, 0, m.tcParentKey, 'Not Found', ;
            m.tcChildTable, iif(used(m.tcChildTable),recno(m.tcChildTable),0), ;
            m.tcChildKey, m.tuKey)
    endif laCount[1] = 0
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**

LOCAL lcTypeTrigger
DO CASE
CASE Deleted()
    lcTypeTrigger="DELETE"    && триггер на удаление
CASE NVL(OldVal("Deleted()"),.T.)
    lcTypeTrigger="INSERT"    && триггер на вставку
OTHERWISE
    lcTypeTrigger="UPDATE"    && триггер на модификацию
ENDCASE

**__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(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, ;
    lcRIInfo, ;
    luOldKey, ;
    luNewKey, ;
    luOldFK, ;
    luNewFK
* 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)
#define cnERR_TRIGGER_FAILED 1539
*!*   local cnERR_TRIGGER_FAILED
*!*   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.
local llManualCleanUp, loSession
llManualCleanUp = .f.
if _triggerlevel = 1
    private plError
    plError = .f.
    release gaErrors
    public gaErrors[1, 12]
    llManualCleanUp = .t.
    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')
* 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.
    begin transaction
endif
if vartype(m.plError) = "L" and m.plError
** Error occurred
else
    pcOldDBC = iif(empty(dbc()), '', '"' + dbc() + '"')
    lcDBC    = cursorgetprop('Database')
    set database to (m.lcDBC)
    if not used('RIDefinitions')
        use RIDefinitions in 0 && Open table with RI Definitions
    endif
    local lcChildTag, 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
        lcChild  = alltrim(ChildTB)
        lcParentTag  = alltrim(ParentTag)
        lcChildTag  = alltrim(ChildTag)
        lcChildKeyExp = alltrim(ChildKey)
        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'
            lcRIInfo = UpdTrigger
            if not empty(m.lcRIInfo) and m.lcRIInfo <> 'I'
                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 == m.lcChild && very rare case
                    select (m.lcAlias)
                    luOldFK = oldval(m.lcChildKeyExp, m.lcAlias)
                    luNewFK = evaluate(m.lcChildKeyExp)
                    select RIDefinitions
                    if m.luOldFK <> m.luNewFK and ;
                            substr(m.lcRules, cnRIINFO_INSERT, 1) = 'R'
                        Restrict_Insert(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
                            m.lcChildKeyExp, m.luNewFK, m.lcTriggerType, m.lcParentTag )
                    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.lcRIInfo = 'C'
                    Cascade_Update(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
                        m.lcChildKeyExp, m.luOldKey, m.luNewKey)
                case m.lcRIInfo = 'R'
                    Restrict_Update(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
                        m.lcChildKeyExp, m.luOldKey, m.luNewKey, m.lcChildTag)
                endcase
            endif not empty(lcRIInfo) ...
* 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'
            lcRIInfo = DelTrigger
            if not empty(m.lcRIInfo) and m.lcRIInfo <> 'I'
                if not alltrim(ParentKey) == m.lcParentKeyExp && So it would calculate it only once
                    lcParentKeyExp = alltrim(ParentKey)
                    select (m.lcAlias)
                    luNewKey          = evaluate(m.lcParentKeyExp)
                    select RIDefinitions
                endif
* Call the appropriate function, depending on whether this is a cascade or
* restrict rule.
                do case
                case m.lcRIInfo = 'C'
                    Cascade_Delete(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
                        m.lcChildKeyExp, m.luNewKey)
                case m.lcRIInfo = 'R'
                    Restrict_Delete(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
                        m.lcChildKeyExp, m.luNewKey, m.lcChildTag)
                endcase
            endif not empty(lcRIInfo) ...
        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 not m.plError
            lcParent = alltrim(ParentTB)
            lcParentTag  = alltrim(ParentTag)
            lcChildTag  = alltrim(ChildTag)
            lcParentKeyExp = alltrim(ParentKey)
            if vartype(m.pcCascadeParent) = "C" and m.pcCascadeParent = m.lcParent
** 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.
                lcRIInfo = InsTrigger
                if m.lcRIInfo = 'R'
                    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.lcParent, m.lcChild, m.lcParentKeyExp, ;
                            m.lcChildKeyExp, m.luNewKey, m.lcTriggerType, m.lcParentTag)
                    endif lcTriggerType <> 'UPDATE' ...
                endif lcRIInfo = 'R'
            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
    if m.llManualCleanUp
        =RICleanUp(.f.)
    else
        if m.plError
            rollback
        else
            end transaction
        endif plError
    endif
* If we're not at the top trigger level, return .T. so we don't trigger an
* error yet.
endif _triggerlevel = 1
return not m.plError
* 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 && 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(tcParentTable, ;
    tcChildTable, ;
    tcParentKey, ;
    tcChildKey, ;
    tuOldKey, ;
    tuNewKey)
local laError[1]
private pcCascadeParent
pcCascadeParent = m.tcParentTable
* Do the cascading update. Log any error that occurred.
if not isnull(m.tuOldKey )
    update (m.tcChildTable) ;
        set &tcChildKey = m.tuNewKey ;
        where &tcChildKey = m.tuOldKey
endif
if m.plError
    aerror(laError)
    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(tcParentTable, ;
    tcChildTable, ;
    tcParentKey, ;
    tcChildKey, ;
    tuOldKey, ;
    tuNewKey)
local laError[1]
if not isnull(m.tuOldKey)
    delete ;
        from (m.tcChildTable) ;
        where &tcChildKey = m.tuOldKey
endif
if m.plError
    aerror(laError)
    LogRIError(laError[1], laError[2], 'Cascade Delete', ;
        m.tcParentTable, iif(used(m.tcParentTable),recno(m.tcParentTable),0), ;
        m.tcParentKey, m.tuNewKey, ;
        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(tcParentTable, ;
    tcChildTable, ;
    tcParentKey, ;
    tcChildKey, ;
    tuKey, tcTag)
local lcTable
if not isnull(m.tuKey)
    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.
        LogRIError(cnERR_TRIGGER_FAILED, 'Trigger Failed', 'Restrict Delete', ;
            m.tcParentTable, iif(used(m.tcParentTable),recno(m.tcParentTable),0), ;
            m.tcParentKey, m.tuKey, ;
            m.tcChildTable, 0, m.tcChildKey, m.tuKey)
    endif _tally > 0
endif
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(tcParentTable, ;
    tcChildTable, ;
    tcParentKey, ;
    tcChildKey, ;
    tuOldKey, ;
    tuNewKey, tcTag)
local lcTable
if not isnull(m.tuOldKey)
    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.tuOldKey, .f., m.lcTable, m.tcTag) && Record exists
*   if keymatch(m.tuOldKey,tagno(m.tcTag, '', m.lcTable), m.lcTable) && Record exists
        plError = .t.
        LogRIError(cnERR_TRIGGER_FAILED, 'Trigger Failed', 'Restrict Update', ;
            m.tcParentTable, iif(used(m.tcParentTable),recno(m.tcParentTable),0), ;
            m.tcParentKey, m.tuNewKey, ;
            m.tcChildTable, 0, m.tcChildKey, m.tuOldKey)
    endif _tally > 0
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(tcParentTable, ;
    tcChildTable, ;
    tcParentKey, ;
    tcChildKey, ;
    tuKey, ;
    tcTriggerType, tcTag)
local lcTable
* CFK - 5/28
* If the key is Null, don't check for a parent, let it pass.
if !isnull( m.tuKey )
    lcTable = strtran(m.tcParentTable, ' ', '_')
    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.tcTag)
*   if not keymatch(m.tuKey,tagno(m.tcTag, '', m.lcTable), m.lcTable) && Record doesn't exist
        plError = .t.
        LogRIError(cnERR_TRIGGER_FAILED, 'Trigger Failed', 'Restrict ' + ;
            proper(m.tcTriggerType), m.tcParentTable, 0, m.tcParentKey, 'Not Found', ;
            m.tcChildTable, iif(used(m.tcChildTable),recno(m.tcChildTable),0), ;
            m.tcChildKey, m.tuKey)
    endif laCount[1] = 0
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**