// Use TblDynAc.nui // Table, dynamic access (cDynamicTableAccess class) // The cDynamicTableAccess enables you to define set // Use like this: // // // enumeration_list // define DBDTABLE_SYSTEM // define DBDTABLE_TABLE // define DBDTABLE_FIELD // define DBDTABLE_INDEX // end_enumeration_list // // object oDynamicTableAccess is a cDynamicTableAccess // set psRootNamePrefix to "db" // // set TableBaseData DBDTABLE_SYSTEM to "system" "DBD - System" 0 // set TableBaseData DBDTABLE_TABLE to "table" "DBD - Tables" 0 // set TableBaseData DBDTABLE_FIELD to "field" "DBD - Fields" 0 // set TableBaseData DBDTABLE_INDEX to "index" "DBD - Indices" 0 // end_object // oDynamicTableAccess // // // // Create: Mon 28-04-2003 - // Update: Tue 18-06-2003 - // Update: Sun 21-12-2003 - Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface) Use FList.nui // A lot of FLIST- procedures and functions Use FDX_Attr.nui // FDX compatible attribute functions Use DBMS.nui // Basic DBMS functions (No User Interface) Use WildCard.nui // WildCardMatch function Use Strings.nui // String manipulation for VDF and 3.2 (No User Interface) Use ItemProp.nui // ITEM_PROPERTY command for use within arrays class cDynamicTableAccess_Help is a cArray // Private class item_property_list item_property integer piFile.i item_property string psPrefix.i item_property string psOpenDescription.i end_item_property_list cDynamicTableAccess_Help procedure add_prefix integer liFile string lsPrefix string lsOpenDescription local integer liRow get row_count to liRow set piFile.i liRow to liFile set psPrefix.i liRow to lsPrefix set psOpenDescription.i liRow to lsOpenDescription end_procedure end_class // cDynamicTableAccess_Help class cDynamicTableAccess is a cArray procedure construct_object // Private forward send construct_object property string psRootNamePrefix public "" property string psPurpose public "" //> This boolean property determines if the object attempt to open the tables //> on 'end_construct_object'. property integer pbOpenTablesOnDefine public TRUE //> Allow the object to open the tables even if they are not listed in filelist.cfg? property integer pbAllowTemporaryFilelistEntries public TRUE property integer pbAllTablesAreOpen private FALSE property integer piOpenMode private DF_SHARE ///// object oTempArray is a cArray NO_IMAGE ///// end_object object oListOfSets is a cDynamicTableAccess_Help end_object end_procedure procedure DeclareOpenError string lsError move (replace("#",lsError,psRootNamePrefix(self))) to lsError error 208 lsError end_procedure function pbAllTablesAreOpen returns integer function_return (!$.pbAllTablesAreOpen(self)) end_function item_property_list item_property integer piFile.i item_property string psRootname.i item_property string psLogicalName.i item_property string psUserName.i item_property string psRootOfRootName.i item_property string psRootOfUserName.i item_property integer piOpenByIndex.i item_property integer piOpenState.i // -1:Open by foreign table 0:Not opened 1:Open end_item_property_list cDynamicTableAccess procedure set TableBaseData integer liRow string lsRootOfRoot string lsRootOfUser integer liOpenByIndex set psRootOfRootName.i liRow to lsRootOfRoot set psRootOfUserName.i liRow to lsRootOfUser set piOpenByIndex.i liRow to liOpenByIndex end_procedure procedure set TableAccess integer liRow integer liFile string lsRootname string lsLogicalName string lsUserName // Private set piFile.i liRow to liFile set psRootname.i liRow to lsRootname set psLogicalName.i liRow to lsLogicalName set psUserName.i liRow to lsUserName end_procedure procedure DoCalcFilelistValues // Private local integer liMax liRow local string lsPrefix lsPurpose get psPurpose to lsPurpose if (lsPurpose<>"") move (" ("+lsPurpose+")") to lsPurpose get psRootNamePrefix to lsPrefix move (lowercase(trim(lsPrefix))) to lsPrefix get row_count to liMax decrement liMax for liRow from 0 to liMax set TableAccess liRow to 0 (lsPrefix+psRootOfRootName.i(self,liRow)) (lsPrefix+psRootOfRootName.i(self,liRow)) (psRootOfUserName.i(self,liRow)+lsPurpose) loop end_procedure function iFind_FL_Entry_By_LogName string lsLogName returns integer // Private local integer liFile local string lsFilelistValue move (lowercase(lsLogName)) to lsLogName move 0 to liFile repeat get_attribute DF_FILE_NEXT_USED of liFile to liFile if liFile begin get_attribute DF_FILE_LOGICAL_NAME of liFile to lsFilelistValue if (lowercase(lsFilelistValue)=lsLogName) function_return liFile end until liFile eq 0 function_return -1 end_function procedure FindExistingFileListEntries // Private local integer liMax liRow liFile local string lsLogical get row_count to liMax decrement liMax for liRow from 0 to liMax if (piFile.i(self,liRow)=0) begin get psLogicalName.i liRow to lsLogical get iFind_FL_Entry_By_LogName lsLogical to liFile if (liFile>0) set piFile.i liRow to liFile end loop end_procedure // Find an empty entry in filelist cfg, that is not temporarily used // by an "open as" statement. Start the search at entry liFile. function iFind_FL_Entry_Unused integer liFile returns integer // Private local integer lbOpened repeat get_attribute DF_FILE_NEXT_EMPTY of liFile to liFile if liFile begin get_attribute DF_FILE_NEXT_OPENED of liFile to lbOpened ifnot lbOpened function_return liFile end until liFile eq 0 function_return -1 end_function ////// // Find liHowMany empty entries in filelist cfg, that are not temporarily used ////// // by an "open as" statement. Start the search at entry liFile. The function ////// // returns the number of the first such entry or 0 if none is found. ////// function iFind_FL_Entries_Unused integer liFile integer liHowMany returns integer // Private ////// local integer lhTempArray ////// move oTempArray to lhTempArray ////// repeat ////// get iFind_FL_Entry_Unused liFile to liFile ////// ////// until liFile eq 0 ////// function_return 0 ////// end_function function bConvertFilelistTo4095 returns integer function_return 0 // function_return (MB_Verify4("Your filelist.cfg is an old one","with less than 256 entries.","","Should it be converted to a 4095 entry filelist?",1)) end_function procedure AutoAssignFileListEntries // Private end_procedure procedure AutoAssignTemporaryFileListEntries // Private local integer liMax liRow liFile local string lsLogical if (FLIST_Information(FLINFO_LT_256)) begin if (bConvertFilelistTo4095(self)) send FLIST_Make4095 end send FindExistingFileListEntries if (pbAllowTemporaryFilelistEntries(self)) begin get row_count to liMax decrement liMax move 400 to liFile // We start at 400 for liRow from 0 to liMax if (piFile.i(self,liRow)=0) begin get iFind_FL_Entry_Unused liFile to liFile if (liFile>0) set piFile.i liRow to liFile else procedure_return end loop end end_procedure procedure DoCloseTables local integer liMax liRow liFile local string lsRoot get row_count to liMax decrement liMax for liRow from 0 to liMax get piFile.i liRow to liFile if (liFile<>0 and piOpenState.i(self,liRow)=1) begin close liFile set piOpenState.i liRow to 0 end loop set !$.pbAllTablesAreOpen to false end_procedure procedure OnAllTablesOpened // Augment to set relationships end_procedure function DoOpenTables returns integer local integer liMax liRow liFile liOpened liOpenMode local string lsRoot get !$.piOpenMode to liOpenMode // DF_SHARE or DF_EXCLUSIVE send DoCalcFilelistValues send AutoAssignTemporaryFileListEntries get row_count to liMax decrement liMax for liRow from 0 to liMax get piFile.i liRow to liFile if (liFile<>0) begin // At this point it would be fair to check that the entry is not // already open with an irrelevant file. If this is found to be // the case piOpenState.i should be set to -1. get psRootname.i liRow to lsRoot get DBMS_OpenFileAs lsRoot liFile liOpenMode (piOpenByIndex.i(self,liRow)) to liOpened ifnot liOpened get DBMS_OpenFileAs (lsRoot+".int") liFile liOpenMode (piOpenByIndex.i(self,liRow)) to liOpened set piOpenState.i liRow to (if(liOpened,1,0)) end else move 0 to liOpened ifnot liOpened begin send DoCloseTables function_return 0 // error end loop set !$.pbAllTablesAreOpen to true send OnAllTablesOpened function_return 1 // ok end_function function DoOpenTablesExclusive returns integer local integer liRval set !$.piOpenMode to DF_EXCLUSIVE get DoOpenTables to liRval set !$.piOpenMode to DF_SHARE function_return liRval end_function // The Precond_TableInFilelist and Precond_TableOnDisk functions are // only here so that a package that wants to create a set of tables // can ask these sensible cousins if *they* think that's alright. function Precond_TableInFilelist string lsRootname integer lbQuiet returns integer local integer liFile local string lsError get FDX_FindRootName 0 lsRootname 0 to liFile if (liFile and not(lbQuiet)) begin move "A table with root-name '#' is already listed in filelist.cfg at entry #" to lsError move (replace("#",lsError,lsRootname)) to lsError move (replace("#",lsError,string(liFile))) to lsError error 201 lsError function_return 1 end get FDX_FindLogicalName 0 lsRootname 0 to liFile if (liFile and not(lbQuiet)) begin move "A table with logical name '#' is already listed in filelist.cfg at entry #" to lsError move (replace("#",lsError,lsRootname)) to lsError move (replace("#",lsError,string(liFile))) to lsError error 201 lsError function_return 1 end function_return 0 end_function function Precond_TableOnDisk string lsRootname integer lbQuiet returns integer local string lsError lsPath get SEQ_FindFileAlongDFPath (lsRootName+".dat") to lsPath if (lsPath<>"" and not(lbQuiet)) begin move "A file named '#' is found in this folder: #" to lsError move (replace("#",lsError,lsRootname+".dat")) to lsError move (replace("#",lsError,lsPath)) to lsError error 204 lsError function_return 1 end get SEQ_FindFileAlongDFPath (lsRootName+".int") to lsPath if (lsPath<>"" and not(lbQuiet)) begin move "A file named '#' is found in this folder: #" to lsError move (replace("#",lsError,lsRootname+".int")) to lsError move (replace("#",lsError,lsPath)) to lsError error 204 lsError function_return 1 end function_return 0 end_function function Precond_CreateTables integer lbQuiet returns integer local integer liMax liRow lbOK liFile local string lsRoot get row_count to liMax decrement liMax move 1 to lbOK for liRow from 0 to liMax get psRootname.i liRow to lsRoot get Precond_TableInFilelist lsRoot lbQuiet to liFile if liFile move 0 to lbOK loop if (not(lbOK) and not(lbQuiet)) begin error 203 "This function cannot create tables that are already listed in filelist.cfg" function_return 0 end for liRow from 0 to liMax get psRootname.i liRow to lsRoot get Precond_TableOnDisk lsRoot lbQuiet to liFile if liFile move 0 to lbOK loop if (not(lbOK) and not(lbQuiet)) begin error 205 "This function cannot create tables that are already found on disk" function_return 0 end function_return 1 end_function function iMainFileRecords returns integer local integer liFile liRecords move -1 to liRecords if (pbAllTablesAreOpen(self)) begin get piFile.i 0 to liFile if liFile get_attribute DF_FILE_RECORDS_USED of liFile to liRecords end function_return liRecords end_function function OpenDescription returns string local integer liMainFileRecords if (pbAllTablesAreOpen(self)) begin get iMainFileRecords to liMainFileRecords function_return (string(liMainFileRecords)+" records in main file") end else function_return "" end_function // Only meant for applications that wants to create and // (in this case) drop databases automatically: function DoEraseAllTables returns integer local integer liMax liRow liFile lbDrop lbExclusive local string lsRootName1 lsRootName2 send DoCloseTables send DoCalcFilelistValues send FindExistingFileListEntries get DoOpenTablesExclusive to lbExclusive send DoCloseTables if lbExclusive begin get row_count to liMax decrement liMax move 1 to lbDrop for liRow from 0 to liMax get piFile.i liRow to liFile if liFile begin get_attribute DF_FILE_ROOT_NAME of liFile to lsRootName1 get psRootname.i liRow to lsRootName2 ifnot (lowercase(DBMS_StripPathAndDriver(lsRootName1))=lowercase(lsRootName2)) move 0 to lbDrop end loop if lbDrop begin for liRow from 0 to liMax get piFile.i liRow to liFile if liFile begin get DBMS_EraseDfFile liFile "" to lbDrop set_attribute DF_FILE_LOGICAL_NAME of liFile to "" set_attribute DF_FILE_ROOT_NAME of liFile to "" set_attribute DF_FILE_DISPLAY_NAME of liFile to "" end else begin get psRootname.i liRow to lsRootName2 get DBMS_EraseDfFile 0 lsRootName2 to lbDrop end loop end end else begin //error 206 "Table(s) could not be dropped" move 0 to lbDrop end function_return lbDrop end_function // Call this to search the filelist.cfg for existing sets of tables that matches the // psRootOfRootName.i (i.e. matches except for the prefix). Makes a list of complete // FTS databases that are available in the current filelist. // NOTE that calling this procedure will close the set of tables that the object currently // has opened, if any (this is also for "God" applications only). procedure DoBuildSetsOfTables local integer lhSetOfSets liFile local string lsPush lsRootOfRoot lsRoot lsPrefix lsOpenDescription move (oListOfSets(self)) to lhSetOfSets send delete_data to lhSetOfSets send DoCloseTables get psRootNamePrefix to lsPush if (row_count(self)) begin get psRootOfRootName.i 0 to lsRootOfRoot send WildCardMatchPrepare ("*"+lowercase(lsRootOfRoot)) move 0 to liFile repeat get FDX_AttrValue_FLSTNAV 0 DF_FILE_NEXT_USED liFile to liFile if liFile begin // If any more files get FDX_AttrValue_FILELIST 0 DF_FILE_ROOT_NAME liFile to lsRoot get DBMS_StripPathAndDriver lsRoot to lsRoot if (WildCardMatch(lowercase(lsRoot))) begin // If the root name matches our own first root name get StringLeftBut lsRoot (length(lsRootOfRoot)) to lsPreFix set psRootNamePrefix to lsPrefix if (DoOpenTables(self)) begin get OpenDescription to lsOpenDescription send add_prefix to lhSetOfSets liFile lsPrefix lsOpenDescription send DoCloseTables end end end until (not(liFile)) send sort_rows to lhSetOfSets 1 end set psRootNamePrefix to lsPush end_procedure procedure end_construct_object forward send end_construct_object if (pbOpenTablesOnDefine(self)) begin ifnot (DoOpenTables(self)) send DeclareOpenError "Tables could not be opened (#)" // Open the tables end end_procedure end_class // cDynamicTableAccess