// Use StrucPgm.vw // View for creating and executing RS programs Use StrucPgm.utl // Class for storing a sequence of restructure instructions Use FdxCompa.nui // Class for comparing table definitions Use StrucPgm.pkg // Display restructure program (procedure StructPgm_Display) Use StrucTrc.utl // Object for tracing a restructure operation Use LogFile.pkg // Object for specifying log file properties Use Spec0007.utl // Display modal text (DoDisplayText) Use WildCard.nui // WildCardMatch function Use Files.utl // Utilities for handling file related stuff desktop_section object oFdxRestructureProgramArray_StrucPgm is a cFdxRestructureProgramArray NO_IMAGE procedure save_browse local integer liChannel row# max# obj# local string fn# get row_count to max# if max# begin #IFDEF IS$WINDOWS move (SEQ_SelectOutFile("Restructure Program File destination (*.rpf)","Restructure program file|*.rpf")) to fn# #ELSE move (SEQ_SelectOutFile("Restructure Program File destination","*.rpf")) to fn# #ENDIF if fn# ne "" begin move (SEQ_DirectOutput(fn#)) to liChannel if liChannel ge 0 begin for row# from 0 to (max#-1) writeln channel liChannel (piFile.i(self,row#)) writeln (psRootName.i(self,row#)) get piObject.i row# to obj# send Seq_Write to obj# liChannel loop send SEQ_CloseOutput liChannel end end end end_procedure procedure open_browse local integer fin# obj# file# row# liChannel local string fn# #IFDEF IS$WINDOWS move (SEQ_SelectFile("Select Restructure Program File (*.rpf)","Restructure program file|*.rpf")) to fn# #ELSE move (SEQ_SelectFile("Select Restructure Program File","*.rpf")) to fn# #ENDIF if fn# ne "" begin move (SEQ_DirectInput(fn#)) to liChannel if liChannel ge 0 begin send reset repeat move (SEQ_ReadLn(liChannel)) to file# move (seqeof) to fin# ifnot fin# begin get row_count to row# set piFile.i row# to file# set psRootName.i row# to (SEQ_ReadLn(liChannel)) get iCreateFdxRestructureProgram to obj# set piObject.i row# to obj# send Seq_Read to obj# liChannel end until fin# send SEQ_CloseInput liChannel end end end_procedure end_object // oFdxRestructureProgramArray_StrucPgm end_desktop_section // NEWTHING #IFDEF IS$WINDOWS class cNewMaxRecordsList is a aps.Grid #ELSE Use NewHelp.utl // Internal help system class cNewMaxRecordsList is a app.List #ENDIF procedure construct_object integer liImage forward send construct_object liImage #IFDEF IS$WINDOWS send GridPrepare_AddColumn "" AFT_ASCII3 send GridPrepare_AddColumn "#" AFT_ASCII4 send GridPrepare_AddColumn "Root name" AFT_ASCII15 send GridPrepare_AddColumn "Display name" AFT_ASCII25 send GridPrepare_AddColumn "Max recs" AFT_NUMERIC8.0 send GridPrepare_AddColumn "Cur recs" AFT_NUMERIC8.0 send GridPrepare_AddColumn "Pct full" AFT_NUMERIC4.0 send GridPrepare_AddColumn "New max" AFT_NUMERIC8.0 send GridPrepare_Apply self #ELSE set highlight_row_state to DFTRUE #ENDIF set select_mode to MULTI_SELECT on_key kenter send next on_key key_ctrl+key_r send sort_data on_key knext_item send increment_item on_key kprevious_item send decrement_item on_key kswitch send switch on_key kswitch_back send switch_back end_procedure procedure decrement_item local integer liCurrentItem get current_item to liCurrentItem decrement liCurrentItem if liCurrentItem ge 0 set current_item to liCurrentItem else send switch_back end_procedure procedure increment_item local integer liCurrentItem get current_item to liCurrentItem increment liCurrentItem if liCurrentItem le (item_count(self)-1) set current_item to liCurrentItem else send switch end_procedure function iSpecialSortValueOnColumn.i integer liColumn returns integer if liColumn eq 2 function_return 0 if liColumn eq 3 function_return 0 function_return 1 end_function function sSortValue.ii integer liColumn integer liItm returns string if liColumn eq 0 function_return (not(select_state(self,liItm))) if liColumn eq 6 function_return (IntToStrR(1000-integer(value(self,liItm)),10)) function_return (IntToStrR(value(self,liItm),10)) end_function procedure sort_data.i integer liColumn send Grid_SortByColumn self liColumn end_procedure procedure sort_data local integer liCurrentColumn get Grid_CurrentColumn self to liCurrentColumn send sort_data.i liCurrentColumn end_procedure #IFDEF IS$WINDOWS procedure header_mouse_click integer liItm send sort_data.i liItm forward send header_mouse_click liItm end_procedure #ENDIF procedure select_toggling integer liItm integer liValue local integer liBase lbState liNewMaxRec NewMaxliItm move (Grid_BaseItem(self)) to liBase move (liBase+7) to NewMaxliItm forward send select_toggling liBase liValue // Redirect to first column get select_state item liBase to lbState set entry_state item NewMaxliItm to lbState if lbState begin set current_item to NewMaxliItm get aux_value item NewMaxliItm to liNewMaxRec ifnot liNewMaxRec begin get value item (liBase+5) to liNewMaxRec move (integer(value(self,liBase+4)) max liNewMaxRec) to liNewMaxRec end set value item NewMaxliItm to liNewMaxRec end else begin set aux_value item NewMaxliItm to (value(self,NewMaxliItm)) set value item NewMaxliItm to "" end end_procedure procedure fill_list.i integer lhFdx local integer liRow liFile liBase liMaxRecs liUsedRecs liPct send delete_data move 0 to liFile repeat move (FDX_AttrValue_FLSTNAV(lhFdx,DF_FILE_NEXT_USED,liFile)) to liFile if liFile begin // Only if DataFlex file and only if it has indices defined: if (FDX_AttrValue_FILE(lhFdx,DF_FILE_DRIVER,liFile)="DATAFLEX" and integer(FDX_AttrValue_FILE(lhFdx,DF_FILE_LAST_INDEX_NUMBER,liFile))<>0 and not(integer(FDX_AttrValue_FILE(lhFdx,DF_FILE_IS_SYSTEM_FILE,liFile)))) begin get item_count to liBase send add_item msg_none "" set checkbox_item_state item liBase to DFTRUE send add_item msg_none liFile send add_item msg_none (FDX_AttrValue_FILELIST(lhFdx,DF_FILE_ROOT_NAME,liFile)) send add_item msg_none (FDX_AttrValue_FILELIST(lhFdx,DF_FILE_DISPLAY_NAME,liFile)) move (FDX_AttrValue_FILE(lhFdx,DF_FILE_MAX_RECORDS,liFile)) to liMaxRecs move (FDX_AttrValue_FILE(lhFdx,DF_FILE_RECORDS_USED,liFile)) to liUsedRecs send add_item msg_none liMaxRecs send add_item msg_none liUsedRecs move (liUsedRecs*100.0/liMaxRecs) to liPct if liPct gt 999 move 999 to liPct send add_item msg_none liPct send add_item msg_none "" end end until liFile eq 0 send Grid_SetEntryState self DFFALSE send sort_data.i 6 set current_item to 0 set dynamic_update_state to DFTRUE end_procedure procedure Callback_ModifiedEntries integer msg# integer obj# local integer liRow liMax liNewMax liBase liFile local string root# get Grid_RowCount self to liMax for liRow from 0 to (liMax-1) get Grid_RowBaseItem self liRow to liBase if (select_state(self,liBase)) begin get value item (liBase+1) to liFile get value item (liBase+2) to root# get value item (liBase+7) to liNewMax send msg# to obj# liFile root# liNewMax end loop end_procedure procedure AutoSetParameters integer liMinPctFree integer liNewPctFree local integer liRow liMax liNewMax liBase liPctFull liCurRecs if (liNewPctFree>liMinPctFree and liNewPctFree<=90) begin // Only if there's a point get Grid_RowCount self to liMax for liRow from 0 to (liMax-1) get Grid_RowBaseItem self liRow to liBase ifnot (select_state(self,liBase)) begin // Only the ones that are not already modified get value item (liBase+6) to liPctFull if ((100-liPctFull)16711679) move 16711679 to liNewMax // dffile of 3.2 says this is maximum set value item (liBase+7) to liNewMax end end loop end end_procedure end_class // cNewMaxRecordsList #IFDEF IS$WINDOWS Use APS // Auto Positioning and Sizing classes for VDF Use Buttons.utl // Button texts object oNewMaxRecords is a aps.ModalPanel label "Set new maximum number of records (indexed DataFlex tables only)" set locate_mode to CENTER_ON_SCREEN on_key ksave_record send close_panel_ok on_key kcancel send close_panel set pMinimumSize to 200 0 property integer piResult public 0 object oLst is a cNewMaxRecordsList set size to 200 0 end_object 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 set piResult to 1 send close_panel end_procedure set Border_Style to BORDER_THICK // Make panel resizeable procedure aps_onResize integer delta_rw# integer delta_cl# send aps_resize (oLst(self)) delta_rw# 0 // delta_cl# send aps_register_multi_button (oBtn1(self)) send aps_register_multi_button (oBtn2(self)) send aps_locate_multi_buttons send aps_auto_size_container end_procedure function iPopup returns integer set piResult to 0 send fill_list.i to (oLst(self)) (fdx.object_id(0)) send popup function_return (piResult(self)) end_procedure procedure AutoSetParameters integer liMinPct integer liNewPct send AutoSetParameters to (oLst(self)) liMinPct liNewPct end_procedure procedure precond_setup send fill_list.i to (oLst(self)) (fdx.object_id(0)) end_procedure end_object // oNewMaxRecords #ELSE /oNewMaxRecords.hdr ÉÍSet new maximum number of records (indexed DataFlex tables only)ÍÍÍÍÍÍÍÍÍÍÍÍÍ» /oNewMaxRecords.lst º º º Maximum Current Pct. New Max º º # Root name Display name records records full records º º ___ ___. _______________ ___________________ _______. _______. ___. _______. º º ___ ___. _______________ ___________________ _______. _______. ___. _______. º º ___ ___. _______________ ___________________ _______. _______. ___. _______. º º ___ ___. _______________ ___________________ _______. _______. ___. _______. º º ___ ___. _______________ ___________________ _______. _______. ___. _______. º º ___ ___. _______________ ___________________ _______. _______. ___. _______. º º ___ ___. _______________ ___________________ _______. _______. ___. _______. º º ___ ___. _______________ ___________________ _______. _______. ___. _______. º º ___ ___. _______________ ___________________ _______. _______. ___. _______. º º ___ ___. _______________ ___________________ _______. _______. ___. _______. º º º /oNewMaxRecords.btn º _____________ _____________ º ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ /* Use App.utl // Character Mode classes Use Buttons.utl // Button texts object oNewMaxRecords is a app.ModalClient oNewMaxRecords.hdr set location to 6 0 absolute on_key ksave_record send ok on_key kcancel send cancel object oLst is a cNewMaxRecordsList oNewMaxRecords.lst set location to 1 0 relative end_object object oBtn is a app.Button oNewMaxRecords.btn set location to 15 0 relative item_list on_item t.btn.ok send ok on_item t.btn.cancel send cancel end_item_list end_object function iPopup returns integer local integer liRval send fill_list.i to (oLst(self)) (fdx.object_id(0)) ui_accept self to liRval function_return (liRval=msg_ok) end_procedure procedure AutoSetParameters integer liMinPct integer liNewPct send AutoSetParameters to (oLst(self)) liMinPct liNewPct end_procedure procedure precond_setup send fill_list.i to (oLst(self)) (fdx.object_id(0)) end_procedure end_object // oNewMaxRecords #ENDIF #IFDEF IS$WINDOWS Use APS // Auto Positioning and Sizing classes for VDF Use Buttons.utl // Button texts object oRestructFilterPn is a aps.ModalPanel label "Filter parameters" set locate_mode to CENTER_ON_SCREEN on_key ksave_record send close_panel_ok on_key kcancel send close_panel send tab_column_define 1 30 25 jmode_left set p_auto_column to 1 on_key key_ctrl+key_a send select_all property integer piResult public 0 object oCb1 is a aps.CheckBox label "Ignore Display Name" end_object object oCb2 is a aps.CheckBox label "Ignore Max Records" end_object object oCb3 is a aps.CheckBox label "Ignore Compression" end_object object oCb4 is a aps.CheckBox label "Ignore Integrity Check" end_object object oCb5 is a aps.CheckBox label "Ignore Lock Type" end_object object oCb6 is a aps.CheckBox label "Ignore Multi User" end_object object oCb7 is a aps.CheckBox label "Ignore Reuse Deleted" end_object object oCb8 is a aps.CheckBox label "Ignore Transaction setting" end_object object oCb9 is a aps.CheckBox label "Ignore Root name" end_object object oCb10 is a aps.CheckBox label "Ignore Record Length" end_object object oCb11 is a aps.CheckBox label "Ignore Record Identity" end_object procedure select_all local integer lbState get checked_state of (oCb1(self)) to lbState move (not(lbState)) to lbState set checked_state of (oCb1(self)) to lbState set checked_state of (oCb2(self)) to lbState set checked_state of (oCb3(self)) to lbState set checked_state of (oCb4(self)) to lbState set checked_state of (oCb5(self)) to lbState set checked_state of (oCb6(self)) to lbState set checked_state of (oCb7(self)) to lbState set checked_state of (oCb8(self)) to lbState set checked_state of (oCb9(self)) to lbState set checked_state of (oCb10(self)) to lbState set checked_state of (oCb11(self)) to lbState end_procedure 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 set piResult to 1 send close_panel end_procedure procedure popup local integer lhObj move (oFdxTableCompare(self)) to lhObj set piResult to 0 set checked_state of (oCb1(self)) to (piIgnore_DisplayName(lhObj)) set checked_state of (oCb2(self)) to (piIgnore_MaxRecords(lhObj)) set checked_state of (oCb3(self)) to (piIgnore_Compression(lhObj)) set checked_state of (oCb4(self)) to (piIgnore_IntegrityCheck(lhObj)) set checked_state of (oCb5(self)) to (piIgnore_LockType(lhObj)) set checked_state of (oCb6(self)) to (piIgnore_MultiUser(lhObj)) set checked_state of (oCb7(self)) to (piIgnore_ReuseDeleted(lhObj)) set checked_state of (oCb8(self)) to (piIgnore_TransactionSetting(lhObj)) set checked_state of (oCb9(self)) to (piIgnore_RootName(lhObj)) set checked_state of (oCb10(self)) to (piIgnore_RecordLength(lhObj)) set checked_state of (oCb11(self)) to (piIgnore_RecordIdentity(lhObj)) forward send popup if (piResult(self)) begin set piIgnore_DisplayName of lhObj to (checked_state(oCb1(self))) set piIgnore_MaxRecords of lhObj to (checked_state(oCb2(self))) set piIgnore_Compression of lhObj to (checked_state(oCb3(self))) set piIgnore_IntegrityCheck of lhObj to (checked_state(oCb4(self))) set piIgnore_LockType of lhObj to (checked_state(oCb5(self))) set piIgnore_MultiUser of lhObj to (checked_state(oCb6(self))) set piIgnore_ReuseDeleted of lhObj to (checked_state(oCb7(self))) set piIgnore_TransactionSetting of lhObj to (checked_state(oCb8(self))) set piIgnore_Rootname of lhObj to (checked_state(oCb9(self))) set piIgnore_RecordLength of lhObj to (checked_state(oCb10(self))) set piIgnore_RecordIdentity of lhObj to (checked_state(oCb11(self))) end end_procedure end_object // oRestructFilterPn #ELSE /oRestructFilterPn.hdr ÉÍFilter parametersÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» /oRestructFilterPn.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 º º º /oRestructFilterPn.btn º _____________ _____________ º ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ /* Use App.utl // Character Mode classes Use Buttons.utl // Button texts object oRestructFilterPn is a app.ModalClient oRestructFilterPn.hdr set location to 6 18 absolute on_key key_ctrl+key_a send select_all on_key ksave_record send ok on_key kcancel send cancel object oFrm is a Form oRestructFilterPn.frm set location to 1 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 procedure select_all local integer lbState get select_state of (oFrm(self)) 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 object oBtn is a app.Button oRestructFilterPn.btn set location to 14 0 relative item_list on_item t.btn.ok send ok on_item t.btn.cancel send cancel end_item_list end_object procedure popup local integer lhRval lhObj move (oFdxTableCompare(self)) to lhObj set select_state of (oFrm(self)) item 0 to (piIgnore_DisplayName(lhObj)) set select_state of (oFrm(self)) item 1 to (piIgnore_MaxRecords(lhObj)) set select_state of (oFrm(self)) item 2 to (piIgnore_Compression(lhObj)) set select_state of (oFrm(self)) item 3 to (piIgnore_IntegrityCheck(lhObj)) set select_state of (oFrm(self)) item 4 to (piIgnore_LockType(lhObj)) set select_state of (oFrm(self)) item 5 to (piIgnore_MultiUser(lhObj)) set select_state of (oFrm(self)) item 6 to (piIgnore_ReuseDeleted(lhObj)) set select_state of (oFrm(self)) item 7 to (piIgnore_TransactionSetting(lhObj)) set select_state of (oFrm(self)) item 8 to (piIgnore_RootName(lhObj)) set select_state of (oFrm(self)) item 9 to (piIgnore_RecordLength(lhObj)) set select_state of (oFrm(self)) item 10 to (piIgnore_RecordIdentity(lhObj)) ui_accept self to lhRval if (lhRval=MSG_OK) begin set piIgnore_DisplayName of lhObj to (select_state(oFrm(self),0)) set piIgnore_MaxRecords of lhObj to (select_state(oFrm(self),1)) set piIgnore_Compression of lhObj to (select_state(oFrm(self),2)) set piIgnore_IntegrityCheck of lhObj to (select_state(oFrm(self),3)) set piIgnore_LockType of lhObj to (select_state(oFrm(self),4)) set piIgnore_MultiUser of lhObj to (select_state(oFrm(self),5)) set piIgnore_ReuseDeleted of lhObj to (select_state(oFrm(self),6)) set piIgnore_TransactionSetting of lhObj to (select_state(oFrm(self),7)) set piIgnore_Rootname of lhObj to (select_state(oFrm(self),8)) set piIgnore_RecordLength of lhObj to (select_state(oFrm(self),9)) set piIgnore_RecordIdentity of lhObj to (select_state(oFrm(self),10)) end end_procedure end_object // oRestructFilterPn #ENDIF #IFDEF IS$WINDOWS class StrucPgmFdxList is a aps.Grid #ELSE class StrucPgmFdxList is a app.List #ENDIF procedure construct_object integer liImage forward send construct_object liImage property integer piFDX_Server public 0 property integer prv.GenerateChangeEvent public 1 set highlight_row_state to DFTRUE on_key key_ctrl+key_d send display_file_things set line_width to 2 0 #IFDEF IS$WINDOWS set header_visible_state to false set gridline_mode to GRID_VISIBLE_NONE set form_margin item 0 to 4 // set form_margin item 1 to 40 // set highlight_row_state to true set highlight_row_color to (rgb(0,255,255)) set current_item_color to (rgb(0,255,255)) set select_mode to no_select #ENDIF on_key knext_item send switch on_key kprevious_item send switch_back end_procedure function iCurrentFile returns integer local integer liBase move ((current_item(self)/2)*2) to liBase if (item_count(self)) function_return (value(self,liBase)) function_return 0 end_function procedure display_file_things send FDX_ModalDisplayFileAttributes (piFDX_Server(self)) (iCurrentFile(self)) end_procedure procedure fill_list.i integer lhFdx local integer liFile liMax liItm set piFDX_Server to lhFdx send delete_data move 0 to liFile repeat move (FDX_AttrValue_FLSTNAV(lhFdx,DF_FILE_NEXT_USED,liFile)) to liFile if liFile begin send add_item msg_none liFile send add_item msg_none (FDX_AttrValue_FILELIST(lhFdx,DF_FILE_DISPLAY_NAME,liFile)) end until liFile eq 0 #IFDEF IS$WINDOWS set dynamic_update_state to true get item_count to liMax for liItm from 0 to (liMax-1) set entry_state item liItm to false loop #ENDIF end_procedure procedure DoGotoFile integer liFile local integer liItm liMax get item_count to liMax move 0 to liItm while (liItmPGM_TYPE_EMPTY) begin // Is there such a program already? uppercase lsRoot move (iFindPgmRow.is(lhProgArray,liFile1,lsRoot)) to liPgmRow if liPgmRow ne -1 send reset.i to lhProgArray liPgmRow // If so, reset it else get iAddPgmRow.is of lhProgArray liFile1 lsRoot to liPgmRow // If not, create it set piObject.i of lhProgArray liPgmRow to lhPgm end else send request_destroy_object to lhPgm end_procedure procedure DoFilter send popup to (oRestructFilterPn(self)) end_procedure procedure DoOne local integer file1# file2# oFDX1# oFDX2# move (fdx.object_id(0)) to oFDX1# move (fdx.object_id(1)) to oFDX2# if (piDataOrigin(oFDX1#)<>FDX_EMPTY and piDataOrigin(oFDX2#)<>FDX_EMPTY) begin get iCurrentFile of (oLst1(self)) to file1# get iCurrentFile of (oLst2(self)) to file2# if (file1# or file2#) begin if file1# eq 0 move file2# to file1# // Create! send compare_definitions file1# file2# FDXCOMP_MODE_ALL send obs "Comparison done" end end else send obs "Can not compare with empty source or destination!" end_procedure procedure CheckFdnFile string lsFile string lsPath local integer lhArray if (WildCardMatch(lsFile)) begin move (oArray(self)) to lhArray set value of lhArray item (item_count(self)) to lsFile end end_procedure procedure DeleteFdnFile string lsFile string lsPath local integer liGrb if (WildCardMatch(lsFile)) begin get SEQ_ComposeAbsoluteFileName lsPath lsFile to lsFile get SEQ_EraseFile lsFile to liGrb end end_procedure procedure DoAll_CompareFieldNames local integer max# liRow olst1# olst2# file1# file2# oFDX1# oFDX2# synch_state# liRval local integer lbContinue local string rn1# ln1# lsDir get synch_state to synch_state# set synch_state to 1 move (oLst1(self)) to olst1# move (oLst2(self)) to olst2# move (fdx.object_id(0)) to oFDX1# move (fdx.object_id(1)) to oFDX2# if (piDataOrigin(oFDX1#)<>FDX_EMPTY and piDataOrigin(oFDX2#)<>FDX_EMPTY) begin // Do changes and drops: get SEQ_SelectDirectory "Directory in which to place the fdn files" to lsDir if (lsDir<>"") begin send SEQ_Load_ItemsInDir lsDir send delete_data to (oArray(self)) send WildCardMatchPrepare "*.FDN" send SEQ_CallBack_ItemsInDir SEQCB_FILES_ONLY MSG_CheckFdnFile self if (item_count(oArray(self))) get MB_Verify4 "FDN files are already present in that directory." "" "Should we delete them before we continue?" "" DFFALSE to lbContinue else move DFTRUE to lbContinue if lbContinue begin move (item_count(oLst1#)/2) to max# for liRow from 0 to (max#-1) set current_item of olst1# to (liRow*2) get iCurrentFile of oLst1# to file1# if file1# ne 50 begin if (iCanOpen.i(oFDX1#,file1#) or file1#=0) begin move (AttrValue_FILELIST(oFDX1#,DF_FILE_ROOT_NAME,file1#)) to rn1# move (AttrValue_FILELIST(oFDX1#,DF_FILE_LOGICAL_NAME,file1#)) to ln1# get iFindLogicalName.si of oFDX2# ln1# 0 to file2# ifnot file2# get iFindRootName.sii of oFDX2# rn1# 0 0 to file2# ifnot file2# get iFindRootName.sii of oFDX2# rn1# 0 1 to file2# if (file2#<>0 and iCanOpen.i(oFDX2#,file2#)) begin get Fdx_GenerateFieldNameChanges oFDX1# File1# oFDX2# File2# lsDir to liRval end end end loop procedure_return msg_ok end end end else send obs "Can not compare with empty source or destination!" end_procedure procedure DoAll local integer liMax liRow lhLst1 lhLst2 liFile1 liFile2 lhFDX1 lhFDX2 lbSynch local integer lbOldStrategy liTestFile lbFirstTime lbDrop lbCanOpen2 local string lsRoot1 lsLogic1 lsRoot2 get synch_state to lbSynch set synch_state to 1 move (oLst1(self)) to lhLst1 move (oLst2(self)) to lhLst2 move (fdx.object_id(0)) to lhFDX1 move (fdx.object_id(1)) to lhFDX2 if (piDataOrigin(lhFDX1)<>FDX_EMPTY and piDataOrigin(lhFDX2)<>FDX_EMPTY) begin // Neither list can be empty! // Do changes and drops: move (item_count(lhLst1)/2) to liMax for liRow from 0 to (liMax-1) // Go through all the files in the <- list set current_item of lhLst1 to (liRow*2) get iCurrentFile of lhLst1 to liFile1 if liFile1 ne 50 begin if (iCanOpen.i(lhFDX1,liFile1) or liFile1=0) begin move (AttrValue_FILELIST(lhFDX1,DF_FILE_ROOT_NAME,liFile1)) to lsRoot1 move (AttrValue_FILELIST(lhFDX1,DF_FILE_LOGICAL_NAME,liFile1)) to lsLogic1 // At this point we have the table number, root name and logical name of the table // we want to update. if 0 begin // Old strategy get iFindLogicalName.si of lhFDX2 lsLogic1 0 to liFile2 ifnot liFile2 get iFindRootName.sii of lhFDX2 lsRoot1 0 0 to liFile2 // Start at entry 0, consider path and driver ifnot liFile2 get iFindRootName.sii of lhFDX2 lsRoot1 0 1 to liFile2 // Start at entry 0, do not consider path and driver if (iCanOpen.i(lhFDX2,liFile2) or liFile2=0) send compare_definitions liFile1 liFile2 FDXCOMP_MODE_ALL end else begin // New Strategy // First we figure out if we have already dealt with this table (as it could be an alias file) get iFindRootName.sii of lhFDX1 lsRoot1 0 1 to liTestFile // Start at entry 0, do not consider path and driver get iFindRootName.sii of lhFDX2 lsRoot1 0 1 to liFile2 // Start at entry 0, do not consider path and driver move (liTestFile=liFile1) to lbFirstTime move (not(liFile2)) to lbDrop if lbDrop begin send compare_definitions liFile1 0 FDXCOMP_MODE_ALL end else begin // Edited 19/10-2004 by Sture if lbFirstTime begin get iCanOpen.i of lhFDX2 liFile2 to lbCanOpen2 if lbCanOpen2 send compare_definitions liFile1 liFile2 FDXCOMP_MODE_FILE // Compare table attributes only send compare_definitions liFile1 liFile1 FDXCOMP_MODE_FILELIST // Compare filelist values only // ÄÄÄÄÄÄCompare the same entry at both sides end else begin send compare_definitions liFile1 liFile1 FDXCOMP_MODE_FILELIST end end //if lbFirstTime begin // //end //else move 0 to lbDrop // //if (liTestFile'Restructure programs'->'Compare' 6. @Load the new .fdx file in the right hand side (press F4) 7. @Press Ctrl+T and DFMatrix will generate all the .fdn files needed. Before doing so it will prompt you for a directory in which to put the files. At this point you take the new .fdx file and all the .fdn files to the production site and put it all in one directory. From this point on you do as normal: 8. @Throw off users and take a backup 9. @Start DFMatrix and load 'current' 10. @Go to 'Functions'->'Restructure programs'->'Compare' 11. @Do the compare (Ctrl+C) 12. @Check that the generated instructions actually take into account the renaming of fields. 13. @Execute the instructions /oStrucPgmDiff.hdr ÉÍCompare data definitionsÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» º ÄÄÄÄÄ Table definitions (alt+1) ÄÄÄÄÂÄÄ Reference definitions (alt+2) ÄÄÄ º º ____________________________________³____________________________________ º /oStrucPgmDiff.Lst1 º___. _______________________________ ³ º___. _______________________________ ³ º___. _______________________________ ³ º___. _______________________________ ³ º___. _______________________________ ³ º___. _______________________________ ³ º___. _______________________________ ³ º___. _______________________________ ³ º___. _______________________________ ³ º ³ /oStrucPgmDiff.Lst2 ___. _______________________________ º ___. _______________________________ º ___. _______________________________ º ___. _______________________________ º ___. _______________________________ º ___. _______________________________ º ___. _______________________________ º ___. _______________________________ º ___. _______________________________ º º /oStrucPgmDiff.btn1 º cL______________ F4_______________ º /oStrucPgmDiff.btn2 º Press Ctrl+T to generate field rename files (*.fdn) º º Press Ctrl+E to edit batch parameter file º º ___ Synchronized lists (cS) º /oStrucPgmDiff.btn3 º º º cF__________ cC___________ cA_______________ _________ º ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ /* object oFdxCompareDefinitions_Pn is a cFdxCompareDefinitions_Pn oStrucPgmDiff.hdr set location to 3 2 absolute on_key key_alt+key_1 send activate_list1 on_key key_alt+key_2 send activate_list2 on_key key_alt+key_3 send activate_buttons set center_state item 0 to true set center_state item 1 to true set window_color item 0 to 2 set window_color item 1 to 2 set piHelpImage to oStrucPgmDiff.hlp.N procedure DisplayHeaders set value item 0 to (sFdxTitle.i(fdx.object_id(0))) set value item 1 to (sFdxTitle.i(fdx.object_id(1))) end_procedure register_object oLst2 register_object oBtn2 object oLst1 is a StrucPgmFdxList oStrucPgmDiff.Lst1 set location to 3 0 relative procedure OnFilelistEntry string rn# string ln# if (select_state(oBtn2(self),0)) send DoGotoFilelistEntry to (oLst2(self)) rn# ln# end_procedure end_object object oLst2 is a StrucPgmFdxList oStrucPgmDiff.Lst2 set location to 3 39 relative procedure OnFilelistEntry string rn# string ln# if (select_state(oBtn2(self),0)) send DoGotoFilelistEntry to (oLst1(self)) rn# ln# end_procedure end_object object oBtn1 is a app.Button oStrucPgmDiff.btn1 set location to 13 0 relative item_list on_item "Open current" send DoLoadCurrent on_item "Open FDX file" send DoLoadFile end_item_list end_object on_key key_ctrl+key_l send DoLoadCurrent on_key key_F4 send DoLoadFile object oBtn2 is a Button oStrucPgmDiff.btn2 set location to 14 0 relative set select_mode to multi_select on_key kdownarrow send switch on_key kuparrow send switch_back on_key knext_item send switch on_key kprevious_item send switch_back item_list on_item "" send none set checkbox_item_state to true set select_state to true end_item_list end_object function synch_state returns integer function_return (select_state(oBtn2(self),0)) end_function procedure set synch_state integer val# set select_state of (oBtn2(self)) item 0 to val# end_procedure procedure ToggleSynchState set synch_state to (not(synch_state(self))) end_procedure on_key key_ctrl+key_s send ToggleSynchState object oBtn3 is a app.Button oStrucPgmDiff.btn3 set location to 17 0 relative item_list on_item "Filter" send DoFilter on_item "Compare" send DoOne on_item "Compare all" send DoAll on_item "Close" send Cancel end_item_list end_object on_key key_ctrl+key_f send DoFilter on_key key_ctrl+key_c send DoOne on_key key_ctrl+key_a send DoAll on_key key_ctrl+key_t send DoAll_CompareFieldNames on_key key_ctrl+key_e send DFMatrix_EditParameterFile procedure activate_list1 send activate to (oLst1(self)) end_procedure procedure activate_list2 send activate to (oLst2(self)) end_procedure procedure activate_buttons send activate to (oBtn3(self)) end_procedure procedure initialise send DisplayHeaders send fill_list.i to (oLst1(self)) (fdx.object_id(0)) send fill_list.i to (oLst2(self)) (fdx.object_id(1)) end_procedure procedure popup local integer grb# send initialise ui_accept self to grb# end_procedure end_object // oFdxCompareDefinitions_Pn #ENDIF #IFDEF IS$WINDOWS register_object oFrm1 register_object oFrm2 register_object oFrm3 register_object oFrm4 register_object oFrm5 register_object oFrm6 object oStrucPgmOther_Pn is a aps.ModalPanel label "Change parameters for selected tables" 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 0 set p_auto_column to 1 send tab_column_define 1 20 15 JMODE_LEFT // Default column setting send tab_column_define 2 100 15 JMODE_LEFT // Default column setting object oCb1 is a aps.CheckBox label "Compression" procedure OnChange set object_shadow_state of (oFrm1(self)) to (not(checked_state(self))) end_procedure end_object object oFrm1 is a Api_Attr.ComboFormAux abstract AFT_ASCII20 snap 2 send prepare_attr_values DF_FILE_COMPRESSION set object_shadow_state to true end_object object oCb2 is a aps.CheckBox label "Integrity check" procedure OnChange set object_shadow_state of (oFrm2(self)) to (not(checked_state(self))) end_procedure end_object object oFrm2 is a Api_Attr.ComboFormAux abstract AFT_ASCII20 snap 2 send prepare_attr_values DF_FILE_INTEGRITY_CHECK set object_shadow_state to true end_object object oCb3 is a aps.CheckBox label "Multiuser" procedure OnChange set object_shadow_state of (oFrm3(self)) to (not(checked_state(self))) end_procedure end_object object oFrm3 is a Api_Attr.ComboFormAux abstract AFT_ASCII20 snap 2 send prepare_attr_values DF_FILE_MULTIUSER set object_shadow_state to true end_object object oCb4 is a aps.CheckBox label "Reuse deleted" procedure OnChange set object_shadow_state of (oFrm4(self)) to (not(checked_state(self))) end_procedure end_object object oFrm4 is a Api_Attr.ComboFormAux abstract AFT_ASCII20 snap 2 send prepare_attr_values DF_FILE_REUSE_DELETED set object_shadow_state to true end_object object oCb5 is a aps.CheckBox label "Transaction type" procedure OnChange set object_shadow_state of (oFrm5(self)) to (not(checked_state(self))) end_procedure end_object object oFrm5 is a Api_Attr.ComboFormAux abstract AFT_ASCII20 snap 2 send prepare_attr_values DF_FILE_TRANSACTION set object_shadow_state to true end_object object oCb6 is a aps.CheckBox label "Lock type" procedure OnChange set object_shadow_state of (oFrm6(self)) to (not(checked_state(self))) end_procedure end_object object oFrm6 is a Api_Attr.ComboFormAux abstract AFT_ASCII20 snap 2 send prepare_attr_values DF_FILE_LOCK_TYPE set object_shadow_state to true end_object object oCb9 is a aps.CheckBox label "Trim record length" end_object 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 set piResult to 1 send close_panel end_procedure procedure popup set piResult to 0 forward send popup if (piResult(self)) begin end end_procedure function iPopup returns integer send popup function_return (piResult(self)) end_function function iSetAttribute.i integer attr# returns integer if attr# eq DF_FILE_COMPRESSION function_return (checked_state(oCb1(self))) if attr# eq DF_FILE_INTEGRITY_CHECK function_return (checked_state(oCb2(self))) if attr# eq DF_FILE_MULTIUSER function_return (checked_state(oCb3(self))) if attr# eq DF_FILE_REUSE_DELETED function_return (checked_state(oCb4(self))) if attr# eq DF_FILE_TRANSACTION function_return (checked_state(oCb5(self))) if attr# eq DF_FILE_LOCK_TYPE function_return (checked_state(oCb6(self))) if attr# eq DF_FILE_RECORD_LENGTH function_return (checked_state(oCb9(self))) //function_return 0 end_function function sAttributeValue.i integer attr# returns string if attr# eq DF_FILE_COMPRESSION function_return (Combo_Current_Aux_Value(oFrm1(self))) if attr# eq DF_FILE_INTEGRITY_CHECK function_return (Combo_Current_Aux_Value(oFrm2(self))) if attr# eq DF_FILE_MULTIUSER function_return (Combo_Current_Aux_Value(oFrm3(self))) if attr# eq DF_FILE_REUSE_DELETED function_return (Combo_Current_Aux_Value(oFrm4(self))) if attr# eq DF_FILE_TRANSACTION function_return (Combo_Current_Aux_Value(oFrm5(self))) if attr# eq DF_FILE_LOCK_TYPE function_return (Combo_Current_Aux_Value(oFrm6(self))) function_return "" end_function end_object // oStrucPgmOther_Pn #ELSE Use App.utl // Character Mode classes /oStrucPgmOther_Pn.hdr ÉÍChange parameters for selected tablesÍÍÍÍ» /oStrucPgmOther_Pn.frm º º º ___ Compression _______________ º º ___ Integrity check _______________ º º ___ Multiuser _______________ º º ___ Reuse deleted _______________ º º ___ Transaction type _______________ º º ___ Lock type _______________ º º ___ Trim record length º º º /oStrucPgmOther_Pn.btn º _____________ _____________ º ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ /* object oStrucPgmOther_Pn is a app.ModalClient oStrucPgmOther_Pn.hdr set location to 9 18 absolute on_key ksave_record send ok on_key kcancel send cancel object oFrm is a Api_Attr.ComboFormAux oStrucPgmOther_Pn.frm set location to 1 0 relative set select_mode to MULTI_SELECT item_list on_item "" send none set checkbox_item_state to true on_item "" send none on_item "" send none set checkbox_item_state to true on_item "" send none on_item "" send none set checkbox_item_state to true on_item "" send none on_item "" send none set checkbox_item_state to true on_item "" send none on_item "" send none set checkbox_item_state to true on_item "" send none on_item "" send none set checkbox_item_state to true on_item "" send none on_item "" send none set checkbox_item_state to true end_item_list set Item_Combo_Width item 1 to 20 set Item_Combo_Width item 3 to 20 set Item_Combo_Width item 5 to 20 set Item_Combo_Width item 7 to 20 set Item_Combo_Width item 9 to 20 set Item_Combo_Width item 11 to 20 send prepare_attr_values 1 DF_FILE_COMPRESSION send prepare_attr_values 3 DF_FILE_INTEGRITY_CHECK send prepare_attr_values 5 DF_FILE_MULTIUSER send prepare_attr_values 7 DF_FILE_REUSE_DELETED send prepare_attr_values 9 DF_FILE_TRANSACTION send prepare_attr_values 11 DF_FILE_LOCK_TYPE end_object object oBtn is a app.Button oStrucPgmOther_Pn.btn set location to 10 0 relative item_list on_item t.btn.ok send ok on_item t.btn.cancel send cancel end_item_list end_object function iSetAttribute.i integer attr# returns integer if attr# eq DF_FILE_COMPRESSION function_return (select_state(oFrm(self),0)) if attr# eq DF_FILE_INTEGRITY_CHECK function_return (select_state(oFrm(self),2)) if attr# eq DF_FILE_MULTIUSER function_return (select_state(oFrm(self),4)) if attr# eq DF_FILE_REUSE_DELETED function_return (select_state(oFrm(self),6)) if attr# eq DF_FILE_TRANSACTION function_return (select_state(oFrm(self),8)) if attr# eq DF_FILE_LOCK_TYPE function_return (select_state(oFrm(self),10)) if attr# eq DF_FILE_RECORD_LENGTH function_return (select_state(oFrm(self),12)) //function_return 0 end_function function sAttributeValue.i integer attr# returns string if attr# eq DF_FILE_COMPRESSION function_return (Item_Combo_Current_Aux_Value(oFrm(self),1)) if attr# eq DF_FILE_INTEGRITY_CHECK function_return (Item_Combo_Current_Aux_Value(oFrm(self),3)) if attr# eq DF_FILE_MULTIUSER function_return (Item_Combo_Current_Aux_Value(oFrm(self),5)) if attr# eq DF_FILE_REUSE_DELETED function_return (Item_Combo_Current_Aux_Value(oFrm(self),7)) if attr# eq DF_FILE_TRANSACTION function_return (Item_Combo_Current_Aux_Value(oFrm(self),9)) if attr# eq DF_FILE_LOCK_TYPE function_return (Item_Combo_Current_Aux_Value(oFrm(self),11)) function_return "" end_function function iPopup returns integer local integer rval# ui_accept self to rval# function_return (rval#=msg_ok) end_procedure end_object // oStrucPgmOther_Pn #ENDIF #IFDEF IS$WINDOWS #ELSE /oListOfTablesAndFieldsThatItIsOkToDropAndDeleteConfirmAndWriteFilePanel.hdr ÉÍList of table drops and field deletionsÍÍÍ» /oListOfTablesAndFieldsThatItIsOkToDropAndDeleteConfirmAndWriteFilePanel.lst º º º ________________________________________ º º ________________________________________ º º ________________________________________ º º ________________________________________ º º ________________________________________ º º ________________________________________ º º ________________________________________ º º ________________________________________ º º ________________________________________ º º ________________________________________ º º º /oListOfTablesAndFieldsThatItIsOkToDropAndDeleteConfirmAndWriteFilePanel.btn º ________________ _____________ º ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ /* Use App.utl // Character Mode classes Use Buttons.utl // Button texts object oListOfTablesAndFieldsThatItIsOkToDropAndDeleteConfirmAndWriteFilePanel is a app.ModalClient oListOfTablesAndFieldsThatItIsOkToDropAndDeleteConfirmAndWriteFilePanel.hdr set location to 6 18 absolute property integer phDropArray public 0 on_key ksave_record send DoSaveToFile on_key kcancel send cancel object oLst is a List oListOfTablesAndFieldsThatItIsOkToDropAndDeleteConfirmAndWriteFilePanel.lst set location to 1 0 relative procedure fill_list.i integer lhArr local integer liMax liItm lbNoTables lbNoFields local string lsValue send delete_data get item_count of lhArr to liMax decrement liMax move 1 to lbNoTables for liItm from 0 to liMax get value of lhArr item liItm to lsValue ifnot (lsValue contains ".") begin // Tables if lbNoTables send add_item MSG_NONE "The following tables will be dropped:" send add_item MSG_NONE (" "+lsValue) end loop if lbNoTables send add_item MSG_NONE "No tables will be dropped" move 1 to lbNoFields for liItm from 0 to liMax get value of lhArr item liItm to lsValue if (lsValue contains ".") begin // Tables if lbNoFields send add_item MSG_NONE "The following fields will be deleted:" send add_item MSG_NONE (" "+lsValue) end loop if lbNoFields send add_item MSG_NONE "No fields will be deleted" end_procedure end_object object oBtn is a app.Button oListOfTablesAndFieldsThatItIsOkToDropAndDeleteConfirmAndWriteFilePanel.btn set location to 13 0 relative item_list on_item "Save to file" send DoSaveToFile on_item "Close" send cancel end_item_list end_object procedure DoSaveToFile local integer liChannel local string lsFileName move (SEQ_SelectOutFile("Save file with allowed tables drops and field deletions","*.txt")) to lsFileName if lsFileName begin get SEQ_DirectOutput lsFileName to liChannel if (liChannel>=0) begin send SEQ_Write to (phDropArray(self)) liChannel send SEQ_CloseOutput liChannel send obs "Allowed table drops and field deletions were written to" lsFileName end end end_procedure procedure popup.i integer lhDropArray local integer rval# set phDropArray to lhDropArray send fill_list.i to (oLst(self)) lhDropArray ui_accept self to rval# end_procedure end_object // oListOfTablesAndFieldsThatItIsOkToDropAndDeleteConfirmAndWriteFilePanel #ENDIF object oListOfTablesAndFieldsThatItIsOkToDropAndDelete is a cArray NO_IMAGE function iFindItem.s string lsItem returns integer local integer liMax liItm move (lowercase(lsItem)) to lsItem get item_count to liMax decrement liMax for liItm from 0 to liMax if (lsItem=value(self,liItm)) function_return liItm loop function_return -1 end_function procedure add_thing string lsValue local integer liItm get item_count to liItm set value item liItm to (lowercase(lsValue)) end_procedure procedure DeleteFieldBuildList integer liFile integer liField string lsName string lsRoot send add_thing (lsRoot+"."+lsName) end_procedure procedure DeleteTableBuildList integer liFile string lsName send add_thing lsName end_procedure define DFM_DROP_FILE_ID for "File ID: DFMatrix allowed drops" //> Write contents to file procedure SEQ_Write integer liChannel local integer liMax liItm writeln channel liChannel DFM_DROP_FILE_ID get item_count to liMax decrement liMax for liItm from 0 to liMax writeln channel liChannel (value(self,liItm)) loop end_procedure //> Read contents from file procedure SEQ_Read integer liChannel local integer lbSeqEof local string lsLine send delete_data readln channel liChannel lsLine if (lsLine=DFM_DROP_FILE_ID) begin repeat readln channel liChannel lsLine move (seqeof) to lbSeqEof ifnot lbSeqEof begin send add_thing lsLine end until lbSeqEof end else error 751 "Incompatible drop file" end_procedure property integer pbOkToRestructure public 0 procedure DeleteFieldCheck integer liFile integer liField string lsName string lsRoot local integer liItem move (lsRoot+"."+lsName) to lsName get iFindItem.s lsName to liItem if (liItem=-1) begin // If not found, then we can't proceed set pbOkToRestructure to false send DoWriteTimeEntry to (oStructure_LogFile(self)) ("Error: Not OK to delete field "+lsName) end end_procedure procedure DeleteTableCheck integer liFile string lsName local integer liItem get iFindItem.s lsName to liItem if (liItem=-1) begin // If not found, then we can't proceed set pbOkToRestructure to false send DoWriteTimeEntry to (oStructure_LogFile(self)) ("Error: Not OK to drop table "+lsName) end end_procedure //> Can we approve of the array of programs function bOkToRestructure integer lhPgmArr returns integer set pbOkToRestructure to true send AppendOutput to (oStructure_LogFile(self)) send callback_deleted_fields to lhPgmArr MSG_DeleteFieldCheck self send callback_deleted_tables to lhPgmArr MSG_DeleteTableCheck self ifnot (pbOkToRestructure(self)) send DoWriteTimeEntry to (oStructure_LogFile(self)) "(Restructure will be cancelled)" send CloseOutput to (oStructure_LogFile(self)) function_return (pbOkToRestructure(self)) end_function // procedure ConfirmAndWriteFile #IFDEF IS$WINDOWS #ELSE local integer lhSelf move self to lhSelf send popup.i to (oListOfTablesAndFieldsThatItIsOkToDropAndDeleteConfirmAndWriteFilePanel(self)) lhSelf #ENDIF end_procedure //> Write contents to log file procedure SEQ_WriteReportToLog integer liChannel end_procedure end_object // oListOfTablesAndFieldsThatItIsOkToDropAndDelete #IFDEF IS$WINDOWS class cStrucPgmList is a aps.Grid #ELSE class cStrucPgmList is a app.List #ENDIF procedure construct_object integer img# forward send construct_object img# set highlight_row_state to dfTrue on_key kenter send display_program on_key key_ctrl+key_e send execute_one on_key kdelete_record send request_delete set line_width to 1 0 #IFDEF IS$WINDOWS set header_visible_state to false set gridline_mode to GRID_VISIBLE_NONE set form_margin item 0 to 70 // set highlight_row_state to true set highlight_row_color to (rgb(0,255,255)) set current_item_color to (rgb(0,255,255)) set select_mode to no_select on_key knext_item send switch on_key kprevious_item send switch_back #ELSE on_key kswitch send switch on_key kswitch_back send switch_back #ENDIF property integer priv.pbDeletesOrDrops public DFFALSE end_procedure procedure request_delete local integer liRow lhServer lhPgm itm# if (item_count(self)) begin get piStructPgm_Server to lhServer // Gets from encapsulating object get current_item to itm# get aux_value item itm# to lhPgm get iFindRowFromPgm.i of lhServer lhPgm to liRow if liRow ne -1 begin send Reset.i to lhServer liRow get current_item to liRow send fill_list if liRow gt (item_count(self)-1) decrement liRow set current_item to liRow end end end_procedure procedure display_program if (item_count(self)) send StructPgm_Display (aux_value(self,current_item(self))) end_procedure #IFDEF IS$WINDOWS procedure mouse_click integer liItem integer liGrb if ((liItem-1)