// Use DirComp.pkg // List class for comparing directory contents (cDirCompList) Use DirComp.nui // Compare directory contents Use GridUtil.utl // Grid and List utilities Use Strings.nui // String manipulation for VDF and 3.2 (No User Interface) Use Dates.nui // Date routines (No User Interface) #IFDEF IS$WINDOWS Use APS // Auto Positioning and Sizing classes for VDF Use Buttons.utl // Button texts object oDirCompCopyPanel is a aps.ModalPanel label "Copy newer files" 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_left_margin to 30 send aps_init object oRad is a aps.RadioContainer object oRad1 is a aps.Radio label "Update left directory" end_object object oRad2 is a aps.Radio label "Update right directory" snap SL_DOWN set p_extra_external_width to 30 end_object object oRad3 is a aps.Radio label "Syncronize both" snap SL_DOWN end_object end_object send aps_goto_max_row send aps_make_row_space 4 object oUpdateExistingOnly is a aps.CheckBox label "Update existing files only" 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 function iPopup returns integer local integer iCurrentRad set piResult to 0 send popup if (piResult(self)) begin get current_radio of (oRad(self)) to iCurrentRad if (checked_state(oUpdateExistingOnly(self))) begin if iCurrentRad eq 0 function_return CA_UPDATE_LEFT_DIR_EXISTING_ONLY if iCurrentRad eq 1 function_return CA_UPDATE_RIGHT_DIR_EXISTING_ONLY if iCurrentRad eq 2 function_return CA_UPDATE_BOTH_DIRS_EXISTING_ONLY end else begin if iCurrentRad eq 0 function_return CA_UPDATE_LEFT_DIR if iCurrentRad eq 1 function_return CA_UPDATE_RIGHT_DIR if iCurrentRad eq 2 function_return CA_UPDATE_BOTH_DIRS end end function_return CA_NO_COPYING end_function end_object // oDirCompCopyPanel #ELSE /oDirCompCopyPanel.hdr ÉÍCopy newer filesÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» /oDirCompCopyPanel.frm1 º º º ___ Update left directory º º ___ Update right directory º º ___ Syncronize both º º º /oDirCompCopyPanel.frm2 º ___ Update existing files only º º º /oDirCompCopyPanel.btn º _____________ _____________ º ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ /* Use App.utl // Character Mode classes Use Buttons.utl // Button texts object oDirCompCopyPanel is a app.ModalClient oDirCompCopyPanel.hdr set location to 6 18 absolute on_key ksave_record send ok on_key kcancel send cancel object oRad is a Form oDirCompCopyPanel.frm1 set location to 1 0 relative set select_mode to SINGLE_SELECT item_list on_item "" send next set checkbox_item_state to true on_item "" send next set checkbox_item_state to true on_item "" send next set checkbox_item_state to true end_item_list end_object object oUpdateExistingOnly is a Form oDirCompCopyPanel.frm2 set location to 6 0 relative set select_mode to MULTI_SELECT item_list on_item "" send next set checkbox_item_state to true end_item_list end_object object oBtn is a app.Button oDirCompCopyPanel.btn set location to 8 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 iCurrentRad iRval ui_accept self to iRval if iRval eq msg_ok begin get current_item of (oRad(self)) to iCurrentRad if (select_state(oUpdateExistingOnly(self),0)) begin if iCurrentRad eq 0 function_return CA_UPDATE_LEFT_DIR_EXISTING_ONLY if iCurrentRad eq 1 function_return CA_UPDATE_RIGHT_DIR_EXISTING_ONLY if iCurrentRad eq 2 function_return CA_UPDATE_BOTH_DIRS_EXISTING_ONLY end else begin if iCurrentRad eq 0 function_return CA_UPDATE_LEFT_DIR if iCurrentRad eq 1 function_return CA_UPDATE_RIGHT_DIR if iCurrentRad eq 2 function_return CA_UPDATE_BOTH_DIRS end end function_return CA_NO_COPYING end_function end_object // oDirCompCopyPanel #ENDIF #IFDEF IS$WINDOWS Use Aps Use RGB.utl // Some color functions class cDirCompList is a aps.Grid #ELSE Use App.utl // Character Mode classes class cDirCompList is a app.List #ENDIF procedure construct_object integer img# forward send construct_object img# property integer piSetOfFilesObject public 0 set select_mode to NO_SELECT #IFDEF IS$WINDOWS send GridPrepare_AddColumn "Filename" AFT_ASCII20 send GridPrepare_AddColumn "Size" AFT_ASCII12 send GridPrepare_AddColumn "Time" AFT_ASCII20 send GridPrepare_AddColumn "Size" AFT_ASCII12 send GridPrepare_AddColumn "Time" AFT_ASCII20 send GridPrepare_Apply self set CurrentCellColor to (rgb(255,128,128)) #ENDIF set highlight_row_state to true on_key KNEXT_ITEM send switch on_key KPREVIOUS_ITEM send switch_back on_key KEY_CTRL+KEY_W send DoWriteToFile on_key KEY_CTRL+KEY_R send sort_data end_procedure function iSpecialSortValueOnColumn.i integer liColumn returns integer if liColumn gt 0 function_Return 1 end_function function sSortValue.ii integer liColumn integer liItem returns string local number lnValue local string lsValue get value item liItem to lsValue if (liColumn=1 or liColumn=3) begin move (replaces(",",lsValue,"")) to lsValue move (replaces(".",lsValue,"")) to lsValue function_return (IntToStrR(lsValue,9)) end if (liColumn=2 or liColumn=4) begin move (trim(lsValue)) to lsValue if (length(lsValue)>10) get TS_Compose (date(left(lsValue,10))) (StringRightBut(lnValue,11)) to lnValue else get TS_Compose 0 lsValue to lnValue function_return (NumToStrR(lnValue,0,13)) end end_function procedure sort_data.i integer column# send Grid_SortByColumn self column# end_procedure procedure sort_data local integer cc# get Grid_CurrentColumn self to cc# send sort_data.i cc# end_procedure #IFDEF IS$WINDOWS procedure header_mouse_click integer itm# send sort_data.i itm# forward send header_mouse_click itm# end_procedure #ENDIF procedure DoSetTimeTolerance send DirComp_SetTimeTolerance (oDirectoryCompareArray(self)) end_procedure procedure DoWriteToFile send Grid_DoWriteToFile self end_procedure function iCurrentRow returns integer local integer iItm if (item_count(self)) begin get Grid_BaseItem self to iItm function_return (aux_value(self,iItm)) end function_return -1 end_function procedure UpdateRow local integer iBase iRow iObj if (item_count(self)) begin move (oDirectoryCompareArray(self)) to iObj get Grid_BaseItem self to iBase get aux_value item iBase to iRow set value item (iBase+1) to (IntToStrTS(piFileSize1.i(iObj,iRow))) set value item (iBase+2) to (TS_ConvertToString(pnFileTime1.i(iObj,iRow))) set value item (iBase+3) to (IntToStrTS(piFileSize2.i(iObj,iRow))) set value item (iBase+4) to (TS_ConvertToString(pnFileTime2.i(iObj,iRow))) #IFDEF IS$WINDOWS set ItemColor item (iBase+1) to clWhite set ItemColor item (iBase+2) to clWhite set ItemColor item (iBase+3) to clWhite set ItemColor item (iBase+4) to clWhite #ENDIF end end_procedure procedure DoCopyNew send DoCopyFile to (oDirectoryCompareArray(self)) CA_COPY_ONE_NEWER (iCurrentRow(self)) send UpdateRow end_procedure procedure DoCopyLeft send DoCopyFile to (oDirectoryCompareArray(self)) CA_COPY_ONE_LEFT_TO_RIGHT (iCurrentRow(self)) send UpdateRow end_procedure procedure DoCopyRight send DoCopyFile to (oDirectoryCompareArray(self)) CA_COPY_ONE_RIGHT_TO_LEFT (iCurrentRow(self)) send UpdateRow end_procedure procedure DoCopyAdvanced local integer iAction get iPopup of (oDirCompCopyPanel(self)) to iAction if iAction ne CA_NO_COPYING begin send DoCopyFiles to (oDirectoryCompareArray(self)) iAction send fill_list.i 0 end end_procedure procedure add_row end_procedure procedure fill_list.i integer liChangesOnly local integer liObj liMax liRow liSize1 liSize2 liExists1 liExists2 local integer liGreen liBase liChanged local number lnTime1 lnTime2 local string lsName send delete_data set dynamic_update_state to false move (oDirectoryCompareArray(self)) to liObj get row_count of liObj to liMax decrement liMax #IFDEF IS$WINDOWS move (RGB_Brighten(clGreen,75)) to liGreen #ENDIF for liRow from 0 to liMax get psFileName.i of liObj liRow to lsName get piExists1.i of liObj liRow to liExists1 get piFileSize1.i of liObj liRow to liSize1 get pnFileTime1.i of liObj liRow to lnTime1 get piExists2.i of liObj liRow to liExists2 get piFileSize2.i of liObj liRow to liSize2 get pnFileTime2.i of liObj liRow to lnTime2 get iIsChanged.i of liObj liRow to liChanged if (not(liChangesOnly) or liChanged) begin get item_count to liBase send add_item msg_none lsName set aux_value item liBase to liRow if liExists1 begin send add_item msg_none (IntToStrTS(liSize1)) send add_item msg_none (TS_ConvertToString(lnTime1)) end else begin send add_item msg_none "" send add_item msg_none "" end if liExists2 begin send add_item msg_none (IntToStrTS(liSize2)) send add_item msg_none (TS_ConvertToString(lnTime2)) end else begin send add_item msg_none "" send add_item msg_none "" end #IFDEF IS$WINDOWS if (liChanged=-1) begin // Left is newer set ItemColor item (liBase+1) to liGreen set ItemColor item (liBase+2) to liGreen end if (liChanged=1) begin // Right is newer set ItemColor item (liBase+3) to liGreen set ItemColor item (liBase+4) to liGreen end #ENDIF end loop send Grid_SetEntryState self DFFALSE set dynamic_update_state to true end_procedure end_class // cDirCompList #IFDEF IS$WINDOWS object oDircompTimeTolerance is a aps.ModalPanel label "Timestamp tolerance" 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 object oEdit is a aps.Edit set object_shadow_state to DFTRUE set border_style to BORDER_NONE set size to 60 220 set scroll_bar_visible_state to DFFALSE set value item 0 to "For reasons not understood at all, I (who made the" set value item 1 to "program) frequently experience that the timestamp of" set value item 2 to "identical files is offset by 1 or 2 seconds." set value item 3 to "For that reason you may specify a time interval inside" set value item 4 to "which the timestamps will be considered identical." end_object send aps_goto_max_row object oFrm is a aps.Form abstract AFT_NUMERIC4.0 label "Tolerance in seconds:" set p_extra_external_width to 100 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.i integer lhObj set piResult to 0 set value of (oFrm(self)) item 0 to (pnTimeTolerance(lhObj)) send popup if (piResult(self)) set pnTimeTolerance of lhObj to (value(oFrm(self),0)) end_procedure end_object // oDircompTimeTolerance #ELSE /oDircompTimeTolerance.hdr ÉÍTimestamp toleranceÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» /oDircompTimeTolerance.frm º º º For reasons not understood at all, I (who made the º º program) frequently experience that the timestamp of º º identical files is offset by 1 or 2 seconds. º º For that reason you may specify a time interval inside º º which the timestamps will be considered identical. º º º º º º Tolerance in seconds: ___. º º º º º /oDircompTimeTolerance.btn º ____________ ____________ º ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ /* object oDircompTimeTolerance is a app.ModalClient oDircompTimeTolerance.hdr set location to 4 10 absolute on_key ksave_record send ok on_key kcancel send cancel object oFrm is a Form oDircompTimeTolerance.frm set location to 1 0 relative item_list on_item "" send next end_item_list end_object object oBtn is a app.Button oDircompTimeTolerance.btn set location to 12 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.i integer lhObj local integer rval# set value of (oFrm(self)) item 0 to (pnTimeTolerance(lhObj)) ui_accept self to rval# if rval# eq msg_ok set pnTimeTolerance of lhObj to (value(oFrm(self),0)) end_procedure end_object // oDircompTimeTolerance #ENDIF procedure DirComp_SetTimeTolerance global integer lhObj send popup.i to (oDircompTimeTolerance(self)) lhObj end_procedure