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

📄 risp.old

📁 VC数据库编程综合应用。订单的管理
💻 OLD
📖 第 1 页 / 共 3 页
字号:

********************************************************************************
procedure __RI_UPDATE_客户资料
** "Referential integrity update trigger for" 客户资料
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=="商品库")
  SELECT (lcChildWkArea)
  lcChildID=商品代码
  lcOldChildID=oldval("商品代码")
  pcChildDBF=dbf(lcChildWkArea)
  pnChildRec=recno(lcChildWkArea)
  pcChildID=lcOldChildID
  pcChildExpr="商品代码"
  IF lcChildID<>lcOldChildID
    lcParentWkArea=riopen("商品库","商品代码")
    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("商品库",lcParentWkArea)
    IF NOT llRetVal
      DO rierror with -1,"Insert restrict rule violated.","",""
      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 "商品库"
IF _triggerlevel=1 or type("pccascadeparent")#"C" or (NOT pccascadeparent=="品牌库")
  SELECT (lcChildWkArea)
  lcChildID=品牌代码
  lcOldChildID=oldval("品牌代码")
  pcChildDBF=dbf(lcChildWkArea)
  pnChildRec=recno(lcChildWkArea)
  pcChildID=lcOldChildID
  pcChildExpr="品牌代码"
  IF lcChildID<>lcOldChildID
    lcParentWkArea=riopen("品牌库","品牌代码")
    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("品牌库",lcParentWkArea)
    IF NOT llRetVal
      DO rierror with -1,"Insert restrict rule violated.","",""
      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 "品牌库"
IF _triggerlevel=1 or type("pccascadeparent")#"C" or (NOT pccascadeparent=="机型库")
  SELECT (lcChildWkArea)
  lcChildID=机型代码
  lcOldChildID=oldval("机型代码")
  pcChildDBF=dbf(lcChildWkArea)
  pnChildRec=recno(lcChildWkArea)
  pcChildID=lcOldChildID
  pcChildExpr="机型代码"
  IF lcChildID<>lcOldChildID
    lcParentWkArea=riopen("机型库","机型代码")
    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("机型库",lcParentWkArea)
    IF NOT llRetVal
      DO rierror with -1,"Insert restrict rule violated.","",""
      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 "机型库"
lcParentWkArea=lcChildWkArea
IF _triggerlevel=1
  do riend with llRetVal
ENDIF at the end of the highest trigger level
SELECT (lcStartArea)
RETURN llRetVal
** "End of Referential integrity Update trigger for" 客户资料
********************************************************************************

********************************************************************************
** "Referential integrity insert trigger for" 客户资料
PROCEDURE __RI_INSERT_客户资料
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("商品库","商品代码")
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("商品库",lcParentWkArea)
IF NOT llRetVal
  DO rierror with -1,"Insert restrict rule violated.","",""
  IF _triggerlevel=1
    DO riend WITH llRetVal
  ENDIF at the end of the highest trigger level
  SELECT (lcStartArea)
  RETURN llRetVal
ENDIF
SELECT (lcChildWkArea)
lcChildID=品牌代码
pcChildDBF=dbf(lcChildWkArea)
pnChildRec=recno(lcChildWkArea)
pcChildID=lcChildID
pcChildExpr="品牌代码"
lcParentWkArea=riopen("品牌库","品牌代码")
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("品牌库",lcParentWkArea)
IF NOT llRetVal
  DO rierror with -1,"Insert restrict rule violated.","",""
  IF _triggerlevel=1
    DO riend WITH llRetVal
  ENDIF at the end of the highest trigger level
  SELECT (lcStartArea)
  RETURN llRetVal
ENDIF
SELECT (lcChildWkArea)
lcChildID=机型代码
pcChildDBF=dbf(lcChildWkArea)
pnChildRec=recno(lcChildWkArea)
pcChildID=lcChildID
pcChildExpr="机型代码"
lcParentWkArea=riopen("机型库","机型代码")
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("机型库",lcParentWkArea)
IF NOT llRetVal
  DO rierror with -1,"Insert restrict rule violated.","",""
  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
** "End of Referential integrity insert trigger for" 客户资料
********************************************************************************

********************************************************************************
** "Referential integrity delete trigger for" 品牌库
PROCEDURE __RI_DELETE_品牌库
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("机型库","品牌代码")
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)
llRetVal=!SEEK(lcParentID,lcChildWkArea)
SELECT (lcChildWkArea)
pnChildRec=recno()
pcChildID=品牌代码
pcChildExpr="品牌代码"
IF !llRetVal
  DO rierror with -1,"Delete restrict rule violated.","",""
ENDIF
=rireuse("机型库",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
SELECT (lcParentWkArea)
pcParentDBF=dbf()
pnParentRec=recno()
STORE 品牌代码 TO lcParentID,pcParentID
pcParentExpr="品牌代码"
lcChildWkArea=riopen("客户资料","品牌代码")
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)
llRetVal=!SEEK(lcParentID,lcChildWkArea)
SELECT (lcChildWkArea)
pnChildRec=recno()
pcChildID=品牌代码
pcChildExpr="品牌代码"
IF !llRetVal
  DO rierror with -1,"Delete restrict rule violated.","",""
ENDIF
=rireuse("客户资料",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
** "End of Referential integrity Delete trigger for" 品牌库
********************************************************************************

********************************************************************************
procedure __RI_UPDATE_品牌库
** "Referential integrity update trigger for" 品牌库
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

⌨️ 快捷键说明

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