//**************************************************************************** // $Module type: Package // $Module name: cSynchronize.pkg // $Author : Nils G. Svedmyr // Created : 2001-07-04 @ 14:20 // // Description // Update 'External' db from 'Business' db. // // $Rev History // 2000-12-04 Module header created //**************************************************************************** Open FlexErrs Register_Object oStatusBar Register_Object oStatusHelp Use DFBase.pkg Use RDCStatPnl.pkg Use ODBC_Drv.pkg // DAC standard package. Use Sql.pkg Use DfTimer.pkg Use CheckDSN.pkg // Check for necessary ODBC DSN's on the computer. Use NewDfAbout.pkg // Dac package with Network user name function Use DfError.pkg Use cReindex.pkg // Reindex of Tool files. Use SyncFuncs.pkg Use Func.pkg //Use KeyLib.h #IFDEF GET_WIN32_FLASHWINDOW #ELSE // Flash window if running minimized: External_Function WIN32_FlashWindow "FlashWindow" User32.Dll Handle hWnd Boolean bInvert Returns Integer #ENDIF // We need these tool files: Open SncSchem Use SncTable.DD Open SncTHea Open SncTRow Use SncSys.DD Use SncLog.DD //**************************************************************************** // $Module type: CLASS // $Module name: cFlashTimer // $Author : Nils G. Svedmyr // Created : 2001-07-26 @ 17:53 // // Description : // // $Rev History // 2001-07-26 Module header created //**************************************************************************** Class cFlashTimer Is A dfTimer Procedure Construct_Object Forward Send Construct_Object Set Auto_Start_State To False Set Auto_Stop_State To False Set Timer_Active_State To False End_Procedure // Construct_Object Procedure End_Construct_Object Forward Send End_Construct_Object End_Procedure // End_Construct_Object Procedure OnTimer Integer iVoid hWnd hoPanel Forward Send OnTimer Delegate Get phoPanel To hoPanel // Get from parent = cSynchronize object. Get Window_Handle Of hoPanel To hWnd If (GetForegroundWindow() <> hWnd) ; Move (WIN32_FlashWindow (hWnd, 1)) To iVoid Else ; Move (WIN32_FlashWindow (hWnd, 0)) To iVoid Set TimeOut To 1000 End_Procedure // OnTimer End_Class // cFlashTimer //**************************************************************************** // $Module type: CLASS // $Module name: cIndexArray // $Author : Nils G. Svedmyr // Created : 2001-08-01 @ 00:30 // // Description : Array to keep index segments // // $Rev History // 2001-08-01 Module header created //**************************************************************************** Class cIndexArray Is An Array Procedure Construct_Object Forward Send Construct_Object End_Procedure // Construct_Object Procedure End_Construct_Object Forward Send End_Construct_Object End_Procedure // End_Construct_Object Procedure DoFillArray Integer iFile Integer iIndex Integer iSegments iField iCount Send Delete_Data // Delete old array items. If (iFile = 0) Procedure_Return // Get the field numbers of the passed index: Get_Attribute DF_INDEX_NUMBER_SEGMENTS Of iFile iIndex To iSegments For iCount From 1 To iSegments Get_Attribute DF_INDEX_SEGMENT_FIELD Of iFile iIndex iCount To iField Set Array_Value item (Item_Count(Self)) To iField Loop // For iCount from 1 to iSegments End_Procedure Procedure Dump Integer iCount iItems iIndexField Get Item_Count To iItems Showln "Index object = " (Self) For iCount From 0 To (iItems -1) Get Integer_Value item iCount To iIndexField Showln "iIndexField = " iIndexField Loop // For iCount from 0 to (iItems -1) Showln "" End_Procedure // Dump End_Class // cIndexArray //**************************************************************************** // $Module type: CLASS // $Module name: cIndexArrayFromString // $Author : Nils G. Svedmyr // Created : 2001-08-01 @ 00:30 // // Description : Array to keep index segments. Filled from string value. // // $Rev History // 2001-08-01 Module header created //**************************************************************************** Class cIndexArrayFromString Is An Array Procedure Construct_Object Forward Send Construct_Object End_Procedure // Construct_Object Procedure End_Construct_Object Forward Send End_Construct_Object End_Procedure // End_Construct_Object Procedure DoFillArray String sValue Integer iField iPos Send Delete_Data // Delete old array items. Move (Trim(sValue)) To sValue If (Length(sValue) = 0) Procedure_Return Repeat Move (Pos(" ", sValue)) To iPos If Not iPos Move sValue To iField // Then only one field. If Not iPos Break Else Begin Move (Mid(sValue, (iPos - 1), 1)) To iField // Get the field number Move (Replace((String(iField) + " "), sValue, '')) To sValue // and remove it from the string. End // Else Begin Set Array_Value item (Item_Count(Self)) To iField Until (Not(Pos(" ", sValue))) Set Array_Value item (Item_Count(Self)) To (Trim(sValue)) End_Procedure // DoFillArray Procedure Dump Integer iCount iItems iIndexField Get Item_Count To iItems Showln "Index from string object = " (Self) " iItems = " iItems For iCount From 0 To (iItems -1) Get Integer_Value item iCount To iIndexField Showln "iIndexField = " iIndexField Loop // For iCount from 0 to (iItems -1) Showln "" End_Procedure // Dump End_Class // cIndexArrayFromString //**************************************************************************** // $Module type: CLASS // $Module name: cConstraintsArray // $Author : Nils G. Svedmyr // Created : 2001-09-07 @ 10:35 // // Description : Array to keep constrain expressions // // $Rev History // 2001-09-07 Module header created //**************************************************************************** Class cConstraintsArray Is A Array Procedure Construct_Object Forward Send Construct_Object End_Procedure // Construct_Object Procedure End_Construct_Object Forward Send End_Construct_Object End_Procedure // End_Construct_Object Procedure DoFillArray String sValue Integer iItems Integer iPos iCount String sConstr Send Delete_Data // Delete old array items. Move (Trim(sValue)) To sValue If (Length(sValue) = 0) Procedure_Return For iCount From 1 To iItems Move (Pos("|", sValue)) To iPos If iPos Begin Move (Left(sValue, (iPos - 1))) To sConstr Move (Replace((String(sConstr) + "|"), sValue, '')) To sValue // and remove it from the string. End // If iPos Begin Else Move sValue To sConstr Set Array_Value item (Item_Count(Self)) To (String(sConstr)) Loop End_Procedure // DoFillArray Function BuildConstraints Integer iFile Returns Integer Integer iItems iCount iPos iField iSet String sText sMode Get Item_Count To iItems Move Self To iSet If Not iItems Procedure_Return Constraint_Set iSet For iCount From 0 To (iItems -1) Get String_Value item iCount To sText Move (Pos(" ", sText)) To iPos Move (Left(sText, (iPos - 1))) To iField Move (Replace((String(iField) + " "), sText, '')) To sText Move (Pos(" ", sText)) To iPos Move (Left(sText, (iPos - 1))) To sMode Move (Replace((String(sMode) + " "), sText, '')) To sText Vconstrain iFile iField sMode sText //showln iFile " " iField " " sMode " " sText Loop // For iCount from 0 to (iItems -1) Function_Return iSet End_Function // BuildConstraints Procedure Dump Integer iCount iItems String sValue Get Item_Count To iItems Showln "Constraints array object = " (Self) " iItems = " iItems For iCount From 0 To (iItems -1) Get String_Value item iCount To sValue Showln "Constraint = " sValue Loop // For iCount from 0 to (iItems -1) Showln "" End_Procedure // Dump End_Class // cConstraintsArray //**************************************************************************** // $Module type: CLASS // $Module name: cSynchFlagsArray // $Author : Nils G. Svedmyr // Created : 2001-09-07 @ 10:35 // // Description : Array to keep SynchFlags expressions for updating fields in // source data table, when a new Destination record has been // created OR updated. // // $Rev History // 2001-09-07 Module header created //**************************************************************************** Class cSynchFlagsArray Is A Array Procedure Construct_Object Forward Send Construct_Object End_Procedure // Construct_Object Procedure End_Construct_Object Forward Send End_Construct_Object End_Procedure // End_Construct_Object Procedure DoFillArray String sValue Integer iItems Integer iPos iCount String sSynchs Send Delete_Data // Delete old array items. Move (Trim(sValue)) To sValue If (Length(sValue) = 0) Procedure_Return For iCount From 1 To iItems Move (Pos("|", sValue)) To iPos If iPos Begin Move (Left(sValue, (iPos - 1))) To sSynchs Move (Replace((String(sSynchs) + "|"), sValue, '')) To sValue // and remove it from the string. End // If iPos Begin Else Move sValue To sSynchs Set Array_Value item (Item_Count(Self)) To (String(sSynchs)) Loop End_Procedure // DoFillArray Procedure Dump Integer iCount iItems String sValue Get Item_Count To iItems Showln "cSynchFlags array object = " (Self) " iItems = " iItems For iCount From 0 To (iItems -1) Get String_Value item iCount To sValue Showln "Synch flag = " sValue Loop // For iCount from 0 to (iItems -1) Showln "" End_Procedure // Dump End_Class // cSynchFlagsArray //**************************************************************************** // $Module type: CLASS // $Module name: cFieldsArray // $Author : Nils G. Svedmyr // Created : 2001-08-08 @ 16:00 // // Description : Array to keep field numbers of iFromFile and iToFile // // $Rev History // 2001-08-08 Module header created //**************************************************************************** Class cFieldsArray Is An Array Procedure Construct_Object Forward Send Construct_Object Property Handle phoFieldTypeArray 0 Property Handle phoAppendArray 0 End_Procedure // Construct_Object Procedure End_Construct_Object Forward Send End_Construct_Object End_Procedure // End_Construct_Object Procedure DoFillArray Integer iFromFile Integer iFromStartField Integer iFromStopField Integer iToFile Integer iToStartField ; Integer iSynchType String sSelFromFields String sSelToFields Integer iSelFieldCount Integer iFrField iToField iFields iCount iStart iExtra iPos iFromType iToType Integer iField String sFromDriver sToDriver Handle hoFieldTypeArray hoAppendArray String sFieldName sAppend Send Delete_Data // Delete old array items. Get phoFieldTypeArray To hoFieldTypeArray Get phoAppendArray To hoAppendArray If hoFieldTypeArray Send Delete_Data Of hoFieldTypeArray If hoAppendArray Send Delete_Data Of hoAppendArray Case Begin // Figure out start field and number of fields: Case (iSynchType = 1) // "Matching Field Names" Get_Attribute DF_FILE_NUMBER_FIELDS Of iFromFile To iFields Get_Attribute DF_FILE_DRIVER Of iFromFile To sFromDriver Get_Attribute DF_FILE_DRIVER Of iToFile To sToDriver If (sFromDriver = FLEX_DRV_ID) Begin Move 0 To iStart If (sToDriver <> FLEX_DRV_ID) Begin Increment iFields // Needed, else the last ToTable field does not get updated. End // If (sToDriver <> FLEX_DRV_ID) Begin Else If (sToDriver = FLEX_DRV_ID) Begin Move 1 To iStart End // Else If (sToDriver = FLEX_DRV_ID) Begin End // If (sFromDriver = FLEX_DRV_ID) Begin Else Move 1 To iStart Case Break Case (iSynchType = 2) // "Range of Field Numbers" Move iFromStartField To iStart Move (iFromStopField - iFromStartField +1) To iFields If (iFromStartField <> iToStartField) Move (iToStartField - iFromStartField) To iExtra Case Break Case (iSynchType = 3) // "Selected Fields Numbers" Move iSelFieldCount To iFields Move (Pos(" ", sSelFromFields)) To iPos Move (Mid(sSelFromFields, (iPos - 1), 1)) To iStart // Get the first field number // showln "iSelFieldCount = " iSelFieldCount " iStart = " iStart Case Break Case Else Error DfErr_Operator ("Wrong Field Selection Type specified for table number:" * String(iFromFile)) Procedure_Return Case End If (iStart = 0) Decrement iFields For iCount From iStart To iFields Case Begin Case (iSynchType = 1) // "Matching Field Names" Move iCount To iFrField Get_Attribute DF_FIELD_NAME Of iFromFile iCount To sFieldname Indicate Err False Get FieldMap iToFile sFieldName To iToField If (Err) Move -1 To iToField Case Break Case (iSynchType = 2) // "Range of Field Numbers" Move iCount To iFrField Move (iCount + iExtra) To iToField Case Break Case (iSynchType = 3) // "Selected Field Numbers" // From Fields: Move (Pos(" ", sSelFromFields)) To iPos If (iPos = 0) Begin Move (Trim(sSelFromFields)) To iFrField Move "" To sSelFromFields End // If (iPos = 0) Begin Else Begin Move (Mid(sSelFromFields, (iPos - 1), 1)) To iFrField // Get the field number Move (Replace((String(iFrField) + " "), sSelFromFields, '')) To sSelFromFields // and remove it from the string. End // Else Begin If (iFrField < 0) Begin // If negative, field value will be appended to previous field number value. Move (String(Abs(iFrField))) To sAppend Repeat Move (Pos(" ", sSelFromFields)) To iPos // *** APPEND LOGIC DOES NOT WORK !!! If iPos Begin Move (Mid(sSelFromFields, (iPos - 1), 1)) To iField If (iField < 0) Begin Move (Replace((String(iField) + " "), sSelFromFields, '')) To sSelFromFields Move (String(sAppend) * String(Abs(iField))) To sAppend // Convert to positive field number. End // If (iField < 0) Begin End // If iPos Begin Until (iField > -1 Or Not(iPos)) If hoAppendArray Set Array_Value Of hoAppendArray item (Item_Count(hoAppendArray)) To sAppend Move 0 To iFrField Move -1 To iToField Decrement iCount End // If (iFrField < 0) Begin Else Begin // Then save field to array If hoAppendArray Set Array_Value Of hoAppendArray item (Item_Count(hoAppendArray)) To 0 // To Fields: Move (Pos(" ", sSelToFields)) To iPos If (iPos = 0) Begin Move (Trim(sSelToFields)) To iToField Move "" To sSelToFields End // If (iPos = 0) Begin Else Begin Move (Mid(sSelToFields, (iPos - 1), 1)) To iToField // Get the field number Move (Replace((String(iToField) + " "), sSelToFields, '')) To sSelToFields // and remove it from the string. End // Else Begin End // Else Begin Case Break Case End // If (sDriver = FLEX_DRV_ID) Begin // *** IS THIS CORRECT ??? // Get_Attribute DF_FIELD_TYPE of iFromFile iCount to iFromType // Should we include OVERLAPS if not Dataflex driver ??? // Get_Attribute DF_FIELD_TYPE of iToFile iCount to iToType // ??? ******************* ??? // End // Else Begin // Move 0 to iFromType // Move 0 to iToType // End // If (iFrField and iToField and iFromType <> DF_OVERLAP and iToType <> DF_OVERLAP) Begin // If (iFrField and iToField) Begin If (iToField >= 0) Begin Set Array_Value item (Item_Count(Self)) To iFrField // iFromFile field number Set Array_Value item (Item_Count(Self)) To iToField // iToFile field number // If hoFieldTypeArray ; // Set Array_Value of hoFieldTypeArray item (Item_Count(hoFieldTypeArray)) to iToType // *** IS NEVER BEING USED! *** End // If (iToField >= 0) Begin Loop // For iCount from iStart to iFields // For iCount from 0 to (Item_Count(hoAppendArray)) // Get String_Value of hoAppendArray item iCount to sAppend // Showln sAppend // Loop // For iCount from 0 to (Item_Count(hoAppendArray)) End_Procedure // DoFillArray Function FieldMap Integer iFile String sFieldName Returns String Integer iFields iField iStart String sTableFieldName sDriver Move (Uppercase(sFieldName)) To sFieldName Get_Attribute DF_FILE_DRIVER Of iFile To sDriver If (sDriver = FLEX_DRV_ID) Move 0 To iStart // Then start at Recnum. Else Move 1 To iStart Get_Attribute DF_FILE_NUMBER_FIELDS Of iFile To iFields For iField From iStart To iFields Get_Attribute DF_FIELD_NAME Of iFile iField To sTableFieldName If (Uppercase(sTableFieldName) = sFieldName) Begin Function_Return iField End Loop Indicate Err False Function_Return -1 End_Function // FieldMap Procedure Dump Integer iCount iItems iFromVal iToVal Get Item_Count To iItems Showln "Fields array values:" For iCount From 0 To (iItems -1) Get Integer_Value item iCount To iFromVal Increment iCount Get Integer_Value item iCount To iToVal Showln "iFromVal = " iFromVal " iToVal = " iToVal Loop // For iCount from 0 to (iItems -1) Showln "" End_Procedure // Dump End_Class // cFieldsArray //**************************************************************************** // $Module type: CLASS // $Module name: cDefaultsArray // $Author : Nils G. Svedmyr // Created : 2001-09-15 @ 19:22 // // Description : // // $Rev History // 2001-09-15 Module header created //**************************************************************************** Class cDefaultsArray Is A Array Procedure Construct_Object Forward Send Construct_Object End_Procedure // Construct_Object Procedure End_Construct_Object Forward Send End_Construct_Object End_Procedure // End_Construct_Object Procedure DoFillArray Integer iFile String sDefaults Integer iCount iFields iType String sValue sDriver sType Send Delete_Data If Not iFile Procedure_Return Move (Trim(sDefaults)) To sDefaults Get_Attribute DF_FILE_DRIVER Of iFile To sDriver If (Uppercase(sDriver) = FLEX_DRV_ID) Procedure_Return Get_Attribute DF_FILE_NUMBER_FIELDS Of iFile To iFields For iCount From 1 To iFields Get_Attribute DF_FIELD_TYPE Of iFile iCount To iType If (Length(sDefaults)) ; Get ExtractField sDefaults iCount To sValue // Get FieldType iType To sType If (iType <> DF_OVERLAP) Begin Set Array_Value item (Item_Count(Self)) To sValue End Loop End_Procedure // DoFillArray Function ExtractField String sDefaults Integer iField Returns String Integer iStart iEnd iCount String sRetval sStartChar sEndChar For iCount From 1 To (iField - 1) Move (Replace("|", sDefaults, "")) To sDefaults Loop // For iCount from 1 to iField Move (Pos("|", sDefaults)) To iStart Move (Replace("|", sDefaults, "")) To sDefaults Move (Pos("|", sDefaults)) To iEnd Move (Mid(sDefaults, (iEnd - iStart), iStart)) To sRetval Move (Left(sRetval, 1)) To sStartChar Move (Right(sRetval, 1)) To sEndChar If ((sStartChar = "'" Or sStartChar = '"') And (sEndChar = "'" Or sEndChar = '"')) Begin Move (Left(sRetval, (Length(sRetval) -1))) To sRetval // Remove rightmost ' or " Move (Right(sRetval, (Length(sRetval) -1))) To sRetval // Remvoe leftmost ' or " End If (Length(sRetval) = 0) Move "|" To sRetval Function_Return sRetval End_Function // ExtractField Procedure Dump Integer iCount iItems String sValue Get Item_Count To iItems Showln "Default Field values array:" For iCount From 0 To (iItems -1) Get String_Value item iCount To sValue Showln "sValue = " sValue Loop // For iCount from 0 to (iItems -1) Showln "" End_Procedure // Dump End_Class // cDefaultsArray //**************************************************************************** // $Module type: CLASS // $Module name: // $Author : Nils G. Svedmyr // Created : 2002-03-06 @ 10:20 // // Description : Holds and creates arrays for field transformation values. // One array is created with values for each pair of Source and Destination fields // This array object will contain handles to those dynamically created arrays. // $Rev History // 2002-03-06 Module header created //**************************************************************************** Class cTransformMainArray Is An Array Procedure Construct_Object Forward Send Construct_Object End_Procedure // Construct_Object Procedure End_Construct_Object Forward Send End_Construct_Object End_Procedure // End_Construct_Object Procedure DoFillArray Integer iItems Integer iSncTable_Recid Handle ho Integer iCount iSet Send DoDestroyChildArrays Send Delete_Data If Not iItems Procedure_Return Move Self To iSet // Increment iSet Constraint_Set iSet Delete Constraint_Set iSet Constrain SncTHea Relates To SncTable Constrained_Find First SncTHea by Index.2 // Recid. For iCount From 1 To iItems Get Create U_Array To ho Set Array_Value item (Item_Count(Self)) To ho // Save the newly created array handle in this main array. Send DoFillNewTransformArray ho SncTHea.SncTRow_Count // Fill new array with transform values. (Proc below) Constraint_Set iSet Constrained_Find Gt SncTHea by Index.2 Loop // For iCount from 1 to iItems Constraint_Set iSet Delete End_Procedure // DoFillArray Procedure DoFillNewTransformArray Handle ho Integer iItems Integer iCount iSet String sFromValue sToValue If Not iItems Procedure_Return Move ho To iSet Constraint_Set iSet Constrain SncTRow Relates To SncTHea Constrained_Find First SncTRow by Index.1 // Recid. For iCount From 1 To iItems Move (Trim(SncTRow.FromValue)) To sFromValue Move (Trim(SncTRow.ToValue)) To sToValue // *** NEW FIELD *** Set Array_Value Of ho item (Item_Count(ho)) To (String(SncTHea.FromField) * String(SncTHea.ToField) * String(SncTRow.IgnoreCase) * String(sFromValue) + String("|") + String(sToValue)) Constrained_Find Gt SncTRow by Index.1 Loop // For iCount from 1 to iItems End_Procedure // DoFillNewTransformArray // Takes a Source field number and a Destination table field number as a parameters. // Returns the array handle if the field number is used in any of // the dynamically created arrays. // Else returns 0. Function IsFieldInArray Integer iFromField Integer iToField Returns Handle Handle ho Integer iItems iCount iItems2 iCount2 iPos iFromCheck iToCheck String sValue Get Item_Count To iItems If Not iItems Function_Return 0 For iCount From 0 To (iItems - 1) Get Integer_Value item iCount To ho If ho Begin Get Item_Count Of ho To iItems2 For iCount2 From 0 To (iItems2 - 1) Get String_Value Of ho item iCount2 To sValue Move (Pos(" ", sValue)) To iPos Move (Left(sValue, (iPos - 1))) To iFromCheck // showln "sValue = " sValue " iFromCheck = " iFromCheck Move (Replace(iFromCheck, sValue, "")) To sValue Move (Trim(sValue)) To sValue Move (Pos(" ", sValue)) To iPos Move (Left(sValue, (iPos - 1))) To iToCheck // showln "sValue = " sValue " iToCheck = " iToCheck If (iFromCheck = iFromField And iToCheck = iToField) Function_Return ho Loop // For iCount2 from 0 to (iItems2 -1) End // If ho Begin Loop // For iCount from 0 to (iItems - 1) Function_Return 0 End_Function // IsFieldInArray // Destroy all dynamically created arrays // that holds field transformation values. Procedure DoDestroyChildArrays Handle ho Integer iItems iCount Get Item_Count To iItems For iCount From 0 To (iItems -1) Get Integer_Value item iCount To ho If ho Send Destroy Of ho Loop // For iCount from 0 to (iItems -1) End_Procedure // DoDestroyChildArrays Procedure Dump Handle ho Integer iCount iItems iCount2 iItems2 String sValue Get Item_Count To iItems If Not iItems Begin Showln "Transform Main array is empty." Procedure_Return End // If Not iItems Begin Showln "Transform Main array: " Self For iCount From 0 To (iItems - 1) Get Integer_Value item iCount To ho Get Item_Count Of ho To iItems2 For iCount2 From 0 To (iItems2 - 1) Get String_Value Of ho item iCount2 To sValue Showln "SncTable id = " SncTable.Recid " Main array item = " iCount " sub array handle, field# and value = " (String(ho) * String(sValue)) Loop // For iCount2 from 0 to (iItems2 -1) Loop // For iCount from 0 to (iItems -1) Showln "" End_Procedure // Dump End_Class // cTransformMainArray //**************************************************************************** // $Module type: CLASS // $Module name: cSynchronize.pkg // $Author : Nils G. Svedmyr // Created : 2001-07-26 @ 16:46 // // Description : // // $Rev History // 2001-07-26 Module header created //**************************************************************************** Class cSynchronize is a cObject Procedure Construct_Object String sValue Forward Send Construct_Object Property Handle phoPanel 0 // Change 2007-04-04 Nils G. Svedmyr. // Use of VDF 12 new status_panel logic: Property Handle phoStatPnl ghoStatusPanel //(Status_Panel(Self)) Property Handle phoStatusBar 0 Property Handle phoDD 0 // SncTable_DD is set below. Property Boolean pbStatPnl (SncSys.Show_Info) // Use the sentinel to display info. Property Boolean pbAutoStart (SncSys.AutoStart) Property Boolean pbAllowCancelSent (SncSys.AllowCancelSent) Property Boolean pbDelete_Records False Property Boolean pbConstraints False Property Boolean pbSynchFlags False Property Boolean pbDefaults False Property Boolean pbTransform False Property Boolean pbCheckIntegrity False Property Boolean pbCancelled False Property Boolean pbReindex False Property Boolean pbSynchErr False Property Boolean Error_Processing_State False // 2004-06-23 ------------------------------------ Start Nils G. Svedmyr Property Boolean pbFromOemToAnsi False Property Boolean pbToOemToAnsi False // 2004-06-23 ------------------------------------ Stop Nils G. Svedmyr Property Integer piOldErrorId Error_Object_Id Property Integer piErrorCount 0 Property Integer piDeletedRecords 0 Property Integer piCopiedRecords 0 Property Integer piComparedRecords 0 Property Integer piUpdatedRecords 0 Property Integer piIndex 0 Property String psToFileDriver "" Property String psText "" Property String psCurrentRecid "" Property String psFromDataTable "" Property String psToDataTable "" Get psDataPath Of (phoWorkspace(ghoApplication)) To sValue Property String psToolDataPath sValue Get psProgramPath Of (phoWorkspace(ghoApplication)) To sValue Property String psToolProgramPath sValue // Property String psToolWsName "CrossMerge" // Property String psDefault_WS "CrossMerge" Property String psUser (Network_User_Name(Self)) // DFAbout function. Property Integer piDemoType 6 // Licensetype demo is maximized to run for a 100 records Property Integer piDemoMax 100 //Set Focus_Mode To NonFocusable // Not allowed in VDF9. Set_Attribute DF_RUNTIME_PROGRESS_FREQUENCY To 1 // Once for every new record. Used by Callback function. Send Ignore_Error Of Error_Info_Object 4100 // "Cannot find field". To not trigger error while trying to find a matching field name in ToFile. Send Ignore_Error Of Error_Info_Object 4121 // "Operation aborted". To not trigger error if user cancel operation while copying all records. Object oFromIndex Is A cIndexArray End_Object // oFromIndex Object oToIndex Is A cIndexArray End_Object // oToIndex Object oIndexArrayFromString Is A cIndexArrayFromString End_Object // oIndexArrayFromString Object oConstraintsArray Is A cConstraintsArray End_Object // oConstraintsArray Object oSynchFlagsArray Is A cSynchFlagsArray End_Object // oSynchFlagsArray Object oFieldsArray Is A cFieldsArray End_Object // oFieldsArray Object oFieldTypeArray Is A Array Move Self To Windowindex Set phoFieldTypeArray Of oFieldsArray To Windowindex End_Object // oFieldTypeArray Object oAppendArray Is A Array Move Self To Windowindex Set phoAppendArray Of oFieldsArray To Windowindex End_Object // oAppendArray Object oDefaultsArray Is A cDefaultsArray End_Object // oDefaultsArray Object oTransformMainArray Is A cTransformMainArray End_Object // oTransformMainArray Object oFlashTimer Is A cFlashTimer End_Object // oFlashTimer Object SncSys_DD Is A SncSys_DataDictionary End_Object // SncSys_DD Object SncLog_DD Is A SncLog_DataDictionary End_Object // SncLog_DD Object SncTable_DD Is A SncTable_DataDictionary Delegate Set phoDD To Self End_Object // SncTable_DD End_Procedure // Construct_Object Procedure End_Construct_Object Forward Send End_Construct_Object If Not (phoPanel(Self)) Begin Send Stop_Box "You forgot to set the 'phoPanel' property of the cSynchronize object. Program will be aborted." Abort End End_Procedure // End_Construct_Object Procedure DoProcess Handle hoGrid Handle hWnd hoStatPnl Integer iRetval String sText sSentinel sRegname sItems Get SelectedItems Of hoGrid To sItems If Not (sItems Contains "1") Begin Move "No data tables to connected selected. Please make a selection and try again." To sText If (pbAutoStart(Self)) Send DoLogWork sText "" Else Send Info_Box sText Procedure_Return End // If Not (sItems Contains "1") Begin Set pbDelete_Records To SncSys.Delete_Records // Needs to be done here if user has made changes. Set phoStatusBar To (oStatusBar(Self)) // Set it here when object has been created. Move (Self) To Error_Object_Id // Use internal error_report for this class. Set piErrorCount To 0 If (phoPanel(Self)) Get Window_Handle Of (phoPanel(Self)) To hWnd Move ("CrossMerge Engine -" * psLicenseType(ghoApplication)) To sText If (pbStatPnl(Self)) Begin Get phoStatPnl To hoStatPnl If hoStatPnl Begin Move ("Registered to:" * psName(ghoApplication) * "No:" * String(psSerial(ghoApplication))) To sRegname // If (Length(sRegname) > 75) ; // Move ("Registered to:" * psName(ghoApplication)) To sRegname // // It seems like impossible to change the offsets in RDCSentdat.pkg: Set License_Text Of hoStatPnl To sRegname Set Button_Text Of hoStatPnl To "Cancel" Set Allow_Cancel_State Of hoStatPnl To (pbAllowCancelSent(Self)) Move (psToolProgramPath(Self) + "\CmSentinel.Exe") To sSentinel Get vFolderExists sSentinel To iRetval If Not iRetval Begin Move "The Sentinel program is missing (\CmSentinel.Exe)." To sText Set pbStatPnl To False Send DoLogWork sText If Not (pbAutoStart(Self)) Begin Get YesNo_Box (sText * "Do you want to display info in the status bar instead? Note: You will not be able to interrupt the process, once it has started.") ; To iRetval If (iRetval = MBR_NO) Procedure_Return End // If Not (pbAutoStart(Self)) Begin End // If (Trim(sSentinel) = "") Begin Else Begin Set Sentinel_Name Of hoStatPnl To sSentinel // Send Initialize_StatusPanel Of hoStatPnl sRegname "Processing:" "" Send Initialize_StatusPanel Of hoStatPnl sText "Processing:" "" Send Start_StatusPanel Of hoStatPnl End // Else Begin End // If hoStatPnl Begin End // If (pbStatPnl(Self)) Begin Else Set Status_Help To "Connecting data..." // Send DoSwitchWorkSpace DateTime dtStartDateTime dtEndDateTime Move (CurrentDateTime()) To dtStartDateTime Send DoLogWork "Connection started" Send DoRunProcess hoGrid // MAIN procedure. Move (CurrentDateTime()) To dtEndDateTime If (pbStatPnl(Self)) Send Stop_StatusPanel Of (phoStatPnl(Self)) If (pbCancelled(Self)) Send DoLogWork "Process interrupted by user." Else Send DoLogWork ("Ready. Time Elapsed:" * String(dtEndDateTime - dtStartDateTime)) If Not (pbAutoStart(Self)) Begin If (hWnd And GetForegroundWindow() <> hWnd) ; Set Timer_Active_State Of oFlashTimer To True // Flash statusbar if we are active and minimized. If (piErrorCount(Self)) ; Send Info_Box (String(piErrorCount(Self)) * "Error(s) encountered while connecting data tables.\nView log for details.") "Connection Error" Else Begin If (pbCancelled(Self)) Send Info_Box (Trim(SncLog.StatusText)) "Ready" Else Send Info_Box ("Connection done.\n" + SncLog.StatusText + "\nView log for details.") "Ready" End // Else Begin Set Timer_Active_State Of oFlashTimer To False End // If Not (pbAutoStart)Self) Begin Get piOldErrorId To Error_Object_Id // Reset to standard error object id. End_Procedure // DoProcess //------------------------------------------------------------------------- // Synchronize selected db's (MAIN LOOP) //------------------------------------------------------------------------- Procedure DoRunProcess Handle hoGrid Handle ho hoDD Integer iItem_Count iItem iCols iTables iTable iNo iRecords iSet iTmp iFromDbType iToDbType Integer iFromFile iToFile iFromIndex iToIndex iRetval iConstrainCount iSynchFlagsCount Integer iFromStartField iFromStopField iToStartField iSynchType iSelFieldCount Integer iSaveInterval Boolean bChecked bDelete_Records bSysFile String sText sSelFromFields sSelToFields sFromFieldsToIdx sToFieldsFromIdx sConstraints sSynchFlags String sFromLogin sFromOwner sToLogin sToOwner sDefaults sFromDriver sToDriver sFromLayout sToLayout String sFromPv sToPv sFromDataTable sToDataTable sFromPath sToPath Get phoDD To hoDD Get NumberSelectedItems Of hoGrid To iTables // cSyncTableCheckboxGrid class function. Get Item_Count Of hoGrid To iItem_Count Get Line_Size Of hoGrid To iCols // Do not check SncTable records, use the grid items, because user For iItem From 0 To (iItem_Count -1) // may have made changes to the scheme. Get Select_State Of hoGrid item iItem To bChecked // NOTE: The order of the fields in the hoGrid is very crucial! Get Aux_Value Of hoGrid item iItem To iNo Set psText To "" Add (iCols -1) To iItem Clear SncTable Move iNo To SncTable.Recid Find Eq SncTable.Recid // If Not (Found) Showln "Not Found!" If Not (Found) Send DoReindexToolFileList hoGrid // Auto re-index tool files if index error! (Will restart this If bChecked Begin // procedure after reindex is ready.) Send Find Of hoDD Eq 1 // Needed by the RDSOpen function. Get Field_Current_Value of hoDD Field SncTable.Recid To iTmp Move SncTable.FromFile To iFromFile Move SncTable.ToFile To iToFile If (iFromFile = 0 And iToFile = 0) Break // If both files=0 just skip it. This allows us to add records with TblSetup as // 2002-10-05 ------------------------------------ Start Nils G. Svedmyr Move SncTable.Text To sText Move (Trim(sText)) To sText Move SncTable.Delete_Records To bDelete_Records // 2002-10-05 ------------------------------------ Stop Nils G. Svedmyr Move SncTable.FromStartField To iFromStartField // comments/dividers. Else if one of the files is 0, an error is triggered (and logged). Move SncTable.FromStopField To iFromStopField Move SncTable.FromIndex To iFromIndex Move SncTable.ToStartField To iToStartField Move SncTable.ToIndex To iToIndex Move SncTable.SynchType To iSynchType Move SncTable.SelFieldCount To iSelFieldCount Set pbFromOemToAnsi To SncTable.FrFileOemToAnsi Set pbToOemToAnsi To SncTable.ToFileOemToAnsi Move SncTable.ConstrainCount To iConstrainCount Move SncTable.SynchFlagCount To iSynchFlagsCount Move SncTable.FromPv To sFromPv Move SncTable.ToPv To sToPv Move SncTable.FromDataTable To sFromDataTable Set psFromDataTable To (Trim(sFromDataTable)) Move SncTable.ToDataTable To sToDataTable Set psToDataTable To (Trim(sToDataTable)) Move SncTable.FromDbType To iFromDbType Move SncTable.ToDbType To iToDbType Move (Trim(SncTable.FromFilePath)) To sFromPath Move (Trim(SncTable.ToFilePath)) To sToPath Move (Trim(SncTable.Constraints)) To sConstraints Move (Trim(SncTable.SynchFlags)) To sSynchFlags Move (Trim(SncTable.SelFromFields)) To sSelFromFields Move (Trim(SncTable.SelToFields)) To sSelToFields Move (Trim(SncTable.FromFieldsToIdx)) To sFromFieldsToIdx Move (Trim(SncTable.ToFieldsFromIdx)) To sToFieldsFromIdx Move (Trim(SncTable.FromLogin)) To sFromLogin Move (Trim(SncTable.FromOwner)) To sFromOwner Move (Trim(SncTable.FromDriver)) To sFromDriver Move (Trim(SncTable.ToLogin)) To sToLogin Move (Trim(SncTable.ToOwner)) To sToOwner Move (Trim(SncTable.ToDriver)) To sToDriver Set psToFileDriver To sToDriver Move (Trim(SncTable.ToDefaults)) To sDefaults Move (Trim(SncTable.FromLayout)) To sFromLayout Move (Trim(SncTable.ToLayout)) To sToLayout Move (Trim(SncTable.FromDataTable)) To sFromDataTable Move (Trim(SncTable.ToDataTable)) To sToDataTable Move (Trim(SncTable.Workspace)) To iSaveInterval Set pbCheckIntegrity To SncTable.CheckIntegrity Set pbDelete_Records To bDelete_Records Add 1 To iTable Set psText To (Trim(sText)) Move 1 To iRetval If (iFromDbType = 6) Begin Get OpenDDFFile True sFromPath sFromDriver True To iRetval If Not iRetval Error DfErr_Operator ("Could not open Pervasive Meta Data File:" * String(sFromPath) - "\File.ddf") End // If (iFromDbType = 6) Begin If Not iRetval Break // The Source file could not be opened. Get RDSOpenAsFile hoDD True True To iRetval If Not iRetval Error DfErr_Operator ("Could not open table:" * String(sFromDataTable)) If Not iRetval Break // The Source DDF file could not be opened. Move 1 To iRetval If (iToDbType = 6) Begin Get OpenDDFFile False sToPath sToDriver True To iRetval If Not iRetval Error DfErr_Operator ("Could not open Pervasive Meta Data File:" * String(sToPath) - "\File.ddf") End // If (iToDbType = 6) Begin If Not iRetval Break // The Destination DDF file could not be opened. Get RDSOpenAsFile hoDD False True To iRetval If Not iRetval Error DfErr_Operator ("Could not open table:" * String(sToDataTable)) If Not iRetval Break // The Destination file could not be opened. // This must be done after Open Files: If (SncSys.DSN_Names <> "" And (Not(pbAutoStart(Self)))) Begin Delegate Get RdsMain_Panel_Id To ho Send DoCheckDSNName SncSys.DSN_Names ho End Get CheckIntegrity iFromFile iToFile sFromLayout sToLayout To iRetval If Not iRetval Break // One of the files has a changed database layout. Move (oTransformMainArray(Self)) To ho // Note: Must precede the defaults array! Send DoFillArray Of ho SncTable.SncTHea_Count SncTable.Recid Set pbTransform To (SncTable.SncTHea_Count > 0) // send dump of ho Move (oDefaultsArray(Self)) To ho // Note: Must be after the Transformation constraint_set! Send DoFillArray Of ho iToFile sDefaults Set pbDefaults To (Length(sDefaults) > 0) // send dump of ho // procedure_Return Move (oFromIndex(Self)) To ho Send DoFillArray Of ho iFromFile iFromIndex // Fill index fields array. // 2004-05-14 ------------------------------------ Start Nils G. Svedmyr Get_Attribute DF_FILE_IS_SYSTEM_FILE Of iFromFile To bSysFile If (bSysFile = False) Begin Get Item_Count Of ho To iRetval If Not iRetval Error DfErr_Operator ("Index not specified for table" * String(iFromFile)) If Not iRetval Break End // If (bSysFile = False) Begin // 2004-05-14 ------------------------------------ Stop Nils G. Svedmyr Move (oToIndex(Self)) To ho Send DoFillArray Of ho iToFile iToIndex // 2004-05-14 ------------------------------------ Start Nils G. Svedmyr Get_Attribute DF_FILE_IS_SYSTEM_FILE Of iToFile To bSysFile If (bSysFile = False) Begin Get Item_Count Of ho To iRetval If Not iRetval Error DfErr_Operator ("Index not specified for table" * String(iToFile)) If Not iRetval Break End // If (bSysFile = False) Begin // 2004-05-14 ------------------------------------ Stop Nils G. Svedmyr // Index array that keeps From file field numbers to seed the To file index segments with values before a find: Move (oIndexArrayFromString(Self)) To ho Send DoFillArray Of ho sFromFieldsToIdx // send dump of ho Get Item_Count Of ho To iRetval If Not iRetval Error DfErr_Operator ("Index Load fields not specified for table" * String(iToFile)) If Not iRetval Break // Fill fields array (Same array for both From and To Fields) Move (oFieldsArray(Self)) To ho Send DoFillArray Of ho iFromFile iFromStartField iFromStopField iToFile iToStartField iSynchType sSelFromFields sSelToFields iSelFieldCount Get Item_Count Of ho To iRetval // send dump of ho If Not iRetval Error DfErr_Operator ("No fields specified for tables" * String(iFromFile) * "and" * String(iToFile)) Move (oConstraintsArray(Self)) To ho Send DoFillArray Of ho sConstraints iConstrainCount // Fill constraints array. Get BuildConstraints Of ho iFromFile To iSet // iSet=Constraint_Set number. // send dump of ho Set pbConstraints To iConstrainCount Move (oSynchFlagsArray(Self)) To ho Send DoFillArray Of ho sSynchFlags iSynchFlagsCount // Fill synch flags array. Set pbSynchFlags To iSynchFlagsCount If iRetval Begin // Then all arrays has been filled properly. Get_Attribute DF_FILE_RECORDS_USED Of iFromFile To iRecords If (pbStatPnl(Self)) Begin Set Title_Text Of (phoStatPnl(Self)) To ("Total number of records:" * String(iRecords)) Set Message_Text Of (phoStatPnl(Self)) To ("Processing:" * ToOem(String(sText)) * "(" + String(iTable) * "of" * String(iTables) + ")") End // If (pbStatPnl(Self)) Begin Set piComparedRecords To 0 Set piUpdatedRecords To 0 Set piCopiedRecords To 0 Set piDeletedRecords To 0 Set pbCancelled To False Move 0 To Constrain_Found_Count Move 0 To Constrain_Tests_Count Send DoStartUpdate iFromFile iFromIndex iToFile iToIndex iSynchType iSaveInterval If (pbConstraints(Self)) Begin Constraint_Set iSet Delete Send DoLogWork (" Filters (Constraints) in effect:" * String(iConstrainCount) * "Found Count:" * String(Constrain_Found_Count) * "Tests Count:" * String(Constrain_Tests_Count)) End // If (pbConstraints(Self)) Begin Send DoLogWork (" Total number of Source table records:" * String(iRecords)) Send DoLogWork (" Compared records:" * String(piComparedRecords(Self)) * "(Field selection type =" * String(iSynchType) + ")") Send DoLogWork (" Updated records:" * String(piUpdatedRecords(Self)) * "(Field selection type =" * String(iSynchType) + ")") Send DoLogWork (" Created records:" * String(piCopiedRecords(Self)) * "(Field selection type =" * String(iSynchType) + ")") Get_Attribute DF_FILE_RECORDS_USED Of iToFile To iRecords Send DoLogWork (" Total number of Destination table records:" * String(iRecords)) If (pbDelete_Records(Self) And Not(pbCancelled(Self))) Begin // This index array keeps To file field numbers to fill the From file index segments with values before a find: Send DoFillArray Of (oIndexArrayFromString(Self)) sToFieldsFromIdx Send DoDeleteOldRecords iFromFile iFromIndex iToFile iToIndex iSynchType Send DoLogWork (" Deleted records:" * String(piDeletedRecords(Self)) * "(Synchtype =" * String(iSynchType)) End // If (pbDelete_Records(Self) and Not(pbCancelled(Self))) Begin End // If iRetval Begin Send DoCloseFiles iFromFile iToFile End // If bChecked Begin If Not (pbCancelled(Self)) Get CancelCheck To iRetval If iRetval Break Send ReDisplayWindow // Procedure in SyncFuncs.pkg Loop // For iItem From 0 to (iItem_Count -1) End_Procedure // DoRunProcess Procedure Set Status_Help String sHelp Set Status_Help Of (phoStatusBar(Self)) To sHelp End_Procedure // Set Status_Help Procedure DoReindexToolFileList Handle hoGrid Integer iRetval String sText If (pbStatPnl(Self)) Send Stop_StatusPanel Of (phoStatPnl(Self)) Move "Process stopped. Index error in CrossMerge's 'SncTable' data table. It needs to be reindexed." To sText Send DoLogWork sText If Not (pbAutoStart(Self)) Begin Get YesNo_Box (sText * "\nReindex Tool tables now?") To iRetval If (iRetval = MBR_No) Begin Move "Reindex process of Tool tables cancelled by user." To sText Send DoLogWork ("Error:" * sText * "The program was aborted.") Send Info_Box (sText * "Program will be aborted.") Abort End // If (iRetval = MBR_No) Begin End // If Not (pbAutoStart(Self)) Begin Set pbReindex To True Get ReindexFiles Of oReindex (Self) To sText // Proc in Reindex.pkg. ho=CallbackObject Returns: String with status text. Set pbReindex To False Send DoLogWork ("Index Error in Tool table(s) fixed." * sText) If Not (pbAutoStart(Self)) Send Info_Box sText Send DoProcess hoGrid // Re-start the Synchronize process from the beginning! End_Procedure // DoReindexToolFileList Procedure DoUpdateSentinelPercentage Integer iFromRecords Integer iFromRecord Number nReady nTotal nPerc Move iFromRecords To nTotal Move iFromRecord To nReady Move ((nReady/nTotal) * 100) To nPerc Send Update_StatusPanel Of (phoStatpnl(Self)) ("__PROGRESS__" + String(Integer(nPerc))) End_Procedure // DoUpdateSentinelPercentage Procedure DoCloseFiles Integer iFromFile Integer iToFile Close iFromFile Close iToFile End_Procedure // DoCloseFiles // HOW SHOULD THIS BE HANDLED IF THERE'S ONLY MULTI-SEGMENT INDEXES, OR NO INDEX DEFINED??? // Example: See IBM DB2 "SAMPLE" DATABASE; TABLE "SALES" // // This can be called for CLI drivers to auto set the record identity. Procedure DoSetPrimaryIndex Integer iFile Integer iField iIndexes iCount iSegments iIndex iLowSegments iFields iType Get_Attribute Df_File_Record_Identity Of iFile To iField If (iField > 0) Begin Get_Attribute Df_Field_Index Of iFile iField To iIndex Set piIndex To iIndex End // If (iField > 0) Begin If (iField <= 0) Begin Move 100 To iLowSegments // Just a high number Get_Attribute DF_FILE_LAST_INDEX_NUMBER Of iFile To iIndexes For iCount From 1 To iIndexes Get_Attribute DF_INDEX_NUMBER_SEGMENTS Of iFile iCount To iSegments If (iSegments = 1) Break If (iSegments < iLowSegments) Begin Move iCount To iIndex // Index with the lowest number of index segments Move iSegments To iLowSegments End // If (iSegments < iLowSegments) Begin Loop // For iCount From 1 To iIndexes If (iSegments = 1) Begin Get_Attribute DF_INDEX_SEGMENT_FIELD Of iFile iCount 1 To iField Move -1 To iIndex End // If (iSegments = 1) Begin Else Begin Get_Attribute DF_FILE_NUMBER_FIELDS Of iFile To iFields For iCount from 1 to iFields Get_Attribute DF_FIELD_TYPE Of iFile To iType If (iType = DF_BCD) Break Loop // For iCount from 1 to iFields Move iCount To iField End // Else Begin End // Else Begin Set_Attribute DF_FILE_RECORD_IDENTITY Of iFile To iField End_Procedure // DoSetPrimaryIndex // Purpose: To compare two files and add records in the second file // that doesn't exist and/or update field values in the // second file that has changed in the first file. // Syntax: // {From file number} {From-file-index} {To-file-number} {To-file-index} {Synchronization type (=1,2 or 3)} // Uses: CompareRecord function and DoCopyRecords, DoCopyManually procedures. // Note: // An index for sFromIndex and an unique index for sToIndex must exist. Procedure DoStartUpdate Integer iFromFile Integer iFromIndex Integer iToFile Integer iToIndex Integer iSynchType Integer iSaveInterval Handle hoToIndex hoIndexArrayFromString Integer iChanged iRecords iSaveCounter iLocks Integer iFromField iToField iCount iRetval iSegments iFromRecords iFromRecord String sFromValue sFieldValue sText sDriver Boolean bConstraints bFound bSynchFlags bSysFile // Check if iFromFile is empty. Get_Attribute DF_FILE_RECORDS_USED Of iFromFile To iFromRecords If Not iFromRecords Begin Send DoLogWork " The Source table was empty. No processing was performed." Procedure_Return // Empty From data file. Nothing to do here. End // If Not iFromRecords Begin Move (oToIndex(Self)) To hoToIndex Move (oIndexArrayFromString(Self)) To hoIndexArrayFromString Get pbConstraints To bConstraints Get pbSynchFlags To bSynchFlags // -1, the index to use will be determined automatically from the constraints in force. // showln "iFromIndex = " iFromIndex Move -1 To iFromIndex Get_Attribute DF_FILE_DRIVER of iFromFile To sDriver If (C_CKDrivers Contains sDriver And sDriver <> DFBTRDRV_ID) Begin Send DoSetPrimaryIndex iFromFile // Class procedure. End // If (C_CKDrivers Contains sDriver And sDriver <> DFBTRDRV_ID) Begin // 2004-09-22 ------------------------------------ Start Nils G. Svedmyr Get_Attribute DF_FILE_DRIVER of iToFile To sDriver If (C_CKDrivers Contains sDriver And sDriver <> DFBTRDRV_ID) Begin Send DoSetPrimaryIndex iToFile // Class procedure. End // If (C_CKDrivers Contains sDriver And sDriver <> DFBTRDRV_ID) Begin // 2004-09-22 ------------------------------------ Stop Nils G. Svedmyr // move 1000 to iSaveInterval // *** TEMP ***** // move 0 to iSaveInterval // *** TEMP ***** Constrained_Find First iFromFile by iFromIndex // FIND FIRST SOURCE RECORD: // Check if iToFile is empty. If empty copy _all_ records from iFromFile and return. Get_Attribute DF_FILE_RECORDS_USED Of iToFile To iCount If Not iCount Begin // Lock Send DoCopyManually iFromFile iToFile (False) iFromIndex iSaveInterval // Use only constrained records and selected field numbers // Unlock Get_Attribute DF_FILE_RECORDS_USED Of iToFile To iRecords Set piCopiedRecords To iRecords Procedure_Return // ...and we're out of here. End // If Not iCount Begin // 2004-05-14 ------------------------------------ Start Nils G. Svedmyr // Move (False) To bSysFile // Get_Attribute DF_FILE_DRIVER Of iToFile To sDriver // If (sDriver = FLEX_DRV_ID) Begin Get_Attribute DF_FILE_IS_SYSTEM_FILE Of iToFile To bSysFile // End // If (Driver = FLEX_DRV_ID) Begin // 2004-05-14 ------------------------------------ Stop Nils G. Svedmyr Get Item_Count Of hoToIndex To iSegments While (Found) // If parameter has been passed to this procedure, // only save changed iToFile records after iSaveInterval: // If iSaveInterval Begin // If (iSaveCounter = 0) Lock //RDC_Begin_Transaction // Increment iSaveCounter // End // If iSaveInterval Begin Move "" To sFromValue Clear iToFile For iCount From 0 To (iSegments -1) // Load ToFile index segments with values from FromFile: Get Integer_Value Of hoIndexArrayFromString item iCount To iFromField Get Integer_Value Of hoToIndex item iCount To iToField If (iFromField < 0 Or iToField < 0) Begin Error DfErr_Operator ("An error occured while initializing the ToFile index field(s) to find records to delete." * "Index load fields: iFrom field =" * String(iFromField) * "iTo field =" * String(iToField)) // If iSaveInterval Abort_Transaction Procedure_Return End // If (iFromField = 0 or iToField = 0) Begin Get_Field_Value iFromFile iFromField To sFieldValue Move (Trim(sFieldValue)) To sFieldValue If (bSysFile = False) ; Set_Field_Value iToFile iToField To sFieldValue Loop // For iCount from 0 to (iSegments -1) // All index segments should now be filled; find record: If (bSysFile = False) Begin Vfind iToFile iToIndex Eq End // If (bSysFile = False) Begin If (bSysFile = True) Begin Clear iToFile Vfind iToFile 0 Gt End // If (bSysFile = True) Begin Move (Found) To bFound // For some reason the next couple of lines changes the found indicator // Display the driver equivivalent of 'Recnum' in status panel: Get_Attribute DF_FILE_RECORD_IDENTITY Of iFromFile To iFromField // This sets the found indicator? Get_Field_Value iFromFile iFromField To sFieldValue If (bFound) Move "Comparing id:" To sText Else Move "Creating id:" To sText Move (sText * String(ToOem(sFieldValue))) To sText If (pbStatPnl(Self)) Set Action_Text Of (phoStatPnl(Self)) To sText Else Set Status_Help To (sText * "for" * psText(Self)) // Not found, Create one record: If Not bFound Begin // If (iSynchType = 1 and Not(bConstraints) and Not(pbDefaults(Self)) and Not(pbTransform(Self))) ; // Send DoCopyRecords iFromFile iToFile (True) iFromIndex // Create 1 record with the copy_records command. // Else Send DoCopyManually iFromFile iToFile (True) iFromIndex iSaveInterval // Create 1 record. Only use selected field numbers Send DoCopyManually iFromFile iToFile (True) iFromIndex 0 // Create 1 record. Only use selected field numbers End // If Not (bFound) Begin Else Begin // ToFile record Found; Check if update is needed in ToFile and save changed record. Begin_Transaction Indicate Err False // 2004-04-01 ------------------------------------ Start Nils G. Svedmyr If (bSysFile = True) Vfind iToFile 0 Eq // Vfind iToFile 0 Eq // 2004-04-01 ------------------------------------ Stop Nils G. Svedmyr Get CompareRecords iFromFile iToFile To iChanged Set piComparedRecords To (piComparedRecords(Self) + 1) If (iChanged > 0) Begin // If iChanged > 0 the record has changed. Set pbSynchErr To False SaveRecord iToFile // SAVE updated destination record! If Not (pbSynchErr(Self)) Begin Set piUpdatedRecords To (piUpdatedRecords(Self) + 1) If bSynchFlags Begin Send DoUpdateSourceFile iFromFile True // Update Source record with flag fields (if any). End // If bSynchFlags Begin End // If Not (pbSynchErr(Self)) Begin End // If (iChanged > 0) Begin End_Transaction If (iChanged < 0) Begin If (iChanged = -1) Error DfErr_Operator "Source table number or index error" Else If (iChanged = -2) Error DfErr_Operator "Destination table number or index error" // If iSaveInterval Abort_Transaction Procedure_Return If (iChanged = -3) Error DfErr_Operator "Could not update a Destination table field" // Continue processing! End // Else If (iChanged < 0) Begin End // Else Begin (Record Found) // If (iSaveInterval And (iSaveCounter = iSaveInterval)) Begin // Unlock // RDC_End_Transaction // Move 0 To iSaveCounter // End // If (iSaveInterval And (iSaveInterval = iSaveCounter)) Begin If Not (pbCancelled(Self)) Get CancelCheck To iRetval If (pbCancelled(Self)) Begin // If iSaveInterval Abort_Transaction Procedure_Return End // If (pbCancelled(Self)) Begin If (piLicenseType(ghoApplication) = piDemoType(Self) And ((piComparedRecords(Self) + piUpdatedRecords(Self)) >= piDemoMax(Self))) Begin // If iSaveInterval Abort_Transaction Procedure_Return // EVAL license. Stop working. End Constrained_Find Next // Add 1 To iSaveCounter Add 1 To iFromRecord If (pbStatPnl(Self)) Send DoUpdateSentinelPercentage iFromRecords iFromRecord Send ReDisplayWindow // Procedure in SyncFuncs.pkg Loop // While (Found) // If iSaveInterval Begin // Get_Attribute DF_TRAN_COUNT To iLocks // If iLocks UnLock // End // If iSaveInterval Begin End_Procedure // DoStartUpdate // Returns: A positive integer (1) if a field has changed: // A negative integer if an error occured while updating a field value. // False if no change. Function CompareRecords Integer iFromFile Integer iToFile Returns Integer Integer iChanged iFields iCount iField iPos iFromField iToField iType iToType iLength iPrec iRecid iStart String sFromValue sToValue sAppend sFieldValue sFile sField sRecid sFromTestValue sToTestValue Handle hoFieldTypeArray hoFieldsArray hoDefaultsArray hoAppendArray hoTransformMainArray hoTransformArray Boolean bDefaults Get pbDefaults To bDefaults Get Item_Count Of oFieldsArray To iFields // Contains both Source and Destination table field numbers. Move (oFieldsArray(Self)) To hoFieldsArray Get phoFieldTypeArray Of hoFieldsArray To hoFieldTypeArray Move (oDefaultsArray(Self)) To hoDefaultsArray Move (oAppendArray(Self)) To hoAppendArray If (pbTransform(Self)) Move (oTransformMainArray(Self)) To hoTransformMainArray // Compare the two field values and update iToFile field value if not same. Move 0 To iStart For iCount From iStart To (iFields -1) Get Integer_Value Of hoFieldsArray item iCount To iFromField Get_Field_Value iFromFile iFromField To sFromValue Move (Trim(sFromValue)) To sFromValue Get String_Value Of hoAppendArray item iCount To sAppend If (Trim(sAppend) <> 0) Begin // Then field values in Source table have been _appended_ together: Move (sAppend + " ") To sAppend Get_Attribute DF_FIELD_TYPE Of iFromFile iFromField To iType Get Integer_Value Of hoFieldsArray Item (iCount + 1) To iToField Get_Attribute DF_FIELD_TYPE Of iToFile iToField To iToType Repeat Move (Pos(" ", sAppend)) To iPos If iPos Begin Move (Left(sAppend, (iPos - 1))) To iField Move (Replace((String(iField) + " "), sAppend, '')) To sAppend Get_Field_Value iFromFile iField To sFieldValue If (iToType = DF_ASCII Or iType = DF_TEXT) ; Move (String(sFromValue) * String(sFieldValue)) To sFromValue Else ; Move (String(sFromValue) + String(sFieldValue)) To sFromValue End // If iPos Begin Until (sAppend = "" Or Not(iPos)) End // If (Trim(sAppend) > 0) Begin If (Err) Function_Return (-1) Get Integer_Value Of hoFieldsArray Item (iCount + 1) To iToField Get_Field_Value iToFile iToField To sToValue Move (Trim(sToValue)) To sToValue If (Err) Function_Return (-2) // Has transformation of field values been used? // Function IsFieldInArray returns the array handle with transformation values // if this field number. If the field has used transformation values, we call // function CheckTransformValues that will substitute to the correct values: If (pbTransform(Self)) Begin Get IsFieldInArray Of hoTransformMainArray iFromField iToField To hoTransformArray If hoTransformArray Get CheckTransformValues sFromValue sToValue hoTransformArray To sFromValue End // If (pbTransform(Self)) Begin // Q: Should default values be applied when a field value transformation table is used? Probably not... If (Length(sFromValue) = 0 And bDefaults) Begin Get String_Value Of hoDefaultsArray item (iToField - 1) To sFromValue If (sFromValue = "|") Move "" To sFromValue End // If (Length(sFromValue) = 0 And bDefaults) Begin Move sFromValue To sFromTestValue Move sToValue To sToTestValue If (pbFromOemToAnsi(Self) <> pbToOemToAnsi(Self)) Begin If (pbFromOemToAnsi(Self) = True) Move (ToOem(sFromValue)) To sFromTestValue Else If (pbToOemToAnsi(Self) = True) Move (ToOem(sToValue)) To sToTestValue End // If (pbFromOemToAnsi(Self) <> pbToOemToAnsi(Self)) Begin If (sFromTestValue <> sToTestValue) Begin // Not same field value, update iToFile field value: //DEBUG: Send DoLogWork ("iFromField = " + String(iFromField) + " sFromValue = " + String(sFromValue) + " iToField = " + String(iToField) + " sToValue = " + String(sToValue) + " iField = " + String(iField) + " sFieldValue = " + String(sFieldValue)) // Move 1 To iChanged Set_Field_Value iToFile iToField To sFromValue If (Err) Function_Return (-3) Get_Field_Value iToFile iToField To sToValue Move (Trim(sToValue)) To sToValue If (sFromTestValue <> sToTestValue) Begin Get psToDataTable To sFile Get_Attribute DF_FIELD_NAME Of iToFile iToField To sField Get_Attribute DF_FILE_RECORD_IDENTITY Of iToFile To iRecid Get_Field_Value iToFile iRecid To sRecid If (Length(sFromValue) > Length(sToValue)) ; Send DoLogWork (" Warning! Updated data didn't fit in field/column:" * String(sFile + "." + sField) * "The new value should be:" * String(sFromValue) ; * "but it is:" * String(sToValue) * "Destination Table Record id:" * String(sRecid)) Else Begin Send DoLogWork (" Warning! Could not properly update field/column value:" * String(sFile + "." + sField) * "The new value should be:" * String(sFromValue) ; * "but it is:" * String(sToValue) * "Destination Table Record id:" * String(sRecid)) End // Else Begin End // If (sFromTestValue <> sToTestValue) Begin End // If (Trim(sFromValue) <> sToValue) Begin Increment iCount Loop // For iCount from 1 to iFields Function_Return (iChanged) End_Function // CompareRecords // The Copy_Records command copies record data between database files of the // same or different types and/or structures. Data is copied from // each field in the source file for which a field of the SAME NAME // exists in the target file. Other than name, the fields do not have // to have the same size or type attributes, since data conversions // will take place automatically. // If the record buffer of the {from-file-number} file is active, the // copy starts from the active record and proceeds until {num-records} // records have been copied to the target file. // If the record buffer of the source file is inactive, the copy starts // at the first record (based on {index-num}) in the source file. // If any copied record contains a field value matching the value in // any other record and the field participates in an on-line unique // index, Error 28 Duplicate records not allowed in file will be returned, // and the record will not be copied. // The destination file does not have to contain all the fields that the // source file does; whichever ones it has will be copied. // DAC Syntax: // Copy_Records {from-file-number} to {to-file-number} [{num-records}] ; // [Using {index-num}] ; // [Callback {callback-object}] // Note: If iRecords = 0, all FromFile records will be copied to ToFile. Procedure DoCopyRecords Integer iFromFile Integer iToFile Boolean bOne Integer iFromIndex String sText If Not bOne Begin // Then copy all records Clear iFromFile Send DoLogWork (" Copying all records." * psText(Self)) Move ("Copying all records") To sText If (pbStatPnl(Self)) Set Title_Text Of (phoStatPnl(Self)) To sText Else Set Status_Help To (sText * "for" * psText(Self)) End // If Not bOne Begin Clear iToFile If bOne Copy_Records iFromFile To iToFile 1 Using iFromIndex // No callback! Else Copy_Records iFromFile To iToFile 0 Using iFromIndex Callback Self End_Procedure // DoCopyRecords // If iRecords = 0 is passed the entire iFromFile will be copied to iToFile. // If iRecords > 0 the specified number of iRecords will be copied and this implies // that the copy will start with the current record in iFromFile Procedure DoCopyManually Integer iFromFile Integer iToFile Boolean bOne Integer iFromIndex Integer iSaveInterval Handle ho hoDefaultsArray hoAppendArray hoTransformMainArray hoTransformArray Boolean bConstraints bDefaults bTransform bSynchFlags Integer iFields iCount iField iFromField iToField iType iToType iRecid iRecordIdentifier iStart iTest Integer iRecs iRetval iRecCount iPos iRecIDField Integer iSaveCounter iLocks String sValue sText sAppend sFieldValue sFile sField sRecid sRecIDValue sDefault Move (oDefaultsArray(Self)) To hoDefaultsArray Move (oAppendArray(Self)) To hoAppendArray Get pbConstraints To bConstraints Get pbSynchFlags To bSynchFlags Get pbDefaults To bDefaults Get pbTransform To bTransform If bTransform Move (oTransformMainArray(Self)) To hoTransformMainArray If Not bOne Begin // Then copy all records Get_Attribute DF_FILE_RECORDS_USED Of iFromFile To iRecs // Set up number of outer loops If bConstraints Move ("Copying all constrained records") To sText Else Move ("Copying all records") To sText Send DoLogWork (" " + sText) If (pbStatPnl(Self)) Set Title_Text Of (phoStatPnl(Self)) To sText Else Set Status_Help To (sText * "for" * psText(Self)) End // If Not bOne Begin Get_Attribute DF_FILE_RECORD_IDENTITY Of iToFile To iRecordIdentifier Indicate Found True Move (oFieldsArray(Self)) To ho Get Item_Count Of ho To iFields // showln "oFieldsArray = " ho " iFields = " iFields Move -1 To iFromIndex // If bConstraints Move -1 to iFromIndex If Not bOne Constrained_Find First iFromFile by iFromIndex // -1, the index to use will be determined automatically from the constraints in force. While (Found) If (Found) Begin Get_Attribute Df_File_Record_Identity Of iFromFile To iRecIDField Get_Field_Value iFromFile iRecIDField To sRecIDValue // Gets ID in buffer Set psCurrentRecid To sRecIDValue // Class property used by DoLogWork procedure. // If ((Not(bOne) And iSaveInterval)) Begin // If (iSaveCounter = 0) Lock // Increment iSaveCounter // End // If ((Not(bOne) And iSaveInterval)) Begin Clear iToFile For iCount From 0 To (iFields -1) Get Integer_Value Of ho item iCount To iFromField Get_Field_Value iFromFile iFromField To sValue Move (Trim(sValue)) To sValue Get String_Value Of hoAppendArray item iCount To sAppend If (Trim(sAppend) <> 0) Begin // Then field values in Source table will be appended: Move (sAppend + " ") To sAppend Get_Attribute DF_FIELD_TYPE Of iFromFile iFromField To iType Get Integer_Value Of ho item (iCount + 1) To iToField Get_Attribute DF_FIELD_TYPE Of iToFile iToField To iToType Repeat Move (Pos(" ", sAppend)) To iPos If iPos Begin Move (Left(sAppend, (iPos - 1))) To iField Move (Replace((String(iField) + " "), sAppend, '')) To sAppend Get_Field_Value iFromFile iField To sFieldValue If (iToType = DF_ASCII Or iType = DF_TEXT) ; Move (String(sValue) * String(sFieldValue)) To sValue Else ; Move (String(sValue) + String(sFieldValue)) To sValue End // If iPos Begin Until (sAppend = "" Or Not(iPos)) End // If (Trim(sAppend) > 0) Begin Get Integer_Value Of ho item (iCount + 1) To iToField // Has transformation of field values been used? // Function IsFieldInArray returns the array handle with transformation values // for this field number. If the field has used transformation values, we call // function CheckTransformValues that will substitute to the correct values: If bTransform Begin Get IsFieldInArray Of hoTransformMainArray iFromField iToField To hoTransformArray If hoTransformArray Get TransformValues sValue hoTransformArray To sValue End // If bTransform Begin Get_Attribute DF_FIELD_TYPE Of iToFile iToField To iType If (iType = DF_BCD) Move (Integer(sValue)) To sValue If (iToField = 1 And iRecordIdentifier = 1) Decrement iToField Set_Field_Value iToFile iToField To sValue // Do check to see that the field was properly updated, else log the error: Get_Field_Value iToFile iToField To sFieldValue If (Length(Trim(sValue)) > Length(Trim(sFieldValue))) Begin Get psToDataTable To sFile Get_Attribute DF_FIELD_NAME Of iToFile iToField To sField Get_Attribute DF_FILE_RECORD_IDENTITY Of iToFile To iRecid Get_Field_Value iToFile iRecid To sRecid If (Length(sValue) > Length(Trim(sFieldValue))) ; Send DoLogWork (" Warning! New data didn't fit in field/column:" * String(sFile + "." + sField) * "The new value should be:" * String(sValue) ; * "but it is:" * String(sFieldValue) * "Record id:" * String(sRecid)) Else ; Send DoLogWork (" Warning! Could not set new field/column value:" * String(sFile + "." + sField) * "The new value should be:" * String(sValue) ; * "but it is:" * String(sFieldValue) * "Record id:" * String(sRecid)) End // If (sValue <> Trim(sFieldValue)) Begin Increment iCount Loop // For iCount from 0 to (iFields -1) // We need to setup default values for fields that is null and that was not handled above: If (bDefaults And Not(bTransform)) Begin Get_Attribute DF_FILE_NUMBER_FIELDS Of iToFile To iTest For iCount From 1 To iTest Get_Attribute DF_FIELD_TYPE Of iToFile iCount To iType Get_Field_Value iToFile iCount To sValue Move (Trim(sValue)) To sValue If (iType = DF_BCD And sValue = "0") Move "" To sValue // Driver always returns a '0' even if Null. If (Length(sValue) = 0) Begin Get String_Value Of hoDefaultsArray Item (iCount -1) To sFieldValue // The default value. If (sFieldValue = "|") Begin If (iType = DF_ASCII Or iType = DF_TEXT) Move "" To sFieldValue Else Move 0 To sFieldValue End // If (sFieldValue = "|") Begin If (iType = DF_BCD) Move (Integer(sFieldValue)) To sFieldValue Set_Field_Value iToFile iCount To sFieldValue End // If (Length(sValue) = 0) Begin Loop // For iCount From 1 To iTest // For iCount From 1 To iTest // *** DEBUG CODE *** // Get_Field_Value iToFile iCount To sValue // Loop // For iCount From 1 To iTest End // If (bDefaults And Not(bTransform)) Begin Set pbSynchErr To False Saverecord iToFile // SAVE NEW Destination record! If Not (pbSynchErr(Self)) Begin Set piCopiedRecords To (piCopiedRecords(Self) + 1) If bSynchFlags Begin Begin_Transaction Send DoUpdateSourceFile iFromFile True // Update Source data table fields (if flag fields has been set). End_Transaction End // If bSynchFlags Begin End // If Not (pbSynchErr(Self)) Begin End // If (Found) Begin If bOne Indicate Found False Else Begin If Not (pbCancelled(Self)) Get CancelCheck To iRetval If iRetval Procedure_Return Increment iRecCount // Display progress in sentinel: Get Callback (String(iRecCount) + "," + String(iRecs)) DF_MESSAGE_PROGRESS_VALUE To iRetval If (piLicenseType(ghoApplication) = piDemoType(Self) And piCopiedRecords(Self) + piUpdatedRecords(Self) >= piDemoMax(Self)) Begin // If (Not(bOne) And iSaveInterval) Begin // Get_Attribute DF_TRAN_COUNT To iLocks // If iLocks UnLock // End // If (Not(bOne) And iSaveInterval) Begin Procedure_Return // EVAL license. Stop working. End // If (piLicenseType(ghoApplication = piDemoType(Self) And piCopiedRecords(Self) = piDemoMax(Self)) Begin Constrained_Find Next End // Else Begin End // While (Found) // If (Not(bOne) And iSaveInterval) Begin // Get_Attribute DF_TRAN_COUNT To iLocks // If iLocks UnLock // End // If (Not(bOne) And iSaveInterval) Begin End_Procedure // DoCopyManually // Deletes records in the ToFile that no longer exist in the FromFile: Procedure DoDeleteOldRecords Integer iFromFile Integer iFromIndex Integer iToFile Integer iToIndex Integer iSynchType Integer iFromField iToField iCount iRetval iSegments iToRecords iToRecord iRecords String sToFieldValue sFieldValue String sText Move (" Checking and removing old records") To sText // for" * psText(Self)) to sText Send DoLogWork sText // Check if iToFile is empty. Get_Attribute DF_FILE_RECORDS_USED Of iToFile To iToRecords If Not iToRecords Begin Send DoLogWork " The Destination table was empty. No records to delete." Procedure_Return // Empty Tofile. Nothing to do here... End // If Not iCount Begin If (pbStatPnl(Self)) Begin Set Action_Text Of (phoStatPnl(Self)) To "" Set Title_Text Of (phoStatPnl(Self)) To (Trim(sText)) End // If (pbStatPnl(Self)) Begin Else Set Status_Help To (sText * "for" * psText(Self)) // Find first record in To-file: // Constrained_Find First iToFile by iToIndex // USE INSTEAD ???? Clear iToFile Vfind iToFile iToIndex Gt If Not (Found) Begin Error DfErr_Operator "Index error in 'ToFile'. The table needs to be reindexed." Procedure_Return // We have previously checked that records exist in this file, so must be index error. End // If Not (Found) Begin // Load FromFile index segments with values from ToFile: Get Item_Count Of oFromIndex To iSegments While (Found) Move "" To sToFieldValue // Start with a cleared FromFile: Clear iFromFile For iCount From 0 To (iSegments -1) Get Integer_Value Of oFromIndex item iCount To iFromField Get Integer_Value Of oIndexArrayFromString item iCount To iToField If (iFromField < 0 Or iToField < 0) Begin Error DfErr_Operator ("An error occured while initializing the FromFile index field(s) to find records to delete." * "Index load fields: iFrom field =" * String(iFromField) * "iTo field =" * String(iToField)) Procedure_Return End // If (iFromField = 0 or iToField = 0) Begin Get_Field_Value iToFile iToField To sFieldValue Move (Trim(sFieldValue)) To sFieldValue Set_Field_Value iFromFile iFromField To sFieldValue Loop // For iCount from 0 to (iSegments -1) // All index segments should now be loaded; find FromFile record: // Constrained_Find eq iFromFile by iFromIndex // USE INSTEAD ???? Vfind iFromFile iFromIndex Eq // Not found in FromFile, delete ToFile record: If Not (Found) Begin Delete iToFile Set piDeletedRecords To (piDeletedRecords(Self) + 1) End // If (Not(Found)) Begin If (piLicenseType(ghoApplication) = piDemoType(Self) And piDeletedRecords(Self) = piDemoMax(Self)) Procedure_Return // EVAL license. Stop working. // Constrained_Find Next // USE INSTEAD ???? Vfind iToFile iToIndex Gt // Find next ToFile record. Add 1 To iToRecord If (pbStatPnl(Self)) Send DoUpdateSentinelPercentage iToRecords iToRecord If Not (pbCancelled(Self)) Get CancelCheck To iRetval If iRetval Procedure_Return Loop // While (Found) End_Procedure // DoDeleteOldRecords // If pbSynchFlags is True, update field/fields in the Source data table: Procedure DoUpdateSourceFile Integer iFile Boolean bLock Handle ho Boolean bSave Integer iCount iItems iField iPos iStart iTranCount String sValue sFlagVal sOldVal If Not (pbSynchFlags(Self)) Procedure_Return Move (oSynchFlagsArray(Self)) To ho Get_Attribute DF_TRAN_COUNT To iTranCount Get Item_Count Of ho To iItems If bLock Begin // Reread iFile // Reread Source record. *** THIS WON'T WORK FOR UNIQUE "ASCII" INDEXES!!! **** // Begin_Transaction // Lock Vfind iFile 0 Eq End // If bLock Begin Move 0 To iStart For iCount From iStart To (iItems - 1) Get String_Value Of ho Item iCount To sValue Move (Pos(" ", sValue)) To iPos If iPos Begin Move (Left(sValue, (iPos - 1))) To iField // Get the field number. Move (Right(sValue, (Length(sValue) - iPos))) To sValue // Remove the field number. Move (Pos("|", sValue)) To iPos // Only if more than one flag field has been defined. If iPos Begin Move (Left(sValue, (iPos - 1))) To sFlagVal Move (Right(sValue, (Length(sValue) - iPos))) To sValue // Remove the field value. End // If iPos Begin Else ; Move sValue To sFlagVal Get_Field_Value iFile iField To sOldVal Move (sOldVal <> sFlagVal) To bSave If bSave ; Set_Field_Value iFile iField To sFlagVal // CHANGE Source data table field value! // showln "Field = " iField " sFlagVal = " sFlagVal End // If iPos Begin Loop // For iCount from 0 to (iItems - 1) If bSave begin SaveRecord iFile // *** TEMPORARY FIX *** // This should be done for _all_ flag fields, right now it only // works if one flag field is used: Set_Field_Value iFile iField To sOldVal // CHANGE Source data table field value! Set_Attribute DF_FILE_CHANGED Of iFile To False // Reset file record buffer flag. // send dologwork "source record was saved" End // If bSave begin If bLock Begin // End_Transaction // If bLock UnLock End // If bLock Begin End_Procedure // DoUpdateSourceFile // Used by the Compare procedure. // Parameters: Current Field values for the Source table and the Destination table and an array handle. // The from values in the array are compared with the passed sFromValue and if there's a match, // the sToValue is swithed with the array value. // Returns the new sFromValue if the array contained the sFromValue, else returns // the sFromValue unchanged. Function CheckTransformValues String sFromValue String sToValue Handle TransformArray Returns String Integer iCount iItems iPos iCase String sValue sTransformFrom sTransformTo Move (Trim(sFromValue)) To sFromValue Move (Trim(sToValue)) To sToValue Get Item_Count Of TransformArray To iItems For iCount From 0 To (iItems - 1) Get String_Value Of TransformArray item iCount To sValue // This is how the sValue is build in the array: // SncTHea.FromField * SncTHea.ToField * SncTRow.IgnoreCase * sFromValue + "|" + sToValue Move (Pos(" ", sValue)) To iPos Move (Right(sValue, (Length(sValue) - iPos))) To sValue // First remove the From field number, we don't need it here, Move (Pos(" ", sValue)) To iPos Move (Right(sValue, (Length(sValue) - iPos))) To sValue // Then remove the To field number, we don't need it here, Move (Pos(" ", sValue)) To iPos Move (Left(sValue, (iPos - 1))) To iCase Move (Right(sValue, (Length(sValue) - iPos))) To sValue // then remove the Ignore_Case value, Move (Pos("|", sValue)) To iPos Move (Left(sValue, (iPos - 1))) To sTransformFrom // get the TransformFrom value, Move (Right(sValue, (Length(sValue) - iPos))) To sTransformTo // and finally get the TransformTo value. // showln "sFromValue = " sFromValue " sTransformFrom = " sTransformFrom " sToValue = " sToValue " sTransformTo = " sTransformTo " hoTransformArray = " hoTransformArray If (Not(iCase) And sFromValue = sTransformFrom And sFromValue <> sTransformTo) ; Function_Return sTransformTo If (iCase And Uppercase(sFromValue) = Uppercase(sTransformFrom) And Uppercase(sFromValue) <> Uppercase(sTransformTo)) ; Function_Return sTransformTo Loop // For iCount from 0 to (iItems - 1) Function_Return sFromValue End_Function // CheckTransformValues // Used by CopyManually procedure to transform ToValues. // Parameters: Current Field value for the Source table and array handle. // Returns the new sFromValue if the array contained the sFromValue, else returns // the sFromValue unchanged. Function TransformValues String sFromValue Handle hoTransformArray Returns String Integer iCount iItems iPos iCase String sValue sTransformFrom sTransformTo Get Item_Count Of hoTransformArray To iItems For iCount From 0 To (iItems - 1) Get String_Value Of hoTransformArray item iCount To sValue Move (Pos(" ", sValue)) To iPos Move (Right(sValue, (Length(sValue) - iPos))) To sValue // First remove the field number, we don't need it here, Move (Pos(" ", sValue)) To iPos Move (Right(sValue, (Length(sValue) - iPos))) To sValue // Then remove the To field number, we don't need it here, Move (Pos(" ", sValue)) To iPos Move (Left(sValue, (iPos - 1))) To iCase Move (Right(sValue, (Length(sValue) - iPos))) To sValue // then remove the Ignore_Case value. Move (Pos("|", sValue)) To iPos Move (Left(sValue, (iPos - 1))) To sTransformFrom Move (Right(sValue, (Length(sValue) - iPos))) To sTransformTo If (Not(iCase) And sFromValue = sTransformFrom And sFromValue <> sTransformTo) ; Function_Return sTransformTo If (iCase And Uppercase(sFromValue) = Uppercase(sTransformFrom) And Uppercase(sFromValue) <> Uppercase(sTransformTo)) ; Function_Return sTransformTo Loop // For iCount from 0 to (iItems - 1) Function_Return sFromValue End_Function // TransformValues // Checks for database integrity i.e. that not one of the fields involved in the synzhronization // process has changed. // Returns True if "successful". I.e. the synchronization process should be run. // False if failed. Then a warning msg is changed to the log file. Function CheckIntegrity Integer iFromFile Integer iToFile String sFromLayout String sToLayout Returns Integer Integer iRetval iStart iEnd iPos If Not (pbCheckIntegrity(Self)) Function_Return True If (Length(sFromLayout) = 0 Or Length(sToLayout) = 0) Begin Send DoLogWork (" Warning! 'Check For Database Table Layout Changes before Connecting' has been set to on but the 'snapshot' of the databases has not been performed in the RDC Main Setup program.") Function_Return (False) End // If (Length(sFromLayout) = 0 or Length(sToLayout) = 0) Begin Move (Pos(" ", sFromLayout)) To iPos Move (Left(sFromLayout, (iPos - 1))) To iStart Get CheckNoOfFields sFromLayout To iEnd Get IsCheckIntegrity iFromFile iStart iEnd sFromLayout To iRetval If iRetval Begin Send DoLogWork (" Warning! The database layout has changed for Source table. No connection was performed.") Function_Return (False) End // If iRetval Begin Else Send DoLogWork (" 'Database Table Layout Changes' was checked for the Source table. It was ok.") Move (Pos(" ", sToLayout)) To iPos Move (Left(sToLayout, (iPos - 1))) To iStart Get CheckNoOfFields sToLayout To iEnd Get IsCheckIntegrity iToFile iStart iEnd sToLayout To iRetval If iRetval Begin Send DoLogWork (" Warning! The database layout has changed for Destination table. No connection was performed.") Function_Return (False) End // If iRetval Begin Else Send DoLogWork (" 'Database Table Layout Changes' was checked for the Destination table. It was ok.") Function_Return (True) End_Function // CheckIntegrity // Help function for the CheckIntegrity function. // Returns True if any field has changed. // False if all fields are the same. Function IsCheckIntegrity Integer iFile Integer iStart Integer iEnd String sLayout Returns Integer Integer iType iLength iPrec iTypeOrg iLengthOrg iPrecOrg iCount iPos iRetval iField String sSub Move (sLayout - "|") To sLayout For iCount From iStart To iEnd Get_Attribute DF_FIELD_TYPE Of iFile iCount To iType Get_Attribute DF_FIELD_LENGTH Of iFile iCount To iLength Get_Attribute DF_FIELD_PRECISION Of iFile iCount To iPrec Move (Pos("|", sLayout)) To iPos Move (Left(sLayout, (iPos - 1))) To sSub Move (Right(sLayout, (Length(sLayout) - iPos))) To sLayout Move (Pos(" ", sSub)) To iPos Move (Left(sSub, (iPos - 1))) To iField Move (Right(sSub, (Length(sSub) - iPos))) To sSub Move (Pos(" ", sSub)) To iPos Move (Left(sSub, (iPos - 1))) To iTypeOrg Move (Right(sSub, (Length(sSub) - iPos))) To sSub Move (Pos(" ", sSub)) To iPos Move (Left(sSub, (iPos - 1))) To iLengthOrg Move (Right(sSub, (Length(sSub) - iPos))) To sSub Move (Trim(sSub)) To iPrecOrg //showln "iType = " iType " iTypeOrg = " iTypeOrg " iLength = " iLength " iLengthOrg = " iLengthOrg " iPrec = " iPrec " iPrecOrg = " iPrecOrg If (iType <> iTypeOrg Or iLength <> iLengthOrg Or iPrec <> iPrecOrg) Move (True) To iRetval If iRetval Break Loop // For iCount from iStart to iEnd Function_Return iRetval End_Function // IsCheckIntegrity Function CheckNoOfFields String sSelFields Returns Integer Integer iRetval iPos Move (Trim(sSelFields)) To sSelFields If (Length(sSelFields) = 0) Function_Return 0 Move (Pos("|", sSelFields)) To iPos If Not iPos Function_Return 1 // Necessary if only one field. Repeat Move (Replace("|", sSelFields, "")) To sSelFields Increment iRetval Until (Not(Pos("|", sSelFields))) Increment iRetval Function_Return iRetval End_Function // CheckNoOfFields // Do what we can to force the status panel to the top. If the main program gets // the focus force the status panel to take the focus. Procedure DoStatusPaneltoForeground Handle hwStat hwMain hMain Get Main_Window To hMain If Not hMain Broadcast Get Main_Window To hMain If hMain Get Window_Handle Of hMain To hwMain If hwMain Begin If (GetForegroundWindow() = hwMain) Begin Move (SentinelWindow(Desktop)) To hwStat If hwStat Move (SetForegroundWindow(hwStat)) To hwStat End End // If hwMain Begin End_Procedure // DoStatusPaneltoForeground Function CancelCheck Returns Integer Integer iRetval String sTitle sMessage sAction If (pbStatPnl(Self)) Begin Send DoStatusPanelToForeground Get Sentinel_Return_Value Of (phoStatPnl(Self)) To iRetval End // If (pbStatPnl(Self)) Begin // Else Get KeyPressedCheck to iRetval // Doesn't work. // showln "iRetval = " iRetval If iRetval Begin Get Title_Text Of (phoStatPnl(Self)) To sTitle Get Message_Text Of (phoStatPnl(Self)) To sMessage Get Action_Text Of (phoStatPnl(Self)) To sAction Send Stop_StatusPanel Of (phoStatPnl(Self)) Get YesNo_Box "Cancel Connect Engine process?" "" MB_DEFBUTTON2 To iRetval If (iRetval = MBR_Yes) Begin Set pbCancelled To (True) Function_Return (True) End // If (iRetval = MBR_Yes) Begin Else If (pbStatPnl(Self)) Begin Send Start_StatusPanel Of (phoStatPnl(Self)) Set Title_Text Of (phoStatPnl(Self)) To sTitle Set Message_Text Of (phoStatPnl(Self)) To sMessage Set Action_Text Of (phoStatPnl(Self)) To sAction End // Else If (pbStatPnl(Self)) Begin End // If (iRetval = MSG_CANCEL) Begin Function_Return (False) End_Function // CancelCheck // Function KeyPressedCheck Returns Integer // KeyCheck Function_Return (True) // This doesn't work... // End_Function Procedure Error_Report Integer iErrNum Integer iErrLine String sErrorText String sDFErrorText If (Error_Processing_State(Self)) Procedure_Return If (iErrNum = 4100 Or iErrNum = 4121 Or iErrNum = 0) Procedure_Return Set Error_Processing_State To True Set piErrorCount To (piErrorCount(Self) + 1) If (Length(sErrorText) = 0) Begin Get Error_Description Of (piOldErrorId(Self)) iErrNum iErrLine To sErrorText Move (Trim(Replace(iErrLine, sErrorText, ""))) To sErrorText End // If (Trim(sErrorText = "")) Begin // 2004-09-22 ------------------------------------ Start Nils G. Svedmyr If (iErrNum < 4097) Begin Move iErrNum To FlexErrs.Recnum Find Eq FlexErrs By Recnum If (Found) Move (Trim(FlexErrs.Error_Descr)) To sDFErrorText End // If (iErrNum < 4097) Begin // 2004-09-22 ------------------------------------ Stop Nils G. Svedmyr Send DoLogWork (" Error:" * "'" + String(sErrorText) + "'" * "No:" * String(iErrNum) * String(sDFErrorText) * "(on line:" * String(iErrLine) + ")") Set Error_Processing_State To False Indicate Err False Set pbSynchErr To True End_Procedure // Error_Report Procedure DoLogWork String sStatusText Integer hDD String sCurrentRecid DateTime dtCurrentDateTime Get psCurrentRecid To sCurrentRecid Move (CurrentDateTime()) To dtCurrentDateTime Move (SncLog_DD(Self)) To hDD Send Clear Of hDD If (sStatusText Contains "Field cannot be updated") Begin Move (sStatusText * "You probably need to set the 'DUMMY_UPDATE_COLUMN' keyword to a proper column number for the Destination table's .INT file.") To sStatusText End If (sStatusText Contains "Please enter a number" And psToFileDriver(Self) = ODBC_DRV_ID) Begin Move (sStatusText * "You probably need to set the 'PATCH2' keyword in the db2cli.ini file, to be able to handle decimal numbers with the ODBC CK driver and IBM DB2 databases.") To sStatusText End If (Uppercase(sStatusText) contains "ERROR") ; Move (sStatusText * "Source Table Record id:" * String(sCurrentRecid)) To sStatusText Set Field_Changed_Value Of hDD Field SncLog.StatusText To sStatusText If Not (sStatusText Contains "Ready.") ; Set Field_Changed_Value Of hDD Field SncLog.TableName To (ToOem(psText(Self))) Set Field_Changed_Value Of hDD Field SncLog.DateTime To dtCurrentDateTime Set Field_Changed_Value Of hDD Field SncLog.NetworkUserName To (psUser(Self)) Send Request_Save Of hDD End_Procedure // DoLogWork //*** Function: Callback //*** Purpose : Callback faciltiy enabler. Pass the information to the status //*** panel. Function Callback String sCallbackMsg Integer iCallbackType Returns Integer Number nReady nTotal nPerc Integer iRetval If (pbStatPnl(Self)) Begin If (iCallbackType <> DF_MESSAGE_PROGRESS_VALUE) ; Send Update_StatusPanel Of (phoStatPnl(Self)) sCallbackMsg Else Begin //*** Interpret numbers Move (Left(sCallbackMsg, (Pos(",", sCallbackMsg) - 1))) To nReady Move (Right(sCallBackMsg, (Length(sCallbackMsg) - Pos(",", sCallbackMsg)))) To nTotal Move ((nReady/nTotal) * 100) To nPerc Send Update_StatusPanel Of (phoStatPnl(Self)) ("__PROGRESS__" + String(Integer(nPerc))) If (pbReindex(Self)) ; Set Action_Text Of (phoStatPnl(Self)) To ("Reindexing" * String(nReady) * "of" * String(nTotal)) Else If (pbConstraints(Self)) ; Set Action_Text Of (phoStatPnl(Self)) To ("Testing/Copying record" * String(nReady) * "of" * String(nTotal)) Else ; Set Action_Text Of (phoStatPnl(Self)) To ("Copying record" * String(nReady) * "of" * String(nTotal)) End End // If (pbStatPnl(Self)) Begin If Not (pbCancelled(Self)) Get CancelCheck To iRetval Function_Return iRetval End_Function // Callback End_Class // cSynchronize