* ********************************************************************* * * * * 2013/12/09 FB2P_DBC.DBC 22:32:26 * * * ********************************************************************* * * * * Description: * * This program was automatically generated by GenDBCX Version 1.1, * * a modified version of Microsoft's utility GenDBC Version 2.26.67. * * * ********************************************************************* LPARAMETERS tcMethod LOCAL oDBC oDBC = CreateObject('GenDBCX') IF TYPE('oDBC') != 'O' RETURN ENDIF cExactSet = SET('EXACT') SET EXACT ON IF EMPTY(tcMethod) =oDBC.GenerateAll() ELSE =EVALUATE('oDBC.' + tcMethod) ENDIF IF cExactSet = 'OFF' SET EXACT OFF ENDIF DEFINE CLASS GenDBCX AS Custom PROTECTED aTables[1] PROTECTED nTables PROCEDURE CustomProcess *-- Your code goes here ENDPROC PROCEDURE Init IF FILE('FB2P_DBC.DBC') OPEN DATABASE FB2P_DBC.DBC this.nTables = ADBOBJECTS(this.aTables, 'Table') ENDIF LOCAL ARRAY xx[1] IF ADIR(xx,'*.DBC') > 0 OR ADIR(xx,'*.DBF') > 0 IF MessageBox('Warning! This program will overwrite your existing database and tables! Continue?', 308, 'GenDBCX Warning...') != 6 RETURN .F. ENDIF ENDIF ENDPROC PROCEDURE CreateDBC *-- Create the Database Container CLOSE DATA ALL CREATE DATABASE 'FB2P_DBC.DBC' ********* Procedure Re-Creation ********* IF !FILE([FB2P_DBC.krt]) ? [Warning! No Procedure File Found!] ELSE CLOSE DATABASE USE 'FB2P_DBC.DBC' g_SetSafety = SET('SAFETY') SET SAFETY OFF LOCATE FOR Objectname = 'StoredProceduresSource' IF FOUND() APPEND MEMO Code FROM [FB2P_DBC.krt] OVERWRITE REPLACE Code WITH SUBSTR(Code, 70, 13140) ENDIF LOCATE FOR Objectname = 'StoredProceduresObject' IF FOUND() APPEND MEMO Code FROM [FB2P_DBC.krt] OVERWRITE REPLACE Code WITH SUBSTR(Code, 13210) ENDIF IF UPPER(g_SetSafety) = 'ON' SET SAFETY ON ENDIF USE OPEN DATABASE [FB2P_DBC.DBC] ENDIF ENDPROC ************************************************** ** Table setup for NOMBRELARGODELDBF ************************************************** PROCEDURE tbNOMBRELARGODELDBF LPARAMETERS tnPassNumber DO CASE CASE tnPassNumber = 1 =this.RemoveTable('NOMBRELARGODELDBF', 'C:\DESA\FOXBIN2PRG\TESTS\DATOS_READONLY\FB2P_DBF.DBF') CREATE TABLE 'FB2P_DBF.DBF' NAME 'NOMBRELARGODELDBF' ( ; NOMBRE C(30) NOT NULL CHECK .NOT.EMPTY(nombre) ERROR "El nombre está vacío" DEFAULT ".", ; EDAD N(3, 0) NOT NULL, ; ID I NOT NULL, ; BIGTEXT M NOT NULL, ; DEPTO C(10) NOT NULL ; ) ***** Create each index for NOMBRELARGODELDBF ***** SET COLLATE TO 'MACHINE' ALTER TABLE 'NOMBRELARGODELDBF' ADD PRIMARY KEY ID TAG ID SET COLLATE TO 'GENERAL' INDEX ON NOMBRE TAG I_NOMBRE SET COLLATE TO 'MACHINE' INDEX ON DEPTO TAG DEPTO CASE tnPassNumber = 2 ***** Change properties for NOMBRELARGODELDBF ***** DBSetProp('NOMBRELARGODELDBF.NOMBRE', 'Field', 'Caption', "'Nombre:'") DBSetProp('NOMBRELARGODELDBF.NOMBRE', 'Field', 'Comment', "Comentario de 'Nombre'") DBSetProp('NOMBRELARGODELDBF.NOMBRE', 'Field', 'InputMask', "!XXXXXXXXXXXXXXXXXXXXXXXXXXXXX") DBSetProp('NOMBRELARGODELDBF.NOMBRE', 'Field', 'Format', "A") DBSetProp('NOMBRELARGODELDBF', 'Table', 'Comment', "Comentario de la tabla 'fb2p_dbf'") CREATE TRIGGER ON 'NOMBRELARGODELDBF' FOR DELETE AS del_trg() CREATE TRIGGER ON 'NOMBRELARGODELDBF' FOR INSERT AS __ri_insert_nombrelargodeldbf().AND.(ins_trg()) CREATE TRIGGER ON 'NOMBRELARGODELDBF' FOR UPDATE AS __ri_update_nombrelargodeldbf().AND.(upd_trg()) ALTER TABLE 'NOMBRELARGODELDBF' SET CHECK edad>10 ERROR "Mensaje de error de la regla edad > 10" ENDCASE ENDPROC ************************************************** ** Table setup for FB2P_DEPTO ************************************************** PROCEDURE tbFB2P_DEPTO LPARAMETERS tnPassNumber DO CASE CASE tnPassNumber = 1 =this.RemoveTable('FB2P_DEPTO', 'C:\DESA\FOXBIN2PRG\TESTS\DATOS_READONLY\FB2P_DEPTO.DBF') CREATE TABLE 'FB2P_DEPTO.DBF' NAME 'FB2P_DEPTO' ( ; DEPTO C(10) NOT NULL, ; DESCRIP C(50) NOT NULL ; ) ***** Create each index for FB2P_DEPTO ***** SET COLLATE TO 'MACHINE' ALTER TABLE 'FB2P_DEPTO' ADD PRIMARY KEY DEPTO TAG DEPTO CASE tnPassNumber = 2 ***** Change properties for FB2P_DEPTO ***** DBSetProp('FB2P_DEPTO', 'Table', 'Comment', "Comentario de 'fb2p_depto'") CREATE TRIGGER ON 'FB2P_DEPTO' FOR DELETE AS __ri_delete_fb2p_depto() ENDCASE ENDPROC ***** Relations Setup ***** PROCEDURE SetRelations ALTER TABLE 'NOMBRELARGODELDBF' ADD FOREIGN KEY TAG DEPTO REFERENCES FB2P_DEPTO TAG DEPTO ENDPROC ***** Referential Integrity Setup ***** PROCEDURE SetRI CLOSE DATABASE USE 'FB2P_DBC.DBC' LOCATE FOR ObjectType = 'Table' AND UPPER(ALLTRIM(ObjectName)) == 'NOMBRELARGODELDBF' IF FOUND() nObjectID = ObjectID LOCATE FOR ObjectType = 'Relation' AND 'depto'$Property AND 'fb2p_depto'$Property AND 'depto'$Property AND ParentID = nObjectID IF FOUND() REPLACE RiInfo WITH 'ICR ' ELSE ? "Could not set RI Information, line " + ltrim(str(lineno())) ENDIF ENDIF USE ENDPROC FUNCTION RemoveTable(tcTable, tcFile) LOCAL ARRAY laTables[1] =ADBOBJECTS(laTables,'Table') IF ASCAN(laTables,tcTable) = 0 *-- No such table in the current dbc, nothing to do! RETURN .t. ENDIF IF !FILE(tcFile) *-- If the file has been erased, REMOVE TABLE fails with a 'File does not *-- exist' error, because it can't find the file to either remove its *-- database reference or delete the file . *-- We'll work around this problem by creating a phony file with the same *-- name, and use REMOVE TABLE DELETE to both remove the table reference *-- in the dbc, and erase the phony file. LOCAL lhFile lhFile = FCREATE(tcFile) IF lhFile = -1 RETURN .f. ENDIF =FCLOSE(lhFile) ENDIF REMOVE TABLE (tcTable) DELETE =ADBOBJECTS(laTables,'Table') RETURN ASCAN(laTables,tcTable) = 0 ENDFUNC PROCEDURE GenerateAll =this.CreateDBC() =this.CreateTables() *-- Call custom method =this.CustomProcess() =this.RulesTriggersProperties() =this.SetRelations() =this.SetRI() ENDPROC PROCEDURE CreateTables *-- Create Tables =this.tbNOMBRELARGODELDBF(1) =this.tbFB2P_DEPTO(1) ENDPROC PROCEDURE RulesTriggersProperties *-- Finish Tables (add rules/triggers/properties) =this.tbNOMBRELARGODELDBF(2) =this.tbFB2P_DEPTO(2) ENDPROC ENDDEFINE