
**__RI_HEADER!@ Do NOT REMOVE or MODIFY this line!!!! @!__RI_HEADER**
procedure RIDELETE
local llRetVal
llRetVal=.t.
 IF (ISRLOCKED() and !deleted()) OR !RLOCK()
    llRetVal=.F.
  ELSE
    IF !deleted()
      DELETE
      IF CURSORGETPROP('BUFFERING') > 1
      	=TABLEUPDATE()
      ENDIF
      llRetVal=pnerror=0
    ENDIF not already deleted
  ENDIF
  UNLOCK RECORD (RECNO())
RETURN llRetVal

procedure RIUPDATE
lparameters tcFieldName,tcNewValue,tcCascadeParent
local llRetVal
llRetVal=.t.
 IF ISRLOCKED() OR !RLOCK()
    llRetVal=.F.
  ELSE
    IF EVAL(tcFieldName)<>tcNewValue
      PRIVATE pcCascadeParent
      pcCascadeParent=upper(iif(type("tcCascadeParent")<>"C","",tcCascadeParent))
      REPLACE (tcFieldName) WITH tcNewValue
      IF CURSORGETPROP('BUFFERING') > 1
      	=TABLEUPDATE()
      ENDIF
      llRetVal=pnerror=0
    ENDIF values don't already match
  ENDIF it's locked already, or I was able to lock it
  UNLOCK RECORD (RECNO())
return llRetVal

procedure rierror
parameters tnErrNo,tcMessage,tcCode,tcProgram
local lnErrorRows,lnXX
lnErrorRows=alen(gaErrors,1)
if type('gaErrors[lnErrorRows,1]')<>"L"
  dimension gaErrors[lnErrorRows+1,alen(gaErrors,2)]
  lnErrorRows=lnErrorRows+1
endif
gaErrors[lnErrorRows,1]=tnErrNo
gaErrors[lnErrorRows,2]=tcMessage
gaErrors[lnErrorRows,3]=tcCode
gaErrors[lnErrorRows,4]=""
lnXX=1
do while !empty(program(lnXX))
  gaErrors[lnErrorRows,4]=gaErrors[lnErrorRows,4]+","+;
  program(lnXX)
  lnXX=lnXX+1
enddo
gaErrors[lnErrorRows,5]=pcParentDBF
gaErrors[lnErrorRows,6]=pnParentRec
gaErrors[lnErrorRows,7]=pcParentID
gaErrors[lnErrorRows,8]=pcParentExpr
gaErrors[lnErrorRows,9]=pcChildDBF
gaErrors[lnErrorRows,10]=pnChildRec
gaErrors[lnErrorRows,11]=pcChildID
gaErrors[lnErrorRows,12]=pcChildExpr
return tnErrNo


PROCEDURE riopen
PARAMETERS tcTable,tcOrder
local lcCurWkArea,lcNewWkArea,lnInUseSpot
lnInUseSpot=atc(tcTable+"*",pcRIcursors)
IF lnInUseSpot=0
  lcCurWkArea=select()
  SELECT 0
  lcNewWkArea=select()
  IF NOT EMPTY(tcOrder)
    USE (tcTable) AGAIN ORDER (tcOrder) ;
      ALIAS ("__ri"+LTRIM(STR(SELECT()))) share
  ELSE
    USE (tcTable) AGAIN ALIAS ("__ri"+LTRIM(STR(SELECT()))) share
  ENDIF
  if pnerror=0
    pcRIcursors=pcRIcursors+upper(tcTable)+"?"+STR(SELECT(),5)
  else
    lcNewWkArea=0
  endif something bad happened while attempting to open the file
ELSE
  lcNewWkArea=val(substr(pcRIcursors,lnInUseSpot+len(tcTable)+1,5))
  pcRIcursors = strtran(pcRIcursors,upper(tcTable)+"*"+str(lcNewWkArea,5),;
    upper(tcTable)+"?"+str(lcNewWkArea,5))
  IF NOT EMPTY(tcOrder)
    SET ORDER TO (tcOrder) IN (lcNewWkArea)
  ENDIF sent an order
  if pnerror<>0
    lcNewWkArea=0
  endif something bad happened while setting order
ENDIF
RETURN (lcNewWkArea)


PROCEDURE riend
PARAMETERS tlSuccess
local lnXX,lnSpot,lcWorkArea
IF tlSuccess
  END TRANSACTION
ELSE
  SET DELETED OFF
  ROLLBACK
  SET DELETED ON
ENDIF
IF EMPTY(pcRIolderror)
  ON ERROR
ELSE
  ON ERROR &pcRIolderror.
ENDIF
FOR lnXX=1 TO occurs("*",pcRIcursors)
  lnSpot=atc("*",pcRIcursors,lnXX)+1
  USE IN (VAL(substr(pcRIcursors,lnSpot,5)))
ENDFOR
IF pcOldCompat = "ON"
	SET COMPATIBLE ON
ENDIF
IF pcOldDele="OFF"
  SET DELETED OFF
ENDIF
IF pcOldExact="ON"
  SET EXACT ON
ENDIF
IF pcOldTalk="ON"
  SET TALK ON
ENDIF
do case
  case empty(pcOldDBC)
    set data to
  case pcOldDBC<>DBC()
    set data to (pcOldDBC)
endcase
RETURN .T.


PROCEDURE rireuse
* rireuse.prg
PARAMETERS tcTableName,tcWkArea
pcRIcursors = strtran(pcRIcursors,upper(tcTableName)+"?"+str(tcWkArea,5),;
  upper(tcTableName)+"*"+str(tcWkArea,5))
RETURN .t.

********************************************************************************
** "参照完整性删除触发器" 考题1
PROCEDURE __RI_DELETE_考题1
LOCAL llRetVal
llRetVal = .t.
PRIVATE pcParentDBF,pnParentRec,pcChildDBF,pnChildRec,pcParentID,pcChildID
PRIVATE pcParentExpr,pcChildExpr
STORE "" TO pcParentDBF,pcChildDBF,pcParentID,pcChildID,pcParentExpr,pcChildExpr
STORE 0 TO pnParentRec,pnChildRec
IF _triggerlevel=1
  BEGIN TRANSACTION
  PRIVATE pcRIcursors,pcRIwkareas,pcRIolderror,pnerror,;
  pcOldDele,pcOldExact,pcOldTalk,pcOldCompat,PcOldDBC
  pcOldTalk=SET("TALK")
  SET TALK OFF
  pcOldDele=SET("DELETED")
  pcOldExact=SET("EXACT")
  pcOldCompat=SET("COMPATIBLE")
  SET COMPATIBLE OFF
  SET DELETED ON
  SET EXACT OFF
  pcRIcursors=""
  pcRIwkareas=""
  pcRIolderror=ON("error")
  pnerror=0
  ON ERROR pnerror=rierror(ERROR(),message(),message(1),program())
  IF TYPE('gaErrors(1)')<>"U"
    release gaErrors
  ENDIF
  PUBLIC gaErrors(1,12)
  pcOldDBC=DBC()
  SET DATA TO ("模拟库")
ENDIF first trigger
LOCAL lcParentID && parent's value to be sought in child
LOCAL lcChildWkArea && child work area handle returned by riopen
LOCAL lcParentWkArea
LOCAL llDelHeaderarea
lcStartArea=select()
llRetVal=.t.
lcParentWkArea=select()
SELECT (lcParentWkArea)
pcParentDBF=dbf()
pnParentRec=recno()
STORE 题号 TO lcParentID,pcParentID
pcParentExpr="题号"
lcChildWkArea=riopen("考题2","题号")
IF lcChildWkArea<=0
  IF _triggerlevel=1
    DO riend WITH .F.
  ENDIF at the end of the highest trigger level
  RETURN .F.
ENDIF not able to open the child work area
pcChildDBF=dbf(lcChildWkArea)
SELECT (lcChildWkArea)
SEEK lcParentID
SCAN WHILE 题号=lcParentID AND llRetVal
  pnChildRec=recno()
  pcChildID=题号
  pcChildExpr="题号"
  llRetVal=ridelete()
ENDSCAN get all of the 考题2 records
=rireuse("考题2",lcChildWkArea)
IF NOT llRetVal
  IF _triggerlevel=1
    DO riend WITH llRetVal
  ENDIF at the end of the highest trigger level
  SELECT (lcStartArea)
  RETURN llRetVal
ENDIF
IF _triggerlevel=1
  do riend with llRetVal
ENDIF at the end of the highest trigger level
SELECT (lcStartArea)
RETURN llRetVal
** "结束参照完整性删除触发器" 考题1
********************************************************************************

********************************************************************************
procedure __RI_UPDATE_考题1
** "参照完整性更新触发器" 考题1
LOCAL llRetVal
llRetVal = .t.
PRIVATE pcParentDBF,pnParentRec,pcChildDBF,pnChildRec,pcParentID,pcChildID
PRIVATE pcParentExpr,pcChildExpr
STORE "" TO pcParentDBF,pcChildDBF,pcParentID,pcChildID,pcParentExpr,pcChildExpr
STORE 0 TO pnParentRec,pnChildRec
IF _triggerlevel=1
  BEGIN TRANSACTION
  PRIVATE pcRIcursors,pcRIwkareas,pcRIolderror,pnerror,;
  pcOldDele,pcOldExact,pcOldTalk,pcOldCompat,PcOldDBC
  pcOldTalk=SET("TALK")
  SET TALK OFF
  pcOldDele=SET("DELETED")
  pcOldExact=SET("EXACT")
  pcOldCompat=SET("COMPATIBLE")
  SET COMPATIBLE OFF
  SET DELETED ON
  SET EXACT OFF
  pcRIcursors=""
  pcRIwkareas=""
  pcRIolderror=ON("error")
  pnerror=0
  ON ERROR pnerror=rierror(ERROR(),message(),message(1),program())
  IF TYPE('gaErrors(1)')<>"U"
    release gaErrors
  ENDIF
  PUBLIC gaErrors(1,12)
  pcOldDBC=DBC()
  SET DATA TO ("模拟库")
ENDIF first trigger
LOCAL lcParentID && parent's value to be sought in child
LOCAL lcOldParentID && previous parent id value
LOCAL lcChildWkArea && child work area handle returned by riopen
LOCAL lcChildID && child's value to be sought in parent
LOCAL lcOldChildID && old child id value
LOCAL lcParentWkArea && parentwork area handle returned by riopen
LOCAL lcStartArea
lcStartArea=select()
llRetVal=.t.
lcParentWkArea=select()
SELECT (lcParentWkArea)
pcParentDBF=dbf()
pnParentRec=recno()
lcOldParentID=OLDVAL("题号")
pcParentID=lcOldParentID
pcParentExpr="题号"
lcParentID=题号
IF lcParentID<>lcOldParentID
  lcChildWkArea=riopen("考题2")
  IF lcChildWkArea<=0
    IF _triggerlevel=1
      DO riend WITH .F.
    ENDIF at the end of the highest trigger level
    SELECT (lcStartArea)
    RETURN .F.
  ENDIF not able to open the child work area
  pcChildDBF=dbf(lcChildWkArea)
  SELECT (lcChildWkArea)
  SCAN FOR 题号=lcOldParentID
    pnChildRec=recno()
    pcChildID=题号
    pcChildExpr="题号"
    IF NOT llRetVal
      EXIT
    ENDIF && not llretval
    llRetVal=riupdate("题号",lcParentID,"考题1")
  ENDSCAN get all of the 考题2 records
  =rireuse("考题2",lcChildWkArea)
  IF NOT llRetVal
    IF _triggerlevel=1
      DO riend WITH llRetVal
    ENDIF at the end of the highest trigger level
    SELECT (lcStartArea)
    RETURN llRetVal
  ENDIF
ENDIF this parent id changed
IF _triggerlevel=1
  do riend with llRetVal
ENDIF at the end of the highest trigger level
SELECT (lcStartArea)
RETURN llRetVal
** "结束参照完整性更新触发器" 考题1
********************************************************************************

********************************************************************************
procedure __RI_UPDATE_考题2
** "参照完整性更新触发器" 考题2
LOCAL llRetVal
llRetVal = .t.
PRIVATE pcParentDBF,pnParentRec,pcChildDBF,pnChildRec,pcParentID,pcChildID
PRIVATE pcParentExpr,pcChildExpr
STORE "" TO pcParentDBF,pcChildDBF,pcParentID,pcChildID,pcParentExpr,pcChildExpr
STORE 0 TO pnParentRec,pnChildRec
IF _triggerlevel=1
  BEGIN TRANSACTION
  PRIVATE pcRIcursors,pcRIwkareas,pcRIolderror,pnerror,;
  pcOldDele,pcOldExact,pcOldTalk,pcOldCompat,PcOldDBC
  pcOldTalk=SET("TALK")
  SET TALK OFF
  pcOldDele=SET("DELETED")
  pcOldExact=SET("EXACT")
  pcOldCompat=SET("COMPATIBLE")
  SET COMPATIBLE OFF
  SET DELETED ON
  SET EXACT OFF
  pcRIcursors=""
  pcRIwkareas=""
  pcRIolderror=ON("error")
  pnerror=0
  ON ERROR pnerror=rierror(ERROR(),message(),message(1),program())
  IF TYPE('gaErrors(1)')<>"U"
    release gaErrors
  ENDIF
  PUBLIC gaErrors(1,12)
  pcOldDBC=DBC()
  SET DATA TO ("模拟库")
ENDIF first trigger
LOCAL lcParentID && parent's value to be sought in child
LOCAL lcOldParentID && previous parent id value
LOCAL lcChildWkArea && child work area handle returned by riopen
LOCAL lcChildID && child's value to be sought in parent
LOCAL lcOldChildID && old child id value
LOCAL lcParentWkArea && parentwork area handle returned by riopen
LOCAL lcStartArea
lcStartArea=select()
llRetVal=.t.
lcChildWkArea=select()
IF _triggerlevel=1 or type("pccascadeparent")#"C" or (NOT pccascadeparent=="考题1")
  SELECT (lcChildWkArea)
  lcChildID=题号
  lcOldChildID=oldval("题号")
  pcChildDBF=dbf(lcChildWkArea)
  pnChildRec=recno(lcChildWkArea)
  pcChildID=lcOldChildID
  pcChildExpr="题号"
  IF lcChildID<>lcOldChildID
    lcParentWkArea=riopen("考题1","题号")
    IF lcParentWkArea<=0
      IF _triggerlevel=1
        DO riend WITH .F.
      ENDIF at the end of the highest trigger level
      SELECT (lcStartArea)
      RETURN .F.
    ENDIF not able to open the child work area
    pcParentDBF=dbf(lcParentWkArea)
    llRetVal=SEEK(lcChildID,lcParentWkArea)
    pnParentRec=recno(lcParentWkArea)
    =rireuse("考题1",lcParentWkArea)
    IF NOT llRetVal
      DO rierror with -1,"违反插入限制规则。","",""
      IF _triggerlevel=1
        DO riend WITH llRetVal
      ENDIF at the end of the highest trigger level
      SELECT (lcStartArea)
      RETURN llRetVal
    ENDIF no parent
  ENDIF this value was changed
ENDIF not part of a cascade from "考题1"
lcParentWkArea=lcChildWkArea
IF _triggerlevel=1
  do riend with llRetVal
ENDIF at the end of the highest trigger level
SELECT (lcStartArea)
RETURN llRetVal
** "结束参照完整性更新触发器" 考题2
********************************************************************************

********************************************************************************
** "参照完整性插入触发器" 考题2
PROCEDURE __RI_INSERT_考题2
LOCAL llRetVal
llRetVal = .t.
PRIVATE pcParentDBF,pnParentRec,pcChildDBF,pnChildRec,pcParentID,pcChildID
PRIVATE pcParentExpr,pcChildExpr
STORE "" TO pcParentDBF,pcChildDBF,pcParentID,pcChildID,pcParentExpr,pcChildExpr
STORE 0 TO pnParentRec,pnChildRec
IF _triggerlevel=1
  BEGIN TRANSACTION
  PRIVATE pcRIcursors,pcRIwkareas,pcRIolderror,pnerror,;
  pcOldDele,pcOldExact,pcOldTalk,pcOldCompat,PcOldDBC
  pcOldTalk=SET("TALK")
  SET TALK OFF
  pcOldDele=SET("DELETED")
  pcOldExact=SET("EXACT")
  pcOldCompat=SET("COMPATIBLE")
  SET COMPATIBLE OFF
  SET DELETED ON
  SET EXACT OFF
  pcRIcursors=""
  pcRIwkareas=""
  pcRIolderror=ON("error")
  pnerror=0
  ON ERROR pnerror=rierror(ERROR(),message(),message(1),program())
  IF TYPE('gaErrors(1)')<>"U"
    release gaErrors
  ENDIF
  PUBLIC gaErrors(1,12)
  pcOldDBC=DBC()
  SET DATA TO ("模拟库")
ENDIF first trigger
LOCAL lcChildID && child's value to be sought in parent
LOCAL lcParentWkArea && parentwork area handle returned by riopen
LOCAL lcChildWkArea && child's work area
LOCAL lcStartArea
lcStartArea=select()
llRetVal=.t.
lcChildWkArea=SELECT()
SELECT (lcChildWkArea)
lcChildID=题号
pcChildDBF=dbf(lcChildWkArea)
pnChildRec=recno(lcChildWkArea)
pcChildID=lcChildID
pcChildExpr="题号"
lcParentWkArea=riopen("考题1","题号")
IF lcParentWkArea<=0
  IF _triggerlevel=1
    DO riend WITH .F.
  ENDIF at the end of the highest trigger level
  SELECT (lcStartArea)
  RETURN .F.
ENDIF not able to open the child work area
pcParentDBF=dbf(lcParentWkArea)
llRetVal=SEEK(lcChildID,lcParentWkArea)
pnParentRec=recno(lcParentWkArea)
=rireuse("考题1",lcParentWkArea)
IF NOT llRetVal
  DO rierror with -1,"违反插入限制规则。","",""
  IF _triggerlevel=1
    DO riend WITH llRetVal
  ENDIF at the end of the highest trigger level
  SELECT (lcStartArea)
  RETURN llRetVal
ENDIF
IF _triggerlevel=1
  do riend with llRetVal
ENDIF at the end of the highest trigger level
SELECT (lcStartArea)
RETURN llRetVal
** "结束参照完整性插入触发器" 考题2
********************************************************************************
**__RI_FOOTER!@ Do NOT REMOVE or MODIFY this line!!!! @!__RI_FOOTER**
