From a57790bb564c7f678811e440a48714bc0ab10818 Mon Sep 17 00:00:00 2001 From: fernando Date: Sat, 18 Jan 2014 17:00:58 +0100 Subject: [PATCH] Changeset: 137 v1.19.3 Change on TXT timestamps to preserve empty values / Optimization on TXT generation of ZOrders --- TESTS/DATOS_READONLY/FB2P_DBC.DC2 | 959 ++++++++++-------- TESTS/DATOS_READONLY/FB2P_DBF.DB2 | 54 +- TESTS/DATOS_READONLY/fb2p_foxuser.fr2 | 460 +++++++++ TESTS/DATOS_READONLY/fb2p_foxuser.lb2 | 122 +++ TESTS/DATOS_READONLY/fb2p_frm_1.sc2 | 520 ++++++++++ TESTS/DATOS_READONLY/fb2p_frm_2.sc2 | 176 ++++ TESTS/DATOS_READONLY/fb2p_test.pj2 | 128 +++ TESTS/DATOS_READONLY/fb2p_test.vc2 | 199 ++++ .../fb2p_test_bug_estructural.vc2 | 41 + .../fb2p_test_bug_metodo_movido.vc2 | 68 ++ TESTS/DATOS_READONLY/menu1.mn2 | 106 ++ TESTS/DATOS_READONLY/menu2.mn2 | 95 ++ TESTS/DATOS_READONLY/menu3.mn2 | 28 + TESTS/DATOS_READONLY/menu_shortcut.mn2 | 98 ++ TESTS/DATOS_READONLY/menu_shortcut2.mn2 | 98 ++ foxbin2prg.pj2 | 4 +- foxbin2prg.pjt | Bin 333824 -> 334272 bytes foxbin2prg.pjx | Bin 1583 -> 1583 bytes foxbin2prg.prg | 52 +- 19 files changed, 2725 insertions(+), 483 deletions(-) create mode 100644 TESTS/DATOS_READONLY/fb2p_foxuser.fr2 create mode 100644 TESTS/DATOS_READONLY/fb2p_foxuser.lb2 create mode 100644 TESTS/DATOS_READONLY/fb2p_frm_1.sc2 create mode 100644 TESTS/DATOS_READONLY/fb2p_frm_2.sc2 create mode 100644 TESTS/DATOS_READONLY/fb2p_test.pj2 create mode 100644 TESTS/DATOS_READONLY/fb2p_test.vc2 create mode 100644 TESTS/DATOS_READONLY/fb2p_test_bug_estructural.vc2 create mode 100644 TESTS/DATOS_READONLY/fb2p_test_bug_metodo_movido.vc2 create mode 100644 TESTS/DATOS_READONLY/menu1.mn2 create mode 100644 TESTS/DATOS_READONLY/menu2.mn2 create mode 100644 TESTS/DATOS_READONLY/menu3.mn2 create mode 100644 TESTS/DATOS_READONLY/menu_shortcut.mn2 create mode 100644 TESTS/DATOS_READONLY/menu_shortcut2.mn2 diff --git a/TESTS/DATOS_READONLY/FB2P_DBC.DC2 b/TESTS/DATOS_READONLY/FB2P_DBC.DC2 index c3d3542..8310436 100644 --- a/TESTS/DATOS_READONLY/FB2P_DBC.DC2 +++ b/TESTS/DATOS_READONLY/FB2P_DBC.DC2 @@ -2,7 +2,7 @@ * (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.15" SourceFile="C:\DESA\FOXBIN2PRG\TESTS\DATOS_READONLY\FB2P_DBC.DBC" Generated="2013/12/17 16:01:00" /> (Para uso con Visual FoxPro 9.0) +*< FOXBIN2PRG: Version="1.19" SourceFile="C:\DESA\foxbin2prg\TESTS\DATOS_READONLY\fb2p_dbc.dbc" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) * @@ -10,7 +10,7 @@ Comentario de los eventos o de la BDD??? 11 .T. - + eventsfile.prg @@ -74,17 +74,17 @@ depto "Depto.Caption" depto_field_comment - depto_field_def_value + "Depto." cl_optiongroup c:\desa\foxbin2prg\tests\datos_readonly\fb2p_test.vcx - Disp.Format - InputMask + ! + XXXXXXXXXX depto_field_validation_rule() depto_field_validation_message() descrip - aaaaaaaaaa + Descripción @@ -103,10 +103,6 @@ .T. - - - - @@ -190,28 +186,36 @@ .T. - i_nombre + edad_nd .F. + + notdeleted + + .F. + + + edad + + .T. + depto .F. + + nombre + + .F. + + + i_nombre + + .F. + - - - - Relation 1 - NOMBRELARGODELDBF - FB2P_DEPTO - DEPTO - DEPTO - ICR - - -
@@ -248,115 +252,147 @@ 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 - - - - @@ -389,67 +425,83 @@ 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 - - - - @@ -482,43 +534,51 @@ 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 - - - - @@ -551,19 +611,19 @@ dummy + C(1) + .F. + .T. + DUAL.DUMMY - - - - @@ -578,436 +638,449 @@ ENDPROC PROCEDURE del_trg STRTOFILE( PROGRAM(), FORCEPATH( "LOG_DBC.TXT", JUSTPATH( EVL( DBC(),DBF() ) ) ) ) ENDPROC +PROCEDURE depto_field_validation_rule +ENDPROC +PROCEDURE depto_field_validation_message + RETURN 'Mensaje para Field Rule "depto_field_validation_rule"' +ENDPROC +PROCEDURE fb2p_depto_record_rule_validation +ENDPROC +PROCEDURE fb2p_depto_record_rule_validation_message + RETURN 'Mensaje para Record Rule "fb2p_depto_record_rule_validation"' +ENDPROC +PROCEDURE depto_field_def_value + RETURN 'Dpto.' +ENDPROC -*PROCEDURE dbc_OpenData -* LPARAMETERS cDatabaseName, lExclusive, lNoUpdate, lValidate +PROCEDURE dbc_OpenData + LPARAMETERS cDatabaseName, lExclusive, lNoUpdate, lValidate * ? ' cDatabaseName = ' + TRANSFORM(cDatabaseName) + ' - ' + TYPE('cDatabaseName') * ? ' lExclusive = ' + TRANSFORM(lExclusive) + ' - ' + TYPE('lExclusive') * ? ' lNoUpdate = ' + TRANSFORM(lNoUpdate) + ' - ' + TYPE('lNoUpdate') * ? ' lValidate = ' + TRANSFORM(lValidate) + ' - ' + TYPE('lValidate') -*ENDPROC +ENDPROC **__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 - ENDIF not already deleted - ENDIF - UNLOCK RECORD (RECNO()) - llRetVal=pnerror=0 -RETURN llRetVal +PROCEDURE RIDELETE + LOCAL llRetVal + llRetVal=.T. + IF (ISRLOCKED() AND !DELETED()) OR !RLOCK() + llRetVal=.F. + ELSE + IF !DELETED() + DELETE + IF CURSORGETPROP('BUFFERING') > 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 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 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 + 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 + LOCAL lcCurWkArea,lcNewWkArea,lnInUseSpot,lnOccurs,lnOccurance lnInUseSpot=0 -ENDFOR + 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) + 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. + 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. + * 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 + ******************************************************************************** + ** "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 -******************************************************************************** + 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 -******************************************************************************** + ******************************************************************************** +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 + ******************************************************************************** + ** "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** + 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** ]]> \ No newline at end of file diff --git a/TESTS/DATOS_READONLY/FB2P_DBF.DB2 b/TESTS/DATOS_READONLY/FB2P_DBF.DB2 index afc5d93..cfb2b3c 100644 --- a/TESTS/DATOS_READONLY/FB2P_DBF.DB2 +++ b/TESTS/DATOS_READONLY/FB2P_DBF.DB2 @@ -2,13 +2,13 @@ * (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.18" SourceFile="C:\DESA\foxbin2prg\TESTS\DATOS_READONLY\fb2p_dbf.dbf" Generated="2014/01/05 19:10:49" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +*< FOXBIN2PRG: Version="1.19" SourceFile="C:\DESA\foxbin2prg\TESTS\DATOS_READONLY\fb2p_dbf.dbf" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) * 1252 - 2014/01/05 + 2014/01/06fb2p_dbc.dbc0x00000031Visual FoxPro, autoincrement enabled @@ -71,7 +71,7 @@ - 20 + 302 @@ -122,31 +122,15 @@ ID - PRINCIPAL + PRIMARY ID ASCENDING MACHINE - - I_NOMBRE - NORMAL - NOMBRE - - ASCENDING - GENERAL - - - DEPTO - NORMAL - DEPTO - - ASCENDING - MACHINE - EDAD_ND - NORMAL + REGULAR EDAD .NOT.DELETED() ASCENDING @@ -154,7 +138,7 @@ NOTDELETED - BINARIO + BINARY .NOT.DELETED() ASCENDING @@ -162,12 +146,36 @@ EDAD - CANDIDATO + CANDIDATE EDAD DESCENDING MACHINE + + DEPTO + REGULAR + DEPTO + .NOT.DELETED().AND..T. + ASCENDING + GENERAL + + + NOMBRE + REGULAR + NOMBRE + .NOT.DELETED().AND..T..AND..T. + ASCENDING + GENERAL + + + I_NOMBRE + REGULAR + NOMBRE + .NOT.DELETED().AND..T..AND..NOT..F. + DESCENDING + GENERAL +
diff --git a/TESTS/DATOS_READONLY/fb2p_foxuser.fr2 b/TESTS/DATOS_READONLY/fb2p_foxuser.fr2 new file mode 100644 index 0000000..61f7b74 --- /dev/null +++ b/TESTS/DATOS_READONLY/fb2p_foxuser.fr2 @@ -0,0 +1,460 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (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="C:\DESA\foxbin2prg\TESTS\DATOS_READONLY\fb2p_foxuser.frx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* + + + + + +