//AB/ Project Global Data Replacement //AB/ Object prj is a View_Project //AB/ Set ProjectName to "Global Data Replacement" //AB/ Set ProjectFileName to "Global.dg" //AB/ Set Size to 244 525 // Project Object Structure // oReplace_View is a dbModalPanel // oFile_Name is a Form // oFile_Numb is a dbForm // oSelection is a Form // oSel_Field_Name is a dbForm // oSel_Field_Numb is a dbForm // Replace_Data is a dbForm // oHelp_Btn is a Button // Replace_Button is a Button // Delete_Button is a Button // Index_Button is a Button // Exit_Button is a Button // LineControl1 is a LineControl // oReturnText is a Textbox // LineControl2 is a LineControl // LineControl3 is a LineControl // LineControl4 is a LineControl // LineControl5 is a LineControl // Register all objects Register_Object Delete_Button Register_Object Exit_Button Register_Object Index_Button Register_Object LineControl1 Register_Object LineControl2 Register_Object LineControl3 Register_Object LineControl4 Register_Object LineControl5 Register_Object oFile_Name Register_Object oFile_Numb Register_Object oHelp_Btn Register_Object oReplace_View Register_Object oReturnText Register_Object oSel_Field_Name Register_Object oSel_Field_Numb Register_Object oSelection Register_Object Replace_Button Register_Object Replace_Data //AB-StoreTopStart //=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= // GLOBAL.VW //=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Main View =-=-=-=-=-=-=-=-=-=-=-=-=-=-= // Register all objects for the compiler Register_Object Replace_Button Register_Object Delete_Button Register_Object Exit_Button Register_Object oIndexLookUp Register_Object oName_Array Register_Object Offset_Array Register_Object oFile_Num Register_Object oSel_File_Numb Register_Object oSel_Field_Numb Register_Object LineControl1 Register_Object LineControl2 Register_Object LineControl3 Register_Object LineControl4 Register_Object LineControl5 Use GlbIndexData.dg // Index data entry Use GlbIndexList.dg // Index pick list // Use GlbHelp.dg // Help edit box //---------------------------------------------------------------> // strip file_name from string //---------------------------------------------------------------> Function strip_field String sField_string Returns String String sTemp_string Integer iDot_location iLen Move (Trim(sField_string)) To sField_string Move (Length(sField_string)) To iLen Move (Pos(".", sField_string)) To iDot_location Move sField_string To sTemp_string If iDot_location Begin Move (Right(sField_string,(iLen-iDot_location))) To sTemp_string End Function_Return sTemp_string End_Function Function Check_File# Returns Integer If (FileNumber = 0) Begin Send Stop_Box "You Must Select A File From The Selection List -- Use The Popup Button." "Field Error" Function_Return 0 End Function_Return 1 End_Procedure Object file_array Is An array End_Object Object offSet_array Is An array End_Object //---------------------------------------------------------------> // This Object stores the field names FOR a particular file. The // pick list loads from this Object. //---------------------------------------------------------------> Object oName_array Is An Array Procedure adding String sField_Name String sOffSet# Integer iCount Get item_count To iCount Set Value Item iCount To sField_Name Set Value Of (offSet_array(Current_Object)) Item iCount To sOffSet# End_Procedure Procedure load_array String sFileName Integer iMaxFields iType iField# iFile# String sName sFieldRef Send delete_data Move FileNumber To iFile# If (iFile# = 0) Begin Send Stop_Box "File number is 0" Procedure_Return End Move FileNumber To iFile# Get_Attribute DF_FILE_NUMBER_FIELDS Of iFile# To iMaxFields For iField# From 0 To iMaxFields Get_Attribute DF_FIELD_NAME Of iFile# iField# To sName Get_Attribute DF_FIELD_TYPE Of iFile# iField# To iType If (iType = DF_ASCII Or iType = DF_TEXT Or iType = DF_OVERLAP Or iType = DF_BINARY); Move ("|FS"+String(FileNumber)+","+String(iField#)) To sFieldRef Else If (iType = DF_DATE ) Move ("|FD"+String(FileNumber)+","+String(iField#)) To sFieldRef Else If (iType = DF_BCD ) Move ("|FN"+String(FileNumber)+","+String(iField#)) To sFieldRef //-------------------------------------------------> //- do not permit use of overlap fields //-------------------------------------------------> If (iType <> DF_OVERLAP) Send adding (sFileName+"."+sName) sFieldRef Loop End_Procedure //--------------------------------------------> // Test the string to see if a mathematical // operator is contained in it. If so, return // the position. //--------------------------------------------> Function IsOperator String sval Returns Integer Integer iCount iTestLength Move (Length(sval)) To iTestLength If (iTestLength = 0) Function_Return 0 For iCount From 1 To (Length(sval)) If (Mid(sval,1,iCount)) in "=<>" Function_Return iCount Loop Function_Return 0 End_Function //--------------------------------------------> // Pass in: // CUSTOMER.MY_DATE=12/31/1999" // Returns in form: // |FD103,33="12/31/1999" // // Other operator: |FD103,33< "01/01/2000" //--------------------------------------------> Function Process_expr String sExpStr Returns String Integer iCount iCounter iPosition iOffSet_obj iDecimal iOperator String sField_Name sOffSet# sLookFor Get Item_count To iCount Move (OffSet_array(Current_Object)) To iOffSet_obj For iCounter From 0 To (iCount - 1) Get Value Item iCounter To sField_Name Get Value Of iOffSet_obj Item iCounter To sOffSet# Move (IsOperator(Self, sExpStr)) To iOperator Move (Left(sExpStr, (iOperator-1))) To sLookfor If (Trim(sLookFor) = Trim(sField_Name)) Begin // Find A Match And Replace The Field Name With The Offset expression Move (Replaces(sField_Name,sExpStr,sOffSet#)) To sExpStr Function_Return sExpStr End Loop Function_Return sExpStr End_Function End_Object // oName_array //AB-StoreTopEnd //AB-IgnoreStart Use dfdbmdpn.pkg Use Windows.pkg Use dfEntry.pkg Use DfLine.Pkg //AB-IgnoreEnd Object oReplace_View is a dbModalPanel //AB-StoreTopStart //---------------------------------------------------> // There are no data aware controls in the application, // but the dbView class is used so we can subvert the // request_clear methods to clear our entry fields. //---------------------------------------------------> // Set Caption_Bar To False // Set View_Mode To Viewmode_Zoom // Set SysMenu_Icon To False Procedure Request_Clear Send Clear_Fields End_Procedure Procedure Request_Clear_All Send Clear_Fields End_Procedure On_Key Key_Alt+Key_R Send Process On_Key Key_Alt+Key_L Send Deletions On_Key Key_Alt+Key_I Send Indexes On_Key Key_Alt+Key_X Send Exit_Application Property String psNeed_Fld# Public "" Property String psJumpIn_Data Public "" Property String psJumpOut_Data Public "" Property String psIndex_Segment Public "" Property String psSelection Public "" Property String psReplace Public "" Property Integer piCurrent_Field_Obj Public 0 Property Integer piIndex# Public 0 Property Integer piReplField# Public 0 Property String psOrigLabel Public "" Property String psFileName Public "" Property String psFieldName Public "" Property Integer piFieldNumber Public 0 Property String psHelpPath Public "" Procedure Process Integer iDoIt Get Check_File# To iDoIt If iDoIt Send Record_Update End_Procedure Procedure Deletions Integer iDoIt Get Check_File# To iDoIt If iDoIt Send Record_Deletion End_Procedure Procedure Indexes Integer iDoIt Get Check_File# To iDoIt If iDoIt Send Popup To (oIndexEntry(Current_Object)) End_Procedure Procedure Clear_Fields Set Value Of oFile_Name To "" Set Value Of oFile_Numb To "" Set Value Of oSelection To "" Set Value Of oSel_Field_Name To "" Set Value Of oSel_Field_Numb To "" Set Value Of Replace_Data To "" Move 0 To FileNumber Set psFileName To "" Set psNeed_Fld# To "" Set piCurrent_Field_Obj To 0 Set piIndex# To 0 Set psJumpIn_Data To "" Set psJumpOut_Data To "" Set psIndex_Segment To "" Set psSelection To "" Set psReplace To "" End_Procedure //=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Pick Lists =-=-=-=-=-=-=-=-=-=-=-=-=-=-= Use GlbFileList.dg // File Name Pick List Use GlbFieldList.dg // Field Name Pick List //=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Processing =-=-=-=-=-=-=-=-=-=-=-=-=-=-= Procedure Setup_fields String Lname gdsDfpath If (psFileName(Self) = "") Begin Send Stop_box "Please select a file from the selection list -- F4." "Field Error" Procedure_Return 1 End Move FileNumber To Filenumber Open FileNumber Send Load_array To (oName_array(Current_object)) (psFileName(Self)) End_Procedure //=-=-=-=-=-=-=-=-=-=-=-=-= Record Updating =-=-=-=-=-=-=-=-=-=-=-=-=-=-= Procedure Record_Update String sAnswer sSegment sJumpin_Data sJumpOut_Data sField String sTemp sMsg sEval_Str sSelection sReplace Integer iCounter iItem_Count iIndex# iHoldFI iStatPnl Integer iUserCancel iFile# iField# iGetOut iReplField# Get psSelection To sSelection Get psReplace To sReplace Move FileNumber To iFile# Get piFieldNumber To iField# // Replacement field If (iField# = 0 Or iFile# = 0) Begin Send Stop_Box "ERROR! No file or field selected for update." Procedure_Return End //-------------------------------------------------> // Get The File.Field Name //- "Replace with" data //-------------------------------------------------> Get Process_expr Of (oName_array(Current_object)) (Trim(sReplace)) To sReplace Get Process_expr Of (oName_array(Current_object)) (Trim(sSelection)) To sSelection Get Item_count Of (oName_array(Current_object)) To iItem_count //-------------------------------------------------> //- Get choices from the screen //-------------------------------------------------> Get piIndex# To iIndex# Get psIndex_Segment To sSegment Get psJumpin_Data To sJumpin_Data // "Jump In" Data Get psJumpout_Data To sJumpout_Data // "Jump Out" Data Get piReplField# To iReplField# //-------------------------------------------------> // We Have Index #, // We Have Data To Jump In, // We Have The Fieldindex Of The First Field In The Index. //-------------------------------------------------> Trim (psFileName(Self)) To sTemp Append sTemp "." sSegment Clear Indirect_File If (iIndex# > 0) Begin //-------------------------------------------------> //-------------------------------------------------> Move iReplField# To FieldIndex //-------------------------------------------------> // If Other Than Recnum, Move "Jump-In" Data To Field //-------------------------------------------------> If (Fieldindex > 0) Move sJumpin_Data To Indirect_file.Recnum End Else Move 0 To Fieldindex Vfind iFile# iIndex# Ge If Not (Found) Begin Send Info_Box "No records found for update." Procedure_Return End Move (Status_Panel(Current_Object)) To iStatPnl Send Initialize_StatusPanel To iStatPnl "Processing" "Updating Records" "" Send Start_StatusPanel To iStatPnl While (Found And Not(iUserCancel)) Move FieldIndex To iHoldFI Move 0 To Fieldindex Send Update_StatusPanel To iStatPnl (String(Indirect_File.Recnum)+" - "+String(iCounter)) Get Check_StatusPanel Of iStatPnl To iUserCancel //-------------------------------------------------> // Evaluate the data selection field, 0=false //-------------------------------------------------> If (Eval(sSelection) Ne False) Begin Move iField# To Fieldindex Reread Move (Eval(sReplace)) To Indirect_file.Recnum Saverecord Indirect_file.Recnum Unlock Increment iCounter End Move iHoldFI To FieldIndex Vfind iFile# Index# Gt //-------------------------------------------------> // If the "jumpout" data is present, get out //-------------------------------------------------> If (sJumpOut_Data <> "" And iIndex# > 0) Begin If (Found And Indirect_file.Recnum <> sJumpOut_Data) Indicate Found False End End // While Loop Send Stop_StatusPanel To iStatPnl Send Info_Box ("All done, "+String(iCounter)+" replacements.") End_Procedure //=-=-=-=-=-=-=-=-=-=-=-=-=-= Record Deletion =-=-=-=-=-=-=-=-=-=-=-=-=-= //-------------------------------------------------> // Deletions always use recnum index //-------------------------------------------------> Procedure Record_Deletion String lTemp lMsg lEval_Str sSelection sReplace Integer iCounter lItem_Count lIndex# lHoldFI iLast_Rec iStatPnl iUserCancel iFile# Get psSelection To sSelection Get psReplace To sReplace Move FileNumber To iFile# Get Process_expr Of (oName_array(CURRENT_OBJECT)) sSelection To sSelection If ((iFile# = 0) Or (Length(sSelection) = "")) Begin Send Stop_Box "ERROR! No file or selection entered for deletion." Procedure_Return End Clear Indirect_File Vfind iFile# 0 Gt If Not (Found) Begin Send Info_Box "No records found for deletion." Procedure_Return End Move (Status_Panel(Current_Object)) To iStatPnl Send Initialize_StatusPanel To iStatPnl "Processing" "Deleting Records" "" Send Start_StatusPanel To iStatPnl While (Found And Not(iUserCancel)) Send Update_StatusPanel To iStatPnl (String(Indirect_File.Recnum)+" - "+String(iCounter)) Get Check_StatusPanel Of iStatPnl To iUserCancel Move Indirect_file.Recnum To iLast_rec If (Eval(sSelection) Ne False) Begin Increment iCounter Lock Delete Indirect_file Clear Indirect_file Move iLast_Rec To Indirect_file.Recnum Unlock End Vfind iFile# 0 Gt End //End While Loop Send Stop_StatusPanel To iStatPnl Send Info_Box ("All done, "+String(iCounter)+" deletions.") End_Procedure //=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Data Entry =-=-=-=-=-=-=-=-=-=-=-=-=-=-= //AB-StoreTopEnd Set Label to "Global Data Replacement Utility" Set Location to 2 2 Set Size to 202 475 //AB-DDOStart //AB-DDOEnd Object oFile_Name is a Form Set Label to "File Name:" Set Size to 13 117 Set Location to 10 66 Set Label_Col_Offset to 40 //AB-StoreStart Set Capslock_State To True Set Prompt_Button_Mode To pb_PromptOn Set Form_Button_Bitmap 0 To 'Prompt.Bmp' Procedure Prompt Set psJumpin_Data To "" Set piIndex# To 0 Send Popup To oFileLookup Forward Send Prompt Set Value To (psFileName(Self)) End_Procedure Procedure Exiting Integer iToObj Integer hFile iFile# String sName sFileName Get Value Item 0 To sFileName Set psFileName To sFileName //-----------------------------------------------------> //- Selection list populates Filenumber & liFile#, //- if 0 need to get it //-----------------------------------------------------> If (sFileName <> "") Begin Repeat //-----------------------------------------------------> // Spin through the filelist to find the file number // from the file root name //-----------------------------------------------------> Get_Attribute DF_FILE_NEXT_USED Of hFile To hFile If (hFile > 0) Begin Get_Attribute DF_FILE_LOGICAL_NAME Of hFile To sName // 7/30/02 To accomodate foreign files If (Uppercase(sName) Contains Uppercase(sFileName)) Move hFile To iFile# End If (iFile# > 0) Break Until (hFile=0) End If (iFile# > 0) Send Entry_Display To oFile_Numb 0 1 Else Begin If (iToObj <> Exit_Button(Self) And iToObj <> oHelp_Btn(Self)) Begin Send Stop_Box "The file name is not valid, please enter one or use the list." Procedure_Return 1 End End //-----------------------------------------------------> // Use FileNumber as a global variable to carry the file // number around //-----------------------------------------------------> Move iFile# To FileNumber Set Value Of (oFile_Numb(Current_Object)) Item 0 To FileNumber If sFileName Ne "" Send Setup_Fields Forward Send Exiting iToObj End_Procedure //AB-StoreEnd End_Object // oFile_Name Object oFile_Numb is a dbForm Set Label to "File Number:" Set Size to 13 48 Set Location to 10 305 Set Label_Col_Offset to 45 //AB-StoreStart Set Enabled_State To False //AB-StoreEnd End_Object // oFile_Numb Object oSelection is a Form Set Label to "Selection:" Set Size to 13 391 Set Location to 49 67 Set Label_Col_Offset to 38 //AB-StoreStart Set Prompt_Button_Mode To pb_PromptOn Set Form_Button_Bitmap 0 To 'Prompt.Bmp' Procedure Prompt Send Popup To oFieldLookup Forward Send Prompt End_Procedure Procedure Entering Set piCurrent_Field_Obj To Current_Object Set psNeed_Fld# To "" Forward Send Entering End_Procedure Procedure Exiting Integer iToObj String sSelection Get Value Item 0 To sSelection Set psSelection To sSelection Forward Send Exiting iToObj End_Procedure //AB-StoreEnd End_Object // oSelection Object oSel_Field_Name is a dbForm Set Label to "Field To Replace:" Set Size to 13 150 Set Location to 88 67 //AB-StoreStart Set Capslock_State To True Set Prompt_Button_Mode To pb_PromptOn Set Form_Button_Bitmap 0 To 'Prompt.Bmp' Procedure Prompt Set piFieldNumber To 0 Send Popup To oFieldLookup Forward Send Prompt End_Procedure Procedure Entering Set psNeed_Fld# To "Y" Set piCurrent_Field_Obj To Current_Object Forward Send Entering End_Procedure Procedure Exiting Integer iToObj Integer iField# iFileNum String sFieldName Get Value To sFieldName If (sFieldName Contains ".") Begin Send Stop_Box "ERROR! It appears that the field name contains the file name as well, please remove." Procedure_Return 1 End Get Value Of oSel_Field_Numb To iField# If (sFieldName > "") Begin Field_Map FileNumber (Trim(sFieldName)) To iField# Set piFieldNumber To iField# If (iField# > 0); Set value Of oSel_Field_Numb To iField# End Forward Send Exiting iToObj End_Procedure //AB-StoreEnd End_Object // oSel_Field_Name Object oSel_Field_Numb is a dbForm Set Label to "Field Number:" Set Size to 13 48 Set Location to 88 305 Set Label_Col_Offset to 50 //AB-StoreStart Set Enabled_State To False //AB-StoreEnd End_Object // oSel_Field_Numb Object Replace_Data is a dbForm Set Label to "Replace With:" Set Size to 13 393 Set Location to 127 66 Set Label_Col_Offset to 50 //AB-StoreStart Set Prompt_Button_Mode To pb_PromptOn Set Form_Button_Bitmap 0 To 'Prompt.Bmp' Procedure Prompt Send Popup To oFieldLookup Forward Send Prompt End_Procedure Procedure Entering Set psNeed_Fld# To "" Set piCurrent_Field_Obj To Current_Object Forward Send Entering End_Procedure Procedure Exiting Integer iToObj String sReplace Get Value Item 0 To sReplace Set psReplace To sReplace Forward Send Exiting iToObj End_Procedure //AB-StoreEnd End_Object // Replace_Data Object oHelp_Btn is a Button Set Label to "Help" Set Location to 167 17 //AB-StoreStart Procedure OnClick // Send Popup to oHelp_Dlg Send DoHelp End_Procedure // OnClick //AB-StoreEnd End_Object // oHelp_Btn Object Replace_Button is a Button Set Label to "&Replace" Set Location to 167 235 //AB-StoreStart Procedure OnClick Integer iDoIt Get Check_File# To iDoIt If iDoIt Send Record_Update End_Procedure //AB-StoreEnd End_Object // Replace_Button Object Delete_Button is a Button Set Label to "De&Lete" Set Location to 167 294 //AB-StoreStart Procedure OnClick Integer iDoIt iRC Get Check_File# To iDoIt Get Yesno_Box "Are you sure you want to delete this data?" To iRC If (iRC = 6 And iDoIt) Send Record_Deletion End_Procedure //AB-StoreEnd End_Object // Delete_Button Object Index_Button is a Button Set Label to "&Indexes" Set Location to 167 353 //AB-StoreStart Procedure OnClick Integer iDoIt Get Check_File# To iDoIt If iDoIt Send Popup To (oIndexEntry(Current_Object)) End_Procedure //AB-StoreEnd End_Object // Index_Button Object Exit_Button is a Button Set Label to "E&Xit" Set Location to 167 413 //AB-StoreStart Procedure OnClick // Send Exit_Application To Desktop Send Request_Cancel End_Procedure //AB-StoreEnd End_Object // Exit_Button Object LineControl1 is a LineControl Set Size to 2 463 Set Location to 33 4 End_Object // LineControl1 Object oReturnText is a Textbox Set Label to "For all fields below, enclose string and date data in quotes, but not numbers." Set Location to 36 124 Set Size to 10 250 Set TypeFace to "MS Sans Serif" End_Object // oReturnText Object LineControl2 is a LineControl Set Size to 2 463 Set Location to 74 4 End_Object // LineControl2 Object LineControl3 is a LineControl Set Size to 2 51 Set Location to -25207 -21846 End_Object // LineControl3 Object LineControl4 is a LineControl Set Size to 2 461 Set Location to 113 5 End_Object // LineControl4 Object LineControl5 is a LineControl Set Size to 2 463 Set Location to 152 4 End_Object // LineControl5 //AB-StoreStart //AB-StoreEnd End_Object // oReplace_View //AB-StoreStart //AB-StoreEnd //AB/ End_Object // prj