*-------------------------------------------------------------------------------------------------------------------------------------------------------- * (ES) AUTOGENERADO - ¡¡ATENCIÓN!! - ¡¡NO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! * (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! *-------------------------------------------------------------------------------------------------------------------------------------------------------- *< FOXBIN2PRG: Version="1.19" SourceFile="fb2p_dbc.dbc" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) * FB2P_DBC Comentario de los eventos o de la BDD??? 11 .T. eventsfile.prg REMOTE_CONNECTION_DBF Visual FoxPro Tables foxuser_fdb .F. .T. 15 .F. 1 .F. 0 4096 0 1 100 REMOTE_CONNECTION_ORACLE DRIVER={Oracle en OraClient11g_home1};SERVER=BDDServer;UID=BDDUser;PWD=BDDPwd;DBQ=CARTERA;DBA=W;APA=T;EXC=F;XSM=Default;FEN=T;QTO=T;FRC=10;FDL=10;LOB=T;RST=T;BTD=F;BNF=F;BAM=IfAllSuccessful;NUM=NLS;DPM=F;MTS=T;MDI=Me;CSR=F;FWC=F;FBS=60000;TLO=O;MLD=0;ODA .F. .T. 15 .F. 3 .F. 10 8192 180 1 100 FB2P_DEPTOComentario de "fb2p_depto"fb2p_depto.dbf__ri_delete_fb2p_depto()deptofb2p_depto_record_rule_validation()fb2p_depto_record_rule_validation_message() depto depto_field_comment"Depto."cl_optiongroupc:\desa\foxbin2prg\tests\datos_readonly\fb2p_test.vcx!XXXXXXXXXXdepto_field_validation_rule()depto_field_validation_message() descrip depto .T. descrip .F.
"Depto.Caption" Descripción
NOMBRELARGODELDBFComentario de la tabla "fb2p_dbf"fb2p_dbf.dbfdel_trg()__ri_insert_nombrelargodeldbf().AND.(ins_trg())__ri_update_nombrelargodeldbf().AND.(upd_trg())idedad>10"Mensaje de error de la regla edad > 10" nombre Comentario de "Nombre""."A!XXXXXXXXXXXXXXXXXXXXXXXXXXXXX.NOT.EMPTY(nombre)"El nombre está vacío" edad id bigtext depto id .T. edad_nd .F. notdeleted .F. edad .T. depto .F. nombre .F. i_nombre .F. Relation 1 NOMBRELARGODELDBF FB2P_DEPTO DEPTO DEPTO
"Nombre:"
RV_DB_DEBUG_SETUP STROSNC.DB_DEBUG_SETUP SELECT Db_debug_setup.PK_NAME, Db_debug_setup.ENABLED, Db_debug_setup.EVALUACION, Db_debug_setup.PK_METODO, Db_debug_setup.NIVELDEBUG, Db_debug_setup.F_DESDE, Db_debug_setup.F_HASTA, Db_debug_setup.DIRECCION_IP, Db_debug_setup.USUARIO FROM STROSNC.DB_DEBUG_SETUP Db_debug_setup ORDER BY Db_debug_setup.PK_NAME, Db_debug_setup.PK_METODO .T. 1 .T. remote_connection_Oracle .T. .T. 100 -1 .F. .T. .F. .T. 2 1 255 3 pk_name C(30) .F. .F. STROSNC.DB_DEBUG_SETUP.PK_NAME enabled N(3) .F. .F. STROSNC.DB_DEBUG_SETUP.ENABLED evaluacion M .F. .F. STROSNC.DB_DEBUG_SETUP.EVALUACION pk_metodo C(30) .F. .F. STROSNC.DB_DEBUG_SETUP.PK_METODO niveldebug N(3) .F. .F. STROSNC.DB_DEBUG_SETUP.NIVELDEBUG f_desde T .F. .F. STROSNC.DB_DEBUG_SETUP.F_DESDE f_hasta T .F. .F. STROSNC.DB_DEBUG_SETUP.F_HASTA direccion_ip C(30) .F. .F. STROSNC.DB_DEBUG_SETUP.DIRECCION_IP usuario C(30) .F. .F. STROSNC.DB_DEBUG_SETUP.USUARIO VISTA_LOCAL fb2p_dbc!nombrelargodeldbf SELECT Fb2p_depto.descrip, Nombrelargodeldbf.nombre, Nombrelargodeldbf.edad, Nombrelargodeldbf.id, Nombrelargodeldbf.depto FROM fb2p_dbc!fb2p_depto INNER JOIN fb2p_dbc!nombrelargodeldbf ON Fb2p_depto.depto = Nombrelargodeldbf.depto .F. 1 .T. .F. .T. 100 -1 .T. .F. .T. .F. 1 1 255 3 descrip C(50) .F. .F. fb2p_dbc!fb2p_depto.descrip nombre C(30) .F. .T. fb2p_dbc!nombrelargodeldbf.nombre edad N(3) .F. .T. fb2p_dbc!nombrelargodeldbf.edad id I .T. .F. fb2p_dbc!nombrelargodeldbf.id depto C(10) .F. .T. fb2p_dbc!nombrelargodeldbf.depto VW_ORA_CONVENIOS CONVENIOS SELECT CONVENIOS.ID_CONVENIO,CONVENIOS.NOMBRE_CONVENIO,CONVENIOS.HISTORICO FROM CONVENIOS .F. 1 .T. remote_connection_Oracle .F. .T. 100 -1 .T. .F. .F. .T. 2 1 255 3 id_convenio C(15) .F. .T. CONVENIOS.ID_CONVENIO nombre_convenio C(250) .F. .T. CONVENIOS.NOMBRE_CONVENIO historico C(1) .F. .T. CONVENIOS.HISTORICO VW_ORA_DUAL DUAL SELECT DUAL.DUMMY FROM DUAL .F. 1 .T. REMOTE_CONNECTION_ORACLE .F. .T. 100 -1 .T. .F. .F. .T. 2 1 255 3 dummy Dummy Dummy_field_comment C(1) Depto. cl_optiongroup fb2p_test.vcx ! XXXXXXXXXX .F. dummy_field_validation_rule() dummy_field_validation_message .T. DUAL.DUMMY 1 =TABLEUPDATE() ENDIF ENDIF NOT already DELETED ENDIF UNLOCK RECORD (RECNO()) llRetVal=pnerror=0 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 ENDIF VALUES don't already match ENDIF it's locked already, or I was able to lock it UNLOCK RECORD (RECNO()) llRetVal=pnerror=0 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,lnOccurs,lnOccurance lnInUseSpot=0 lnOccurs = OCCURS(UPPER(tcTable)+"*",UPPER(pcRIcursors)) FOR lnOccurance = 1 TO lnOccurs lnInUseSpot=ATC(tcTable+"*",pcRIcursors,lnOccurance) IF ISDIGIT(SUBSTR(pcRIcursors,lnInUseSpot-1,1)) OR; EMPTY(SUBSTR(pcRIcursors,lnInUseSpot-1,1)) EXIT ENDIF lnInUseSpot=0 ENDFOR 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. ******************************************************************************** ** "Referential integrity delete trigger for" fb2p_depto PROCEDURE __RI_DELETE_fb2p_depto 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 ("FB2P_DBC") 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 LOCAL lcStartArea lcStartArea=SELECT() llRetVal=.T. lcParentWkArea=SELECT() SELECT (lcParentWkArea) pcParentDBF=DBF() pnParentRec=RECNO() STORE DEPTO TO lcParentID,pcParentID pcParentExpr="DEPTO" lcChildWkArea=riopen("nombrelargodeldbf","depto") 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 DEPTO=lcParentID AND llRetVal pnChildRec=RECNO() pcChildID=DEPTO pcChildExpr="DEPTO" llRetVal=RIDELETE() ENDSCAN GET ALL OF the nombrelargodeldbf RECORDS =rireuse("nombrelargodeldbf",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" fb2p_depto ******************************************************************************** ******************************************************************************** PROCEDURE __RI_UPDATE_nombrelargodeldbf ** "Referential integrity update trigger for" nombrelargodeldbf 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 ("FB2P_DBC") 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=="FB2P_DEPTO") SELECT (lcChildWkArea) lcChildID=DEPTO lcOldChildID=OLDVAL("DEPTO") pcChildDBF=DBF(lcChildWkArea) pnChildRec=RECNO(lcChildWkArea) pcChildID=lcOldChildID pcChildExpr="DEPTO" IF ISNULL(lcChildID) OR ISNULL(lcOldChildID) OR lcChildID <> lcOldChildID lcParentWkArea=riopen("fb2p_depto","depto") 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) IF llRetVal AND NOT (ISRLOCKED(pnParentRec, lcParentWkArea) OR ; ISFLOCKED(lcParentWkArea)) IF RLOCK(lcParentWkArea) UNLOCK RECORD pnParentRec IN (lcParentWkArea) ELSE =rireuse("tparen",lcParentWkArea) pnerror = rierror(-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 ENDIF =rireuse("fb2p_depto",lcParentWkArea) IF NOT llRetVal pnerror = rierror(-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 "fb2p_depto" 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" nombrelargodeldbf ******************************************************************************** ******************************************************************************** ** "Referential integrity insert trigger for" nombrelargodeldbf PROCEDURE __RI_INSERT_nombrelargodeldbf 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 ("FB2P_DBC") 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=DEPTO pcChildDBF=DBF(lcChildWkArea) pnChildRec=RECNO(lcChildWkArea) pcChildID=lcChildID pcChildExpr="DEPTO" lcParentWkArea=riopen("fb2p_depto","depto") 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) IF llRetVal AND NOT (ISRLOCKED(pnParentRec, lcParentWkArea) OR ; ISFLOCKED(lcParentWkArea)) IF RLOCK(lcParentWkArea) UNLOCK RECORD pnParentRec IN (lcParentWkArea) ELSE =rireuse("tparen",lcParentWkArea) pnerror = rierror(-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 ENDIF =rireuse("fb2p_depto",lcParentWkArea) IF NOT llRetVal pnerror = rierror(-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" nombrelargodeldbf ******************************************************************************** **__RI_FOOTER!@ Do NOT REMOVE or MODIFY this line!!!! @!__RI_FOOTER** ]]>