// Use dbd.pkg // Database Documentation, Ability to create tables and control a cDBD_System object Use DBD.nui // cDBD_System, cDBD_TableAccess and cDBD_Updater classes Use FTSData.nui // cFTS_TableAccess class. Use TblCreate.pkg // cTableCreator class Use FList.nui // A lot of FLIST- procedures and functions object oDBD_TablePrefix is a aps.ModalPanel label "Create DBD tables" // "Root name prefix" set locate_mode to CENTER_ON_SCREEN on_key ksave_record send close_panel_ok on_key kcancel send close_panel property integer piResult public DFFALSE object oFrm is a aps.Form abstract AFT_ASCII2 label "Root name prefix (enter two letters)" set enabled_state to false end_object function iValidateValue returns integer integer liRval string lsValue move 1 to liRval get value of oFrm item 0 to lsValue move (trim(lowercase(lsValue))) to lsValue set value of oFrm item 0 to lsValue ifnot (length(lsValue)=2) move 0 to liRval ifnot ("abcdefghijklmnopqrstuvwxyz" contains left(lsValue,1)) move 0 to liRval ifnot ("abcdefghijklmnopqrstuvwxyz0123456789" contains right(lsValue,1)) move 0 to liRval ifnot liRval error 534 "Value must be two letters!" function_return liRval end_function object oBtn1 is a aps.Multi_Button on_item t.btn.ok send close_panel_ok end_object object oBtn2 is a aps.Multi_Button on_item t.btn.cancel send close_panel end_object send aps_locate_multi_buttons procedure close_panel_ok if (iValidateValue(self)) begin set piResult to DFTRUE send close_panel end end_procedure function sPopup.s string lsValue returns string set piResult to DFFALSE set value of oFrm item 0 to lsValue send popup if (piResult(self)) function_return (value(oFrm(self),0)) function_return "" end_procedure end_object // oDBD_TablePrefix object oDBD_TableDefinitions is a cArray object oTable_System is a cTableCreator set pbUpdateFilelist to true procedure OnDefine set piMaxRecords to 1 send DoAddField "NAME" DF_ASCII 50 send DoAddField "DESCRIPTION" DF_TEXT 12288 send DoAddField "PREV_UPD_METHOD" DF_BCD 2 // 0=Current DB, 1=XML, 2=FDX send DoAddField "PREV_UPD_FILE" DF_ASCII 255 send DoAddField "PREV_VDFQ_OUT" DF_ASCII 255 send DoAddField "PREV_XML_OUT" DF_ASCII 255 send DoAddField "DEF_LAST_UPD_DT" DF_DATE 0 // Date and time, when the DB's were last updated send DoAddField "DEF_LAST_UPD_TM" DF_ASCII 8 // end_procedure end_object object oTable_Table is a cTableCreator set pbUpdateFilelist to true procedure OnDefine set piMaxRecords to 10000 send DoAddField "TBL_ID" DF_BCD 6 // 1 send DoAddField "TBL_NAME" DF_ASCII 40 // 2 send DoAddField "TBL_LOGIC_NAME" DF_ASCII 12 // 3 send DoAddField "TBL_PHYSIC_NAME" DF_ASCII 80 // 4 send DoAddField "TBL_NOT_FOUND" DF_BCD 2 // 5 send DoAddField "TBL_OPENAS_PATH" DF_ASCII 255 // 6 send DoAddField "TBL_DESCRIPTION" DF_TEXT 12288 // 7 send DoAddField "TBL_OBSOLETE" DF_BCD 2 // 8 send DoAddField "CRE_DATE" DF_DATE 0 // send DoAddField "CRE_TIME" DF_ASCII 5 // send DoAddField "CRE_USER" DF_ASCII 30 // send DoAddField "REV_DATE" DF_DATE 0 // send DoAddField "REV_TIME" DF_ASCII 5 // send DoAddField "REV_USER" DF_ASCII 30 // send DoAddOnlineIndex 1 "tbl_id" send DoAddOnlineIndex 2 "TBL_PHYSIC_NAME recnum" // Uppercase = Ignore case end_procedure end_object object oTable_Field is a cTableCreator set pbUpdateFilelist to true procedure OnDefine set piMaxRecords to 100000 send DoAddField "TBL_ID" DF_BCD 6 // 1 send DoAddField "FLD_POS" DF_BCD 4 // 2 send DoAddField "FLD_NAME" DF_ASCII 15 // 3 send DoAddField "FLD_NOT_FOUND" DF_BCD 2 // 4 send DoAddField "FLD_DESCRIPTION" DF_TEXT 12288 // 5 send DoAddField "SUGGESTED_LABEL" DF_ASCII 20 // 6 send DoAddField "FLD_DEFINITION" DF_ASCII 20 // 7 send DoAddField "FLD_OBSOLETE" DF_BCD 2 // 8 send DoAddField "FLD_CALCULATED" DF_BCD 2 // 9 send DoAddField "FLD_CREATE_DATE" DF_DATE 0 // 10 send DoAddField "FLD_CREATE_TIME" DF_ASCII 8 // 11 send DoAddField "FLD_EDIT_DATE" DF_DATE 0 // 12 send DoAddField "FLD_EDIT_TIME" DF_ASCII 8 // 13 send DoAddField "CRE_DATE" DF_DATE 0 // send DoAddField "CRE_TIME" DF_ASCII 5 // send DoAddField "CRE_USER" DF_ASCII 30 // send DoAddField "REV_DATE" DF_DATE 0 // send DoAddField "REV_TIME" DF_ASCII 5 // send DoAddField "REV_USER" DF_ASCII 30 // send DoAddOnlineIndex 1 "tbl_id FLD_NAME" send DoAddOnlineIndex 2 "tbl_id fld_not_found fld_pos recnum" end_procedure end_object object oTable_Index is a cTableCreator set pbUpdateFilelist to true procedure OnDefine set piMaxRecords to 10000 send DoAddField "TBL_ID" DF_BCD 6 send DoAddField "IDX_POS" DF_BCD 2 send DoAddField "IDX_NAME" DF_ASCII 35 send DoAddField "IDX_DESCRIPTION" DF_TEXT 12288 send DoAddField "IDX_NOT_FOUND" DF_BCD 2 send DoAddField "CRE_DATE" DF_DATE 0 // send DoAddField "CRE_TIME" DF_ASCII 5 // send DoAddField "CRE_USER" DF_ASCII 30 // send DoAddField "REV_DATE" DF_DATE 0 // send DoAddField "REV_TIME" DF_ASCII 5 // send DoAddField "REV_USER" DF_ASCII 30 // send DoAddOnlineIndex 1 "tbl_id idx_pos" end_procedure end_object procedure DoCreateTables integer lhTableAccess integer liFile lhAppDbTable lbSuccess string lsRoot lsLogical lsDisplay get piFile.i of lhTableAccess DBDTABLE_SYSTEM to liFile get psRootname.i of lhTableAccess DBDTABLE_SYSTEM to lsRoot get psLogicalName.i of lhTableAccess DBDTABLE_SYSTEM to lsLogical get psUserName.i of lhTableAccess DBDTABLE_SYSTEM to lsDisplay set FileListValues of oTable_System to liFile lsRoot lsLogical lsDisplay send DoDefine of oTable_System send CreateTable of oTable_System get piFile.i of lhTableAccess DBDTABLE_TABLE to liFile get psRootname.i of lhTableAccess DBDTABLE_TABLE to lsRoot get psLogicalName.i of lhTableAccess DBDTABLE_TABLE to lsLogical get psUserName.i of lhTableAccess DBDTABLE_TABLE to lsDisplay set FileListValues of oTable_Table to liFile lsRoot lsLogical lsDisplay send DoDefine of oTable_Table send CreateTable of oTable_Table get piFile.i of lhTableAccess DBDTABLE_FIELD to liFile get psRootname.i of lhTableAccess DBDTABLE_FIELD to lsRoot get psLogicalName.i of lhTableAccess DBDTABLE_FIELD to lsLogical get psUserName.i of lhTableAccess DBDTABLE_FIELD to lsDisplay set FileListValues of oTable_Field to liFile lsRoot lsLogical lsDisplay send DoDefine of oTable_Field send CreateTable of oTable_Field get piFile.i of lhTableAccess DBDTABLE_INDEX to liFile get psRootname.i of lhTableAccess DBDTABLE_INDEX to lsRoot get psLogicalName.i of lhTableAccess DBDTABLE_INDEX to lsLogical get psUserName.i of lhTableAccess DBDTABLE_INDEX to lsDisplay set FileListValues of oTable_Index to liFile lsRoot lsLogical lsDisplay send DoDefine of oTable_Index send CreateTable of oTable_Index end_procedure end_object // oDBD_TableDefinitions procedure DBD_CreateTables global integer lhTableAccess send DoCreateTables of oDBD_TableDefinitions lhTableAccess end_procedure object oDBDControlPanel is a aps.ModalPanel label "DBD - Control Panel" set locate_mode to CENTER_ON_SCREEN on_key KCANCEL send close_panel property integer phDbdSystem property integer pbNewTablesSelected procedure Write_XML_Output string lsFileName lsDataPath get psDataPath of (phoWorkspace(ghoApplication)) to lsDataPath //get CurrentDataPath of ghoWorkSpace to lsDataPath // VDF 7 get SEQ_SelectOutFileStartDir "Select XML output filename" "XML files|*.xml|All files|*.*" lsDataPath to lsFileName if (lsFileName<>"") send DoProcess_FileName of dbDocBPOXML_Write lsFileName (phDbdSystem(self)) end_procedure procedure Read_XML_Input string lsFileName lsDataPath get psDataPath of (phoWorkspace(ghoApplication)) to lsDataPath //get CurrentDataPath of ghoWorkSpace to lsDataPath // VDF 7 get SEQ_SelectFileStartDir "Select XML input filename" "XML filer|*.xml|Alle filer|*.*" lsDataPath to lsFileName if (lsFileName<>"") send DoProcess_FileName of dbDocBPOXML_Read lsFileName (phDbdSystem(self)) end_procedure procedure UpdateDefinitions integer lhUpdater move (phTableUpdater(phDbdSystem(self))) to lhUpdater send DoUpdateDatabase of lhUpdater end_procedure procedure DoZeroData integer lhTableAccess string lsTableFn lsFieldFn lsIndexFn move (phTableAccessObject(integer(phDbdSystem(self)))) to lhTableAccess get DBMS_TablePath (piFile.i(lhTableAccess,DBDTABLE_TABLE)) to lsTableFn get DBMS_TablePath (piFile.i(lhTableAccess,DBDTABLE_FIELD)) to lsFieldFn get DBMS_TablePath (piFile.i(lhTableAccess,DBDTABLE_INDEX)) to lsIndexFn if (MB_Verify4("Delete ALL descriptions of your database from the tables below?",lsTableFn,lsFieldFn,lsIndexFn,0)) begin move (phTableAccessObject(phDbdSystem(self))) to lhTableAccess if (DoZerofileAllTables(lhTableAccess)) send obs "Data in tables have been deleted" //send request_clear_all end end_procedure procedure UpdateFDX send obs "Not implemented yet!" end_procedure procedure CreateNewTables string lsPrefix lsOldPrefix integer lhTableAccess lbSuccess integer liBaseFile // this one is used to figure out file numbers were changed as a result of calling this procedure move (phTableAccessObject(phDbdSystem(self))) to lhTableAccess get psRootNamePrefix of lhTableAccess to lsOldPrefix get sPopup.s of oDBD_TablePrefix lsOldPrefix to lsPrefix get piFile.i of lhTableAccess DBDTABLE_SYSTEM to liBaseFile if (lsPrefix<>"") begin set psRootNamePrefix of lhTableAccess to lsPrefix send DoCloseTables of lhTableAccess get DoOpenTables of lhTableAccess to lbSuccess ifnot lbSuccess begin if (MB_Verify4("Tables not found!","Do you want to create","a new set of tables?","(with prefix: "+lsPrefix+")",0)) begin send DBD_CreateTables lhTableAccess send DoCloseTables of lhTableAccess get DoOpenTables of lhTableAccess to lbSuccess ifnot lbSuccess send obs "The program was not able to create a new set of tables." end ifnot lbSuccess begin // OK! We try to open the previous ones set psRootNamePrefix of lhTableAccess to lsPrefix get DoOpenTables of lhTableAccess to lbSuccess ifnot lbSuccess begin send obs "The program failed re-open the previous set of tables." "The program will now terminate!" system end end end set pbNewTablesSelected to (liBaseFile<>piFile.i(lhTableAccess,DBDTABLE_SYSTEM)) send close_panel end end_procedure procedure DoRelocateFilelistEntries end_procedure //object oBtn1 is a aps.Button // set size to 16 200 // on_item "Open new set of tables" send CreateNewTables //end_object //object oBtn2 is a aps.Button // snap SL_DOWN // set size to 16 200 // on_item "Update tables according to current DB" send UpdateDefinitions //end_object //object oBtn3 is a aps.Button snap SL_DOWN // set size to 16 200 // on_item "Update tables according to FDX file" send UpdateFDX //end_object object oBtn4 is a aps.Button // snap SL_DOWN set size to 16 200 on_item "Delete all data in the description tables!" send DoZeroData end_object object oBtn5 is a aps.Button snap SL_DOWN set size to 16 200 on_item "Export DB descriptions to XML" send Write_XML_Output end_object object oBtn6 is a aps.Button snap SL_DOWN set size to 16 200 on_item "Import DB descriptions from XML" send Read_XML_Input end_object object oBtn7 is a aps.Button snap SL_DOWN set size to 16 200 on_item "Relocate filelist entries" send DoRelocateFilelistEntries end_object send aps_goto_max_row send aps_make_row_space 10 object oBtnCancel is a aps.Button set size to 16 200 on_item "Cancel" send close_panel end_object end_object // oDBDControlPanel procedure Popup_DbdCreateTablesPanel integer lhDbdSystem set pbNewTablesSelected of oDBDControlPanel to false set phDbdSystem of oDBDControlPanel to lhDbdSystem send CreateNewTables of oDBDControlPanel end_function procedure Popup_DbdControlPanel integer lhDbdSystem set pbNewTablesSelected of oDBDControlPanel to false set phDbdSystem of oDBDControlPanel to lhDbdSystem send popup to oDBDControlPanel end_procedure function DbdControl_NewTablesSelected global returns integer function_return (pbNewTablesSelected(oDBDControlPanel(self))) end_function procedure DbdControl_ReadDatabaseDefinitions integer lhDbdSystem set phDbdSystem of oDBDControlPanel to lhDbdSystem send UpdateDefinitions to oDBDControlPanel end_procedure