//********************************************************************** // Use DFMatrix.utl // DFMatrix application glue // // By Sture Andersen // Version: 2.0- // // Create: Wed 09-02-2000 // Update: // // //********************************************************************** Use CmdLine.nui // Simple thing for reading command line parameters Use Strings.nui // String manipulation for VDF and 3.2 (No User Interface) Use Files.nui // Utilities for handling file related stuff (No User Interface) Use Output.utl // Basic sequential output service //Use DataScan.utl // Data scan classes Use FDX.nui // cFDX class Use Fdx1.utl // FDX aware display global attributes (FDX_DisplayGlobalAttributes procedure) Use Fdx2.utl // FDX aware object for displaying a table definiton Use Fdx4.utl // FDX aware cFileList_List selector object Use Fdx5.utl // Basic adiministration of FDX objects Use ObjGroup.utl // Defining groups of objects Use DfmPrint.utl // Classes for printing DFMatrix reports. Use Login.utl // DBMS_GetDriverLogin function Use Focus.utl // Retrieve basic information about object Use ErrorHnd.nui // cErrorHandlerRedirector class and oErrorHandlerQuiet object (No User Interface) Use LogFile.nui // Class for handling a log file (No User Interface) Use Flist.nui define app.DFMatrix.Title for "The DataFlex Matrix" define app.DFMatrix.Version for "DFM10.0/FDX2.0" procedure DFMatrix_Create_FDX global send fdx.entry_create_empty 0 // Primary FDX object send fdx.entry_create_empty 1 // Secondary FDX object set piFDX_Server of (oFdxSetOfFields(self)) to (fdx.object_id(0)) set piFDX_Server of (oFdxSetOfTables(self)) to (fdx.object_id(0)) set piFDX_Server of (oFdxSetOfIndices(self)) to (fdx.object_id(0)) set piFDX_Server of (oAuxFdxSetOfFields(self)) to (fdx.object_id(0)) set piFDX_Server of (oAuxFdxSetOfTables(self)) to (fdx.object_id(0)) set piFDX_Server of (oAuxFdxSetOfIndices(self)) to (fdx.object_id(0)) end_procedure send DFMatrix_Create_FDX //send fdx.open_file 0 "lws.fdx" //send fdx.open_file 1 "multi.fdx" enumeration_list // Who are you's define WAY_GLOBAL_ATTRIBUTES_VW define WAY_TABLE_SELECTOR_VW define WAY_TABLE_DEFINITION_VW define WAY_DIRECTORY_CONTENTS_VW define WAY_SET_OF_TABLES_VW define WAY_SET_OF_FIELDS_VW define WAY_SET_OF_INDICES_VW end_enumeration_list object oDFMatrixViewPanels is a cArray no_image property integer piCurrentFileInSelector public 0 property integer piWorkSpaceLoaded public 0 property string psCurrentWorkSpace public "no workspace" procedure add_row integer who_are_you# integer obj# set value item who_are_you# to obj# end_procedure end_object function DFMatrix_WorkSpaceLoaded global returns integer function_return (piWorkSpaceLoaded(oDFMatrixViewPanels(self))) end_function function DFMatrix_CurrentWorkSpace global returns string if (DFMatrix_WorkSpaceLoaded()) function_return (psCurrentWorkSpace(oDFMatrixViewPanels(self))) function_return "" end_function procedure DFMatrix_Vw_Register global integer who_are_you# integer obj# send add_row to (oDFMatrixViewPanels(self)) who_are_you# obj# end_procedure function DFMatrix_Vw_Object_ID global integer who_are_you# returns integer function_return (value(oDFMatrixViewPanels(self),who_are_you#)) end_function function DFMatrix_SelectorObject global returns integer local integer vw# move (DFMatrix_Vw_Object_ID(WAY_TABLE_SELECTOR_VW)) to vw# #IFDEF IS$WINDOWS function_return (oLst(vw#)) #ELSE function_return (oLst(vw#)) #ENDIF end_function procedure DFMatrix_NewFileInSelector global integer file# set piCurrentFileInSelector of (oDFMatrixViewPanels(self)) to file# send OnChangeFdxFile to (DFMatrix_Vw_Object_ID(WAY_TABLE_DEFINITION_VW)) end_procedure procedure DFMatrix_CallBack_Selected_Files global integer msg# integer obj# integer selected# integer shaded# integer tmp# local integer oLst# master# if num_arguments gt 4 move tmp# to master# else move 0 to master# get DFMatrix_SelectorObject to oLst# send Callback_General to oLst# msg# obj# selected# shaded# master# end_procedure // (Probably) used by display definition view function DFMatrix_Current_File global returns integer function_return (piCurrentFileInSelector(oDFMatrixViewPanels(self))) end_function function sFdxTitle.i global integer lhFDX returns string local string str# if (piDataOrigin(lhFDX)) eq FDX_EMPTY move "(empty)" to str# else begin if (piDataOrigin(lhFDX)) eq FDX_REAL_WORLD begin if (psFileName(lhFDX)<>"") move ("current ("+psFileName(lhFDX)+")") to str# else move "Current" to str# end else begin if (psTitle(lhFDX)<>"") move (psTitle(lhFDX)+" ("+psFileName(lhFDX)+")") to str# else move (psFileName(lhFDX)) to str# end end function_return str# end_function function DFMatrix_RealDataPrimary global returns integer local integer lhFDX move (fdx.object_id(0)) to lhFDX function_return (piDataOrigin(lhFDX)=FDX_REAL_WORLD) end_function procedure DFMatrix_Update_App_Title global local integer lhFDX local string str# move (fdx.object_id(0)) to lhFDX if (piDataOrigin(lhFDX)) eq FDX_EMPTY move " (empty)" to str# else begin if (piDataOrigin(lhFDX)) eq FDX_REAL_WORLD begin if (psFileName(lhFDX)<>"") move (", current ("+psFileName(lhFDX)+")") to str# else move " (current)" to str# end else begin if (psTitle(lhFDX)<>"") move (", "+psTitle(lhFDX)+" ("+psFileName(lhFDX)+")") to str# else move (" ("+psFileName(lhFDX)+")") to str# end end #IFDEF IS$WINDOWS set DFMatrix_App_Label to (app.dfMatrix.Title+", "+psCurrentWorkSpace(oDFMatrixViewPanels(self))+str#) #ELSE set DFMatrix_App_Label to (app.dfMatrix.Title+str#) #ENDIF end_procedure Procedure DFMatrix_Select_FileList local string lsFilelist lsPath #IFDEF IS$WINDOWS get SEQ_SelectFile "Open FILELIST.CFG" "filelist.cfg|filelist.cfg|*.cfg|*.CFG" to lsFileList #ELSE get SEQ_SelectFile "Open FILELIST.CFG" "filelist.cfg" to lsFileList #ENDIF if (lsFileList<>"") begin get SEQ_ExtractPathFromFileName lsFileList to lsPath send FLIST_SetOpenPath lsPath send FLIST_SetCurrentFilelist lsFileList set psCurrentWorkSpace of (oDFMatrixViewPanels(self)) to lsFilelist set piWorkSpaceLoaded of (oDFMatrixViewPanels(self)) to DFFALSE send DFMatrix_CloseAll send DFMatrix_PrimaryOpenCurrentFilelist end end_procedure #IFDEF IS$WINDOWS Use SelectWorkspace.dg Use WorkSpc.utl Procedure DFMatrix_Clear_WorkSpace End_Procedure Procedure DFMatrix_Select_WorkSpace integer hoWorkspace eOpened string sWorkspace DataPath# FileListPath# WsDescription# get phoWorkspace of ghoApplication To hoWorkspace get WorkSpc_SelectWS to sWorkspace If (sWorkspace<>"") Begin Send DoClearPaths of hoWorkspace Get OpenWorkspace of hoWorkspace sWorkspace To eOpened If (eOpened <> WSWORKSPACEOPENED) Begin send stop_box "The current default workspace is invalid." End else begin get psDataPath of hoWorkspace to DataPath# get psFileList of hoWorkspace to FileListPath# get psDescription of hoWorkspace to WsDescription# send FLIST_SetOpenPath DataPath# send FLIST_SetCurrentFilelist FileListPath# set psCurrentWorkSpace of (oDFMatrixViewPanels(self)) to WsDescription# set piWorkSpaceLoaded of (oDFMatrixViewPanels(self)) to DFTRUE send DFMatrix_CloseAll if (MB_Verify("Open table definitions in the selected workspace?",1)) send DFMatrix_PrimaryOpenCurrentFilelist end end end_procedure #ENDIF //> This procedure will read in the 'current' data definitions in the //> primary slot. procedure DFMatrix_PrimaryOpenCurrentFilelist global send fdx.entry_read_current 0 send DFMatrix_NotifyFdxChange send Activate_Table_Selector end_procedure procedure DFMatrix_PrimaryReread global // This isn't actually a reread send fdx.entry_read_current 0 // (It's called after a restructure) send DFMatrix_NotifyFdxChange end_procedure procedure DFMatrix_SecondaryOpenCurrentFilelist global send fdx.entry_read_current 1 end_procedure procedure DFMatrix_OpenDirectoryContents global local integer lhFDX move (fdx.object_id(0)) to lhFDX if (piDataOrigin(lhFDX)) ne FDX_EMPTY begin send fdx.wait.on if (piDataOrigin(lhFDX)) eq FDX_REAL_WORLD send Read_Directory_Contents to lhFDX if (piDataOrigin(lhFDX)) eq FDX_READ_FROM_FILE send Read_Directory_Contents_From_File to lhFDX send fdx.wait.off send OnChangeFDX to (DFMatrix_Vw_Object_ID(WAY_DIRECTORY_CONTENTS_VW)) send Activate_Directory_Contents end end_procedure register_procedure OnChangeFDX_Broadcasted procedure DFMatrix_NotifyFdxChange global send OnChangeFDX to (DFMatrix_Vw_Object_ID(WAY_GLOBAL_ATTRIBUTES_VW)) send OnChangeFDX to (DFMatrix_Vw_Object_ID(WAY_TABLE_SELECTOR_VW)) send OnChangeFDX to (DFMatrix_Vw_Object_ID(WAY_TABLE_DEFINITION_VW)) send OnChangeFDX to (DFMatrix_Vw_Object_ID(WAY_DIRECTORY_CONTENTS_VW)) send OnChangeFDX to (DFMatrix_Vw_Object_ID(WAY_SET_OF_TABLES_VW)) send OnChangeFDX to (DFMatrix_Vw_Object_ID(WAY_SET_OF_FIELDS_VW)) send OnChangeFDX to (DFMatrix_Vw_Object_ID(WAY_SET_OF_INDICES_VW)) broadcast recursive send OnChangeFDX_Broadcasted to desktop send DFMatrix_Update_App_Title end_procedure procedure DFMatrix_CloseAll global send fdx.reset_all send DFMatrix_Create_FDX send DFMatrix_NotifyFdxChange end_procedure procedure DFMatrix_PrimaryOpenFdxFile global if (fdx.open_file_browse(0)) begin send DFMatrix_NotifyFdxChange send Activate_Table_Selector end end_procedure function DFMatrix_SecondaryOpenFdxFile global returns integer function_return (fdx.open_file_browse(1)) end_function procedure DFMatrix_PrimarySaveFdxAs global local integer lhFDX move (fdx.object_id(0)) to lhFDX if (piDataOrigin(lhFDX)) ne FDX_EMPTY begin send fdx.entry_save_as 0 send DFMatrix_Update_App_Title end end_procedure function DFMatrix_Vw_Active global integer who_are_you# returns integer function_return (active_state(value(oDFMatrixViewPanels(self),who_are_you#))) end_function procedure DFMatrix_Transfer_Set global integer origin# integer target# integer intersection# if target# eq WAY_TABLE_SELECTOR_VW begin if origin# eq WAY_SET_OF_TABLES_VW begin send make_set_of_files to (oFdxSetOfTables(self)) (oAuxFdxSetOfTables(self)) end if origin# eq WAY_SET_OF_FIELDS_VW begin send make_set_of_files to (oFdxSetOfFields(self)) (oAuxFdxSetOfTables(self)) end if origin# eq WAY_SET_OF_INDICES_VW begin send make_set_of_fields to (oFdxSetOfIndices(self)) (oAuxFdxSetOfFields(self)) send make_set_of_files to (oAuxFdxSetOfFields(self)) (oAuxFdxSetOfTables(self)) end if intersection# send DoTableSelector_Intersection to (oAuxFdxSetOfTables(self)) else send DoTableSelector_Union to (oAuxFdxSetOfTables(self)) send Activate_Table_Selector end if target# eq WAY_SET_OF_TABLES_VW begin if origin# eq WAY_SET_OF_FIELDS_VW begin send make_set_of_files to (oFdxSetOfFields(self)) (oAuxFdxSetOfTables(self)) end if origin# eq WAY_SET_OF_INDICES_VW begin send make_set_of_fields to (oFdxSetOfIndices(self)) (oAuxFdxSetOfFields(self)) send make_set_of_files to (oAuxFdxSetOfFields(self)) (oAuxFdxSetOfTables(self)) end if intersection# send DoInterSection.i to (oFdxSetOfTables(self)) (oAuxFdxSetOfTables(self)) else send DoUnion.i to (oFdxSetOfTables(self)) (oAuxFdxSetOfTables(self)) send update_display to (DFMatrix_Vw_Object_ID(WAY_SET_OF_TABLES_VW)) send Activate_SetOfTables end if target# eq WAY_SET_OF_FIELDS_VW begin if origin# eq WAY_SET_OF_INDICES_VW begin send make_set_of_fields to (oFdxSetOfIndices(self)) (oAuxFdxSetOfFields(self)) end if intersection# send DoInterSection.i to (oFdxSetOfFields(self)) (oAuxFdxSetOfFields(self)) else send DoUnion.i to (oFdxSetOfFields(self)) (oAuxFdxSetOfFields(self)) send update_display to (DFMatrix_Vw_Object_ID(WAY_SET_OF_FIELDS_VW)) send Activate_SetOfFields end end_procedure // ********************** REPORT UTILITY SECTION *************************** // The order in which these symbols are defined determines the order in which // the reports appear in the report pull down menu: enumeration_list // FDX report identifiers define FDXRPT_VALIDY_CHECK // Check validity of table definitions define FDXRPT_RELATION_TREE define FDXRPT_DEFINITION define FDXRPT_GLOBAL_ATTR define FDXRPT_FIND_FIELDS // Locate fields with specific characteristics end_enumeration_list object oFdxReportArray is a cArray item_property_list item_property string psTitle.i item_property integer piPreCond.i item_property integer piUI_Object.i end_item_property_list end_object procedure fdx.add_report global integer row# string title# integer obj# integer precond# local integer arr# move (oFdxReportArray(self)) to arr# set psTitle.i of arr# row# to title# set piUI_Object.i of arr# row# to obj# set piPreCond.i of arr# row# to precond# end_procedure #IFDEF IS$WINDOWS class fdxrpt.ModalClient is a aps.ModalPanel #ELSE class fdxrpt.ModalClient is a app.ModalClient #ENDIF procedure construct_object integer img# forward send construct_object img# on_key kcancel send cancel on_key ksave_record send DoReport on_key key_ctrl+key_r send DoReport on_key key_ctrl+key_s send DoProperties property integer piId public 0 property string psTitle public "" property integer piPrecond public 0 property integer piFDX_Server public 0 property integer piDontRegister public 0 // Should the report automatically register with the main menu #IFDEF IS$WINDOWS set locate_mode to CENTER_ON_SCREEN #ELSE set location to 2 0 absolute #ENDIF end_procedure procedure define_report integer id# string title# integer precond# set piId to id# set psTitle to title# set piPrecond to precond# end_procedure procedure DoReport end_procedure procedure DoProperties end_procedure procedure Callback_Filelist_Entry integer file# integer selected# integer shaded# end_procedure procedure Callback_Filelist_Entries integer selected# integer shaded# local integer oLst# get DFMatrix_SelectorObject to oLst# send Callback_General to oLst# msg_CallBack_Filelist_Entry self selected# shaded# end_procedure procedure end_construct_object forward send end_construct_object ifnot (piDontRegister(self)) send fdx.add_report (piId(self)) (psTitle(self)) self (piPrecond(self)) end_procedure procedure DoDefaults end_procedure procedure popup set piFDX_Server to (fdx.object_id(0)) send DoDefaults forward send popup end_procedure end_class // fdxrpt.client //enumeration_list // define DFMOP_NONE // No opearion // define DFMOP_PRIMLOAD // Load primary FDX // define DFMOP_OPENVIEW // Open a view //end_enumeration_list #IFDEF IS$WINDOWS #ELSE enumeration_list define DFM_BATCH_IGNORE_DISPLAY_NAME define DFM_BATCH_IGNORE_MAX_RECORDS define DFM_BATCH_IGNORE_COMPRESSION define DFM_BATCH_IGNORE_INTEGRITY_CHECK define DFM_BATCH_IGNORE_LOCK_TYPE define DFM_BATCH_IGNORE_MULTI_USER define DFM_BATCH_IGNORE_REUSE_DELETED define DFM_BATCH_IGNORE_TRANSACTION_SETTING define DFM_BATCH_IGNORE_ROOT_NAME define DFM_BATCH_IGNORE_RECORD_LENGTH define DFM_BATCH_IGNORE_RECORD_IDENTITY define DFM_BATCH_FORCE_REINDEX_STATE define DFM_BATCH_FREE_RECORDS_MIN_PERCENT define DFM_BATCH_FREE_RECORDS_NEW_PERCENT end_enumeration_list object oBatchModeParameters is a cArray NO_IMAGE property string psFileName public "" item_property_list item_property string psName.i item_property string psValue.i item_property integer piType.i // 0=Bool 1=String item_property string psDiscreteValues.i end_item_property_list procedure Reset set psValue.i DFM_BATCH_IGNORE_DISPLAY_NAME to 0 set psValue.i DFM_BATCH_IGNORE_MAX_RECORDS to 1 set psValue.i DFM_BATCH_IGNORE_COMPRESSION to 0 set psValue.i DFM_BATCH_IGNORE_INTEGRITY_CHECK to 0 set psValue.i DFM_BATCH_IGNORE_LOCK_TYPE to 1 set psValue.i DFM_BATCH_IGNORE_MULTI_USER to 1 set psValue.i DFM_BATCH_IGNORE_REUSE_DELETED to 0 set psValue.i DFM_BATCH_IGNORE_TRANSACTION_SETTING to 1 set psValue.i DFM_BATCH_IGNORE_ROOT_NAME to 0 set psValue.i DFM_BATCH_IGNORE_RECORD_LENGTH to 0 set psValue.i DFM_BATCH_IGNORE_RECORD_IDENTITY to 0 set psValue.i DFM_BATCH_FORCE_REINDEX_STATE to "OFF" set psValue.i DFM_BATCH_FREE_RECORDS_MIN_PERCENT to 25 set psValue.i DFM_BATCH_FREE_RECORDS_NEW_PERCENT to 50 set psFileName to "" end_procedure send Reset procedure add_parameter integer liRow string lsName integer liType string lsDiscreteValues set psName.i liRow to lsName set piType.i liRow to liType set psDiscreteValues.i liRow to lsDiscreteValues end_procedure send add_parameter DFM_BATCH_IGNORE_DISPLAY_NAME "IGNORE DISPLAY NAME" 0 "" send add_parameter DFM_BATCH_IGNORE_MAX_RECORDS "IGNORE MAX RECORDS" 0 "" send add_parameter DFM_BATCH_IGNORE_COMPRESSION "IGNORE COMPRESSION" 0 "" send add_parameter DFM_BATCH_IGNORE_INTEGRITY_CHECK "IGNORE INTEGRITY CHECK" 0 "" send add_parameter DFM_BATCH_IGNORE_LOCK_TYPE "IGNORE LOCK TYPE" 0 "" send add_parameter DFM_BATCH_IGNORE_MULTI_USER "IGNORE MULTI USER" 0 "" send add_parameter DFM_BATCH_IGNORE_REUSE_DELETED "IGNORE REUSE DELETED" 0 "" send add_parameter DFM_BATCH_IGNORE_TRANSACTION_SETTING "IGNORE TRANSACTION SETTING" 0 "" send add_parameter DFM_BATCH_IGNORE_ROOT_NAME "IGNORE ROOT NAME" 0 "" send add_parameter DFM_BATCH_IGNORE_RECORD_LENGTH "IGNORE RECORD LENGTH" 0 "" send add_parameter DFM_BATCH_IGNORE_RECORD_IDENTITY "IGNORE RECORD IDENTITY" 0 "" send add_parameter DFM_BATCH_FORCE_REINDEX_STATE "FORCE REINDEX STATE" 1 "OFF|ON|ALL" send add_parameter DFM_BATCH_FREE_RECORDS_MIN_PERCENT "MIN FREE RECORDS PERCENT" 1 "" send add_parameter DFM_BATCH_FREE_RECORDS_NEW_PERCENT "FREE RECORDS RESIZE PERCENT" 1 "" function iFindName.s string lsName returns integer local integer liMax liRow get row_count to liMax decrement liMax for liRow from 0 to liMax if (psName.i(self,liRow)=lsName) function_return liRow loop function_return -1 end_function procedure SEQ_Read_Value string lsLine local integer liType liRow local string lsName lsValue get ExtractWord lsLine "=" 1 to lsName get ExtractWord lsLine "=" 2 to lsValue move (uppercase(trim(lsName))) to lsName move (uppercase(trim(lsValue))) to lsValue get iFindName.s lsName to liRow if (liRow<>-1) begin get piType.i liRow to liType if (liType=0) begin // Boolean if (lsValue="TRUE") set psValue.i liRow to 1 else set psValue.i liRow to 0 end if (liType=1) begin // String set psValue.i liRow to lsValue end end end_procedure function sRemoveComments string lsLine returns string local integer liPos move (pos("/"+"/",lsLine)) to liPos if liPos move (left(lsLine,liPos-1)) to lsLine function_return (trim(lsLine)) end_function define DFM_BATCH_RESTRUCTURE_PARAMETERS_CHECK for "File ID: DFMatrix batch restructure parameters" procedure SEQ_ReadFile string lsFile local integer liChannel lbSeqEof local string lsLine lsValue lsCheckLine get SEQ_DirectInput lsFile to liChannel if (liChannel>=0) begin send Reset readln channel liChannel lsCheckLine if (lsCheckLine=DFM_BATCH_RESTRUCTURE_PARAMETERS_CHECK) begin repeat readln channel liChannel lsLine move (seqeof) to lbSeqEof ifnot lbSeqEof begin get sRemoveComments lsLine to lsLine if (lsLine<>"") begin send SEQ_Read_Value lsLine end end until lbSeqEof send SEQ_CloseInput liChannel set psFileName to lsFile end else begin move "Incompatible param file (#)" to lsValue move (replace("#",lsValue,lsFile)) to lsValue error 961 lsValue end end else begin move "Param file not found (#)" to lsValue move (replace("#",lsValue,lsFile)) to lsValue error 955 lsValue end end_procedure procedure SEQ_Write_Boolean integer liChannel string lsName integer lbValue write channel liChannel (pad(lsName,30)+"=") if lbValue writeln "TRUE" else writeln "FALSE" end_procedure procedure SEQ_Write_String integer liChannel string lsName string lsValue writeln channel liChannel (pad(lsName,30)+"="+lsValue) end_procedure procedure SEQ_WriteFile string lsFile local integer liChannel liMax liRow get SEQ_DirectOutput lsFile to liChannel if (liChannel>=0) begin writeln channel liChannel DFM_BATCH_RESTRUCTURE_PARAMETERS_CHECK // "DFMatrix batch restructure parameters" get row_count to liMax decrement liMax for liRow from 0 to liMax if (piType.i(self,liRow)=0) send SEQ_Write_Boolean liChannel (psName.i(self,liRow)) (psValue.i(self,liRow)) if (piType.i(self,liRow)=1) send SEQ_Write_String liChannel (psName.i(self,liRow)) (psValue.i(self,liRow)) loop send SEQ_CloseOutput liChannel set psFileName to lsFile end end_procedure end_object object oBatchModeLogFile is a cLogFile property integer pbFileSpefified public false set psFileName to "dfm.log" // Write to this file set piCloseOnWrite to DFTRUE // Close the log file after each write set psPurpose to "Events during DFMatrix batchmode" procedure WriteLn string lsLine if (pbFileSpefified(self)) forward send WriteLn lsLine end_procedure procedure DoWriteTimeEntry string lsLine if (pbFileSpefified(self)) forward send DoWriteTimeEntry lsLine end_procedure end_object // oBatchModeLogFile object oBatchModeErrorHandler is a cErrorHandlerRedirector NO_IMAGE procedure OnError integer liError string lsErrorText integer liErrorLine local string lsLogLine move " ERROR: # on line #: #" to lsLogLine move (replace("#",lsLogLine,IntToStrR(liError,4))) to lsLogLine move (replace("#",lsLogLine,IntToStrR(liErrorLine,6))) to lsLogLine move (replace("#",lsLogLine,trim(lsErrorText))) to lsLogLine send DoWriteTimeEntry to (oBatchModeLogFile(self)) lsLogLine end_procedure end_object // oBatchModeErrorHandler /oDFMCreateParameterFile.hdr ÉÍEdit restructure parameter fileÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» º º º____________________________________________________________º /oDFMCreateParameterFile.frm º º º ___ Ignore Display Name º º ___ Ignore Max Records º º ___ Ignore Compression º º ___ Ignore Integrity Check º º ___ Ignore Lock Type º º ___ Ignore Multi User º º ___ Ignore Reuse Deleted º º ___ Ignore Transaction Setting º º ___ Ignore Root Name º º ___ Ignore Record Length º º ___ Ignore Record Identity º /oDFMCreateParameterFile.index º Re-index: ___ Auto ___ Force ___ All º /oDFMCreateParameterFile.free º Minimum free records: _.% º º Resize free records: _.% º º º /oDFMCreateParameterFile.btn º _____________ _____________ _____________ _____________ º º Ctrl+O F2 Ctrl+S Esc º ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ /* Use App.utl // Character Mode classes Use Buttons.utl // Button texts object oDFMCreateParameterFile is a app.ModalClient oDFMCreateParameterFile.hdr set location to 2 9 absolute on_key ksave_record send ok on_key kcancel send cancel on_key key_ctrl+key_a send select_all set center_state item 0 to true object oFrm is a Form oDFMCreateParameterFile.frm set location to 3 0 relative set select_mode to MULTI_SELECT item_list on_item "" send none set checkbox_item_state to DFTRUE on_item "" send none set checkbox_item_state to DFTRUE on_item "" send none set checkbox_item_state to DFTRUE on_item "" send none set checkbox_item_state to DFTRUE on_item "" send none set checkbox_item_state to DFTRUE on_item "" send none set checkbox_item_state to DFTRUE on_item "" send none set checkbox_item_state to DFTRUE on_item "" send none set checkbox_item_state to DFTRUE on_item "" send none set checkbox_item_state to DFTRUE on_item "" send none set checkbox_item_state to DFTRUE on_item "" send none set checkbox_item_state to DFTRUE end_item_list end_object object oRad is a Radio oDFMCreateParameterFile.index set location to 15 0 relative set select_mode to AUTO_SELECT item_list on_item "" send none on_item "" send none on_item "" send none end_item_list end_object object oFree is a Form oDFMCreateParameterFile.free set location to 16 0 relative item_list on_item "" send "" on_item "" send "" end_item_list end_object procedure select_all local integer lbState get select_state of (oFrm(self)) item 0 to lbState move (not(lbState)) to lbState set select_state of (oFrm(self)) item 0 to lbState set select_state of (oFrm(self)) item 1 to lbState set select_state of (oFrm(self)) item 2 to lbState set select_state of (oFrm(self)) item 3 to lbState set select_state of (oFrm(self)) item 4 to lbState set select_state of (oFrm(self)) item 5 to lbState set select_state of (oFrm(self)) item 6 to lbState set select_state of (oFrm(self)) item 7 to lbState set select_state of (oFrm(self)) item 8 to lbState set select_state of (oFrm(self)) item 9 to lbState set select_state of (oFrm(self)) item 10 to lbState end_procedure procedure do_entry_display local integer lhObj lhFrm local string lsValue move (oBatchModeParameters(self)) to lhObj move (oFrm(self)) to lhFrm set value item 0 to (psFileName(lhObj)) set select_state of lhFrm item 0 to (integer(psValue.i(lhObj,DFM_BATCH_IGNORE_DISPLAY_NAME ))) set select_state of lhFrm item 1 to (integer(psValue.i(lhObj,DFM_BATCH_IGNORE_MAX_RECORDS ))) set select_state of lhFrm item 2 to (integer(psValue.i(lhObj,DFM_BATCH_IGNORE_COMPRESSION ))) set select_state of lhFrm item 3 to (integer(psValue.i(lhObj,DFM_BATCH_IGNORE_INTEGRITY_CHECK ))) set select_state of lhFrm item 4 to (integer(psValue.i(lhObj,DFM_BATCH_IGNORE_LOCK_TYPE ))) set select_state of lhFrm item 5 to (integer(psValue.i(lhObj,DFM_BATCH_IGNORE_MULTI_USER ))) set select_state of lhFrm item 6 to (integer(psValue.i(lhObj,DFM_BATCH_IGNORE_REUSE_DELETED ))) set select_state of lhFrm item 7 to (integer(psValue.i(lhObj,DFM_BATCH_IGNORE_TRANSACTION_SETTING))) set select_state of lhFrm item 8 to (integer(psValue.i(lhObj,DFM_BATCH_IGNORE_ROOT_NAME ))) set select_state of lhFrm item 9 to (integer(psValue.i(lhObj,DFM_BATCH_IGNORE_RECORD_LENGTH ))) set select_state of lhFrm item 10 to (integer(psValue.i(lhObj,DFM_BATCH_IGNORE_RECORD_IDENTITY ))) get psValue.i of lhObj DFM_BATCH_FORCE_REINDEX_STATE to lsValue if (lsValue="OFF") set current_item of (oRad(self)) to 0 if (lsValue="ON") set current_item of (oRad(self)) to 1 if (lsValue="ALL") set current_item of (oRad(self)) to 2 set value of (oFree(self)) item 0 to (psValue.i(lhObj,DFM_BATCH_FREE_RECORDS_MIN_PERCENT)) set value of (oFree(self)) item 1 to (psValue.i(lhObj,DFM_BATCH_FREE_RECORDS_NEW_PERCENT)) end_procedure send do_entry_display procedure do_entry_update local integer lhObj lhFrm move (oBatchModeParameters(self)) to lhObj move (oFrm(self)) to lhFrm set psValue.i of lhObj DFM_BATCH_IGNORE_DISPLAY_NAME to (select_state(lhFrm, 0)) set psValue.i of lhObj DFM_BATCH_IGNORE_MAX_RECORDS to (select_state(lhFrm, 1)) set psValue.i of lhObj DFM_BATCH_IGNORE_COMPRESSION to (select_state(lhFrm, 2)) set psValue.i of lhObj DFM_BATCH_IGNORE_INTEGRITY_CHECK to (select_state(lhFrm, 3)) set psValue.i of lhObj DFM_BATCH_IGNORE_LOCK_TYPE to (select_state(lhFrm, 4)) set psValue.i of lhObj DFM_BATCH_IGNORE_MULTI_USER to (select_state(lhFrm, 5)) set psValue.i of lhObj DFM_BATCH_IGNORE_REUSE_DELETED to (select_state(lhFrm, 6)) set psValue.i of lhObj DFM_BATCH_IGNORE_TRANSACTION_SETTING to (select_state(lhFrm, 7)) set psValue.i of lhObj DFM_BATCH_IGNORE_ROOT_NAME to (select_state(lhFrm, 8)) set psValue.i of lhObj DFM_BATCH_IGNORE_RECORD_LENGTH to (select_state(lhFrm, 9)) set psValue.i of lhObj DFM_BATCH_IGNORE_RECORD_IDENTITY to (select_state(lhFrm,10)) if (current_item(oRad(self))=0) set psValue.i of lhObj DFM_BATCH_FORCE_REINDEX_STATE to "OFF" if (current_item(oRad(self))=1) set psValue.i of lhObj DFM_BATCH_FORCE_REINDEX_STATE to "ON" if (current_item(oRad(self))=2) set psValue.i of lhObj DFM_BATCH_FORCE_REINDEX_STATE to "ALL" set psValue.i of lhObj DFM_BATCH_FREE_RECORDS_MIN_PERCENT to (value(oFree(self),0)) set psValue.i of lhObj DFM_BATCH_FREE_RECORDS_NEW_PERCENT to (value(oFree(self),1)) end_procedure procedure DoOpen local string lsFile get SEQ_SelectFileStartDir "Select restructure parameter file" "*.txt" (SEQ_CurrentFolder()) to lsFile if (lsFile<>"") begin send SEQ_ReadFile to (oBatchModeParameters(self)) lsFile send do_entry_display end end_procedure procedure DoSaveAs local string lsFile get SEQ_SelectOutFileStartDir "Save restructure parameter file" "*.txt" (SEQ_CurrentFolder()) to lsFile if (lsFile<>"") begin send do_entry_update send SEQ_WriteFile to (oBatchModeParameters(self)) lsFile send do_entry_display send obs "Parameters have been saved to" lsFile end end_procedure procedure DoSave local string lsFile get psFileName of (oBatchModeParameters(self)) to lsFile if (lsFile<>"") begin send do_entry_update send SEQ_WriteFile to (oBatchModeParameters(self)) lsFile send obs "Parameters have been saved to" lsFile end else send DoSaveAs end_procedure on_key KEY_CTRL+KEY_O send DoOpen on_key KSAVE_RECORD send DoSave on_key KEY_CTRL+KEY_S send DoSaveAs object oBtn is a app.Button oDFMCreateParameterFile.btn set location to 19 0 relative item_list on_item "Open" send DoOpen on_item "Save" send DoSave on_item "Save as" send DoSaveAs on_item "Close" send cancel end_item_list end_object procedure popup local integer liRval ui_accept self to liRval end_procedure end_object // oDFMCreateParameterFile procedure DFMatrix_EditParameterFile send popup to (oDFMCreateParameterFile(self)) end_procedure register_object oStructPgmArray_Vw register_object oFdxCompareDefinitions_Pn register_object oFdxTableCompare register_object oNewMaxRecords register_object oLst register_object oListOfTablesAndFieldsThatItIsOkToDropAndDelete register_object oStructure_LogFile object oDFM_BatchProgram is a cArray NO_IMAGE property integer pbBatch public 0 item_property_list item_property string psInstr.i item_property string psArg.i end_item_property_list procedure dfmp_OpenDataPath string lsPath send FLIST_SetOpenPath lsPath set psCurrentWorkSpace of (oDFMatrixViewPanels(self)) to "filelist.cfg" set piWorkSpaceLoaded of (oDFMatrixViewPanels(self)) to DFTRUE send DFMatrix_CloseAll send DFMatrix_PrimaryOpenCurrentFilelist end_procedure procedure dfmp_WriteFDX string lsFile local integer liChannel lhFDX move (fdx.object_id(0)) to lhFDX move (SEQ_DirectOutput(lsFile)) to liChannel if (liChannel>=0) begin set psFileName of lhFDX to lsFile send Seq_Write to lhFDX liChannel send SEQ_CloseOutput liChannel end else error 956 "Could not write FDX file" end_procedure procedure dfmp_ReadReferenceFDX string lsFile local integer liChannel lhFDX move (fdx.object_id(1)) to lhFDX get SEQ_DirectInput lsFile to liChannel if (liChannel>=0) begin send Seq_Read to lhFDX liChannel send SEQ_CloseInput liChannel end else error 957 "FDX reference file not found" end_procedure procedure dfmp_ReadAllowedDrops string lsFile local integer liChannel get SEQ_DirectInput lsFile to liChannel if (liChannel>=0) begin send Seq_Read to (oListOfTablesAndFieldsThatItIsOkToDropAndDelete(self)) liChannel send SEQ_CloseInput liChannel end else error 958 "Could not read allowed drops" end_procedure procedure dfmp_WriteAllowedDrops string lsFile local integer liChannel move (SEQ_DirectOutput(lsFile)) to liChannel if (liChannel>=0) begin send Seq_Write to (oListOfTablesAndFieldsThatItIsOkToDropAndDelete(self)) liChannel send SEQ_CloseOutput liChannel end else error 959 "Could not write allowed drops" end_procedure procedure dfmp_GenAllowedDrops // local integer lhPgmArr // get piStructPgm_Server of (oStructPgmArray_Vw(self)) to lhPgmArr send generate_list_of_tables_and_fields_that_it_is_ok_to_drop_and_delete to (oLst(oStructPgmArray_Vw(self))) end_procedure procedure dfmp_DeleteFile string lsFile local integer lbOK if (SEQ_FileExists(lsFile)<>SEQIT_FILE) send DoWriteTimeEntry to (oBatchModeLogFile(self)) (" File not found ("+lsFile+")") else begin get SEQ_EraseFile lsFile to lbOK ifnot lbOK if (SEQ_FileExists(lsFile)=SEQIT_FILE) send DoWriteTimeEntry to (oBatchModeLogFile(self)) (" File could not be erased ("+lsFile+")") end end_procedure procedure dfmp_ReindexAll local integer liGrb local string lsLogFile runprogram wait "cls" runprogram wait "dfsort -a" send refresh_screen get DfmBatchMode_LogfileName to lsLogFile get SEQ_AppendFiles lsLogFile "dfsort.log" to liGrb end_procedure procedure ExecuteProgram local integer liRow liMax lhObj1 lhObj2 local string lsInstr lsArg lsLogFileName lsVal move "" to lsLogFileName get row_count to liMax decrement liMax for liRow from 0 to liMax get psInstr.i liRow to lsInstr get psArg.i liRow to lsArg send DoWriteTimeEntry to (oBatchModeLogFile(self)) ("**** "+lsInstr*lsArg+" ****") if (lsInstr="OpenDataPath") begin send dfmp_OpenDataPath lsArg end if (lsInstr="CloseDataPath") begin send DFMatrix_CloseAll end if (lsInstr="WriteFDX") begin send dfmp_WriteFDX lsArg end if (lsInstr="ReadReferenceFDX") begin send dfmp_ReadReferenceFDX lsArg end if (lsInstr="CompareAll") begin send Activate_RestructPrograms to desktop send reset_list to (oStructPgmArray_Vw(self)) send Initialise to (oFdxCompareDefinitions_Pn(self)) send DoAll to (oFdxCompareDefinitions_Pn(self)) send post_compare to (oStructPgmArray_Vw(self)) // Change of maximum number of records are added here: move (oBatchModeParameters(self)) to lhObj1 if (integer(psValue.i(lhObj1,DFM_BATCH_IGNORE_MAX_RECORDS))) begin // If ignore the comparison value if (integer(psValue.i(lhObj1,DFM_BATCH_FREE_RECORDS_MIN_PERCENT))) begin // If minimum value has been specified send precond_setup to (oNewMaxRecords(self)) send AutoSetParameters to (oNewMaxRecords(self)) (integer(psValue.i(lhObj1,DFM_BATCH_FREE_RECORDS_MIN_PERCENT))) (integer(psValue.i(lhObj1,DFM_BATCH_FREE_RECORDS_NEW_PERCENT))) send Post_MaxRecords to (oLst(oStructPgmArray_Vw(self))) end end end if (lsInstr="CompareOne") begin error 954 "CompareOne not implemented" end if (lsInstr="CompareReport") begin if (lsLogFileName<>"") send DoReportPrograms to (oStructPgmArray_Vw(self)) lsLogFileName else error 960 "Log file name not specified" end if (lsInstr="Restructure") begin send request_execute_all to (oStructPgmArray_Vw(self)) end if (lsInstr="SetLogFile") begin // Our own batch specific log file: set pbFileSpefified of (oBatchModeLogFile(self)) to true send AppendOutput to (oBatchModeLogFile(self)) lsArg // The restructure specific log file: //set psFileName of (oStructure_LogFile(self)) to lsArg move lsArg to lsLogFileName end if (lsInstr="SetParameterFile") begin move (oBatchModeParameters(self)) to lhObj1 send SEQ_ReadFile to lhObj1 lsArg move (oFdxTableCompare(self)) to lhObj2 set piIgnore_DisplayName of lhObj2 to (psValue.i(lhObj1,DFM_BATCH_IGNORE_DISPLAY_NAME)) set piIgnore_MaxRecords of lhObj2 to (psValue.i(lhObj1,DFM_BATCH_IGNORE_MAX_RECORDS)) set piIgnore_Compression of lhObj2 to (psValue.i(lhObj1,DFM_BATCH_IGNORE_COMPRESSION)) set piIgnore_IntegrityCheck of lhObj2 to (psValue.i(lhObj1,DFM_BATCH_IGNORE_INTEGRITY_CHECK)) set piIgnore_LockType of lhObj2 to (psValue.i(lhObj1,DFM_BATCH_IGNORE_LOCK_TYPE)) set piIgnore_MultiUser of lhObj2 to (psValue.i(lhObj1,DFM_BATCH_IGNORE_MULTI_USER)) set piIgnore_ReuseDeleted of lhObj2 to (psValue.i(lhObj1,DFM_BATCH_IGNORE_REUSE_DELETED)) set piIgnore_TransactionSetting of lhObj2 to (psValue.i(lhObj1,DFM_BATCH_IGNORE_TRANSACTION_SETTING)) set piIgnore_Rootname of lhObj2 to (psValue.i(lhObj1,DFM_BATCH_IGNORE_ROOT_NAME)) set piIgnore_RecordLength of lhObj2 to (psValue.i(lhObj1,DFM_BATCH_IGNORE_RECORD_LENGTH)) set piIgnore_RecordIdentity of lhObj2 to (psValue.i(lhObj1,DFM_BATCH_IGNORE_RECORD_IDENTITY)) get psValue.i of lhObj1 DFM_BATCH_FORCE_REINDEX_STATE to lsVal if (lsVal="ON") send ForceIndex_On to (oStructPgmArray_Vw(self)) else send ForceIndex_Off to (oStructPgmArray_Vw(self)) if (lsVal="ALL") send ForceIndex_All to (oStructPgmArray_Vw(self)) end if (lsInstr="SetCaption") begin send DfApp.Title_Bar lsArg end if (lsInstr="ReadAllowedDrops") begin send dfmp_ReadAllowedDrops lsArg end if (lsInstr="WriteAllowedDrops") begin send dfmp_WriteAllowedDrops lsArg end if (lsInstr="GenAllowedDrops") begin send dfmp_GenAllowedDrops end if (lsInstr="ResetAllowedDrops") begin send delete_data to (oListOfTablesAndFieldsThatItIsOkToDropAndDelete(self)) end if (lsInstr="DeleteFile") begin send dfmp_DeleteFile lsArg end if (lsInstr="ReindexAll") begin send dfmp_ReindexAll lsArg end if (lsInstr="Exit") begin system end loop end_procedure function sRemoveComments string lsLine returns string local integer liPos move (pos("/"+"/",lsLine)) to liPos if liPos move (left(lsLine,liPos-1)) to lsLine function_return (trim(lsLine)) end_function function sLineInstr string lsLine returns string move (ExtractWord(lsLine," ",1)) to lsLine move (lowercase(lsLine)) to lsLine if (lsLine="") function_return "" if (lsLine="opendatapath") function_return "OpenDataPath" if (lsLine="closedatapath") function_return "CloseDataPath" if (lsLine="writefdx") function_return "WriteFDX" if (lsLine="readreferencefdx") function_return "ReadReferenceFDX" if (lsLine="compareall") function_return "CompareAll" if (lsLine="compareone") function_return "CompareOne" if (lsLine="comparereport") function_return "CompareReport" if (lsLine="restructure") function_return "Restructure" if (lsLine="setlogfile") function_return "SetLogFile" if (lsLine="setparameterfile") function_return "SetParameterFile" if (lsLine="setcaption") function_return "SetCaption" if (lsLine="readalloweddrops") function_return "ReadAllowedDrops" if (lsLine="writealloweddrops") function_return "WriteAllowedDrops" if (lsLine="genalloweddrops") function_return "GenAllowedDrops" if (lsLine="resetalloweddrops") function_return "ResetAllowedDrops" if (lsLine="deletefile") function_return "DeleteFile" if (lsLine="reindexall") function_return "ReindexAll" if (lsLine="exit") function_return "Exit" function_return "error" end_function function sLineArg string lsLine returns string local string lsInstr move (ExtractWord(lsLine," ",1)) to lsInstr move (replace(lsInstr,lsLine,"")) to lsLine function_return (trim(lsLine)) end_function procedure DoProgram string lsFile local integer liChannel lbSeqEof lbError liLine liRow local string lsLine lsInstr lsArg get SEQ_DirectInput lsFile to liChannel if (liChannel>=0) begin set pbBatch to true move 0 to liLine move 0 to lbError repeat readln channel liChannel lsLine move (SeqEof) to lbSeqEof ifnot lbSeqEof begin increment liLine get sRemoveComments lsLine to lsLine get sLineInstr lsLine to lsInstr if (lsInstr<>"") begin if (lsInstr<>"error") begin get sLineArg lsLine to lsArg get row_count to liRow set psInstr.i liRow to lsInstr set psArg.i liRow to lsArg end else begin error 953 ("Command not found in line "+string(liLine)) move 1 to lbError end end end until lbSeqEof send SEQ_CloseInput liChannel ifnot lbError send ExecuteProgram set pbBatch to false end else error 951 ("DFM batch file not found, "+lsFile) end_procedure end_object // oDFM_BatchProgram procedure DoDfMatrixCommandLine for desktop local integer liPos local string lsFile get CmdLineFindParamValue "-cmd" true to liPos if (liPos<>-1) begin get CmdLineParamValue (liPos+1) to lsFile if (lsFile<>"") begin send DoActivate to (oBatchModeErrorHandler(self)) send DoProgram to (oDFM_BatchProgram(self)) lsFile send DoDeactivate to (oBatchModeErrorHandler(self)) end else error 952 "Missing command file on command line" end end_procedure #ENDIF function DfmBatchMode global returns integer #IFDEF IS$WINDOWS function_return 0 #ELSE function_return (pbBatch(oDFM_BatchProgram(self))) #ENDIF end_function function DfmBatchMode_LogfileName global returns string #IFDEF IS$WINDOWS #ELSE local string lsValue get psFileName of (oStructure_LogFile(self)) to lsValue function_return lsValue #ENDIF end_function procedure DFMatrix_Login global local integer rval# driver# local string server# user# pw# get DBMS_GetDriverLogin 0 to rval# if rval# begin get DBMS_GetDriverLoginDriverID to driver# get DBMS_GetDriverLoginServer to server# get DBMS_GetDriverLoginUserID to user# get DBMS_GetDriverLoginPassWord to pw# login server# user# pw# (DBMS_TypeToDriverName(driver#)) end end_procedure procedure DFMatrix_Logout global logout end_procedure #IFDEF IS$WINDOWS #ELSE class fdxrpt.button is a app.Button procedure construct_object integer img# forward send construct_object img# item_list on_item "Run" send DoReport on_item "Setup" send DoProperties on_item "Close" send Cancel end_item_list end_procedure end_class // fdxrpt.button #ENDIF class fdxrpt.report_control is a cArray procedure construct_object integer img# forward send construct_object img# end_procedure end_class // fdxrpt.report_control // ********************** REPORT UTILITY SECTION *************************** function DFMatrix_RealData_Check global returns integer // local integer liDataOrigin move (piDataOrigin(fdx.object_id(0))) to liDataOrigin if (liDataOrigin=FDX_REAL_WORLD) function_return 1 if (liDataOrigin=FDX_READ_FROM_FILE) send obs "You cannot execute this function on definitions read from an FDX file" else send obs "In order to execute this function you need to read some" "table definitions first (use the 'File' menu)." end_function function DFMatrix_Primary_Origin global returns integer function_return (piDataOrigin(fdx.object_id(0))) end_function on_key key_ctrl+key_t send Request_Activate_Table_Selector procedure Request_Activate_Table_Selector send Focus_Analyze_Focus ifnot (integer(Focus_Info(FOCUS_DEO_MODAL))) send Activate_Table_Selector end_procedure