The project I am working on (eSum) has numerous xbasic based batch processes that can be launched from forms. The forms contain the data that the xbasic is processing if there are problems with any of the data an error field in the same table is filled out with error description. At the end of process all records with errors are queried up for the end user to review.
The following function and script assist in this process. The function will take a space separated list of record numbers and does a query on them or marks them depending if the function is launched from a form or not. It also saves a copy of this Query list so that script can be called from the form to recreate the Query.
If a error is encountered during the xBasic processing the script need only write a text description to field within the offending record and add the record number to a string that is then passed to this function. The code for building the record list is simply;
ErrList = ErrList + TrimNum(Tbl.recno()) + " " 'Add record to error list
You will see reference to a function PrgrssBar this function puts up a modeless dialog box with a progress bar but is not included here you will need to supply your own.
Function to Query Up or Mark offending records
Script to recall previous Queries
The following function and script assist in this process. The function will take a space separated list of record numbers and does a query on them or marks them depending if the function is launched from a form or not. It also saves a copy of this Query list so that script can be called from the form to recreate the Query.
If a error is encountered during the xBasic processing the script need only write a text description to field within the offending record and add the record number to a string that is then passed to this function. The code for building the record list is simply;
ErrList = ErrList + TrimNum(Tbl.recno()) + " " 'Add record to error list
You will see reference to a function PrgrssBar this function puts up a modeless dialog box with a progress bar but is not included here you will need to supply your own.
Function to Query Up or Mark offending records
Code:
'Date Created: 22-Aug-2013 11:30:03 PM 'Last Updated: 14-Feb-2014 11:47:35 AM 'Created By : Paul Verboom 'Updated By : Paul Verboom FUNCTION zQryFromList AS C (DialogTtl AS C, tbl AS P, byrev QueryList AS C, RunFromFB AS L, QueryOrder AS C, CallFuncName AS C, Recall AS L) '------------ 'zQryFromList '------------ 'This function builds a query that will contain all the records 'in a list, passed to the function 'If the list is less then 500 characters long then the 'A5 function is_recno_in() is used otherwise 'records are marked and Query is built from marked records 'If function is not called from a form records are marked regardless 'This function was written to composate for errors generated by 'is_recno_in() function when list was too long 'It appears that the strings passed to the Query function must be under 500-1000 characters ' 'DialogTtl - The title used in the progress bar 'Tbl - pointer to the table we are working on 'QueryList - space seperated record numbers 'RunFromFB - True if run from a Form or Browse must do a query otherwise must mark records 'QueryOrder - The order to use when doing Queries 'CallFuncName - The name of the calling function if null DialogTtl is used ' is different when only when recalling previous queries 'Recall - T if this is a recall of a Query, prevents Query from being added to recall list again 'Function returns message indicating what was done 'Function also records the details of the last 10 Queries generated this way to variables 'these variables are not retained between sessions. 'The companion Script zQyPrvList allows one of these saved Queries to be reinstated. '------------------------------------------------ '---- Set up Error handler for this function ---- '------------------------------------------------ errspot = "" ON ERROR GOTO ERRORHANDLER '-------------------------------------------- '// Save the Query so it can be recalled ---- '-------------------------------------------- 'Standard variable can be dimmed a second time but arrays can not so test for existance is required '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '!! DO NOT PLACE comments within variable TYPE declaration. Will cause syntax errors in !!! '!! runtime enviroment, and cause unknown function error as function will not be loaded !!! '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IF .NOT. is_object(PrvList) THEN 'Does storage array already exist PrvListPtr = 1 'if not define it now TYPE ListMemory TableName as C QueryOrder as C QueryList as C Name as C Time as C END TYPE DIM Global PrvList[1] as {ListMemory} else END IF IF .NOT. Recall THEN 'Not a recall so save Query conditions PrvList.insert(1,1) 'push the values into array PrvList[1].TableName = FILE.FILENAME_PARSE(tbl.filename_get(),"n") IF isnull(CallFuncName) PrvList[1].Name = DialogTtl else PrvList[1].Name = CallFuncName end if PrvList[1].Time = left(time(),5) PrvList[1].QueryOrder = QueryOrder '! array size is not limited but is not PrvList[1].QueryList = QueryList '! not saved between runs should be Ok END IF '------------------------------------------ '// We have Query list now get to that ---- '------------------------------------------ IF Len(QueryList) > 500 THEN ToLong = .T. ELSE ToLong = .F. QueryList = " " + QueryList + " " END IF 'Are we going to need to mark records if so unmark them all now '!this approach causes full index rebuild with significant delays '!will unmark records in marking loop instead '!IF .NOT. RunFromFB .OR. ToLong THEN '! tbl.index_primary_put("_Marked") '! tbl.unmark_range() '! tbl.index_primary_put() '!END IF 'If record list is not too long then we can do direct Query IF .NOT. ToLong THEN query.filter = "is_recno_in(QueryList)" query.order = QueryOrder query.options = "" indx = tbl.query_create() RecQty = indx.records_get() 'Record list was too long so we must loop through all records ELSE '! would be quicker to lookup up each record in list '! and mark it but this gives no oppertunity to unmark records tbl.index_primary_put() RecQty = tbl.records_get() 'number of records '!Batch mode causes full index rebuild with significant delays '!However exception errors occur when it is not used on large files tbl.batch_begin() tbl.fetch_first() 'Get the Installation Code 'How many records to count DIM MarkTtl as N DIM MarkCnt as N = 0 MarkTtl = occurs(space(1),QueryList) 'Intialize progress bar RecCur = 1 UpdCnt = 1 UpdFlg = int(RecQty/100) PrgrssBar("I","Marking " + MarkTtl + " records",1) PrgrssBar("T",DialogTtl,1) 'Check each record in the USER Correction data WHILE .not. tbl.fetch_eof() 'Update progress bar but not evey loop or we spend ' all our time updating progress bar UpdCnt = UpdCnt + 1 IF UpdCnt > UpdFlg THEN 'debug(1) PrgrssBar("F","",RecCur/RecQty) UpdCnt = 1 END IF RecCur = RecCur + 1 'Is this record in the list RecWord = " " + TrimNum(tbl.recno()) + " " IF AT(RecWord,QueryList) THEN 'This record was found in list so lets mark it errspot = "chngrec" commit_flag = .T. tbl.change_begin(.F.) tbl.mark() tbl.change_end(commit_flag) errspot = "" IF .NOT. commit_flag THEN 'can only be FALSE IF error changing record error_generate("Unable to Mark record " + MarkCnt + " of " + MarkTtl \ + crlf() + Commit_error) END IF MarkCnt = MarkCnt + 1 else if tbl.is_marked() then 'record should not be marked so unmark it errspot = "chngrec" commit_flag = .T. tbl.change_begin(.F.) tbl.unmark() tbl.change_end(commit_flag) errspot = "" IF .NOT. commit_flag THEN 'can only be FALSE IF error changing record error_generate("Unable to UnMark record") END IF END IF tbl.fetch_next() END WHILE PrgrssBar("C","",0) '!batch not used causes full index's rebuilds with significant delays. tbl.batch_end() END IF 'If we ran from a form or browse and we marked records then we now need to do a query IF RunFromFB .AND. ToLong THEN query.filter = "marked()" query.order = QueryOrder query.options = "" indx = tbl.query_create() RecQty = indx.records_get() END IF 'If not run from a form or browse and direct Query was done then we need to mark the Queried records IF (.NOT. RunFromFB) .AND. (.NOT. ToLong) THEN tbl.mark_range() END IF DIM Mess as C IF .NOT. RunFromFB THEN Mess = "Records have been marked" ELSE IF ToLong THEN Mess = "Records have been Marked and Queried" ELSE Mess = "Records have been queried" END IF zQryFromList = Mess end function '------------------------ '---- ERROR Handler ----- '------------------------ 'actual error reporting could be elborated to be a central function with log generation etc. ERRORHANDLER: 'Record Entry or Change operation must be completed to prevent 'leaving table in change or entry mode. Set flags and return. IF errspot = "chngrec" Commit_error = error_text_get() + " Line: " + TrimNum(error_line_number_get()) Commit_flag = .F. resume next End if ON ERROR GOTO 0 'if run from form refresh the browse so error record is displayed IF RunFromFB THEN parentform.refresh_layout() END IF ui_msg_box("ERROR "+DialogTtl,error_text_get()+crlf()+"Error Line: "+TrimNum(error_line_number_get())) PrgrssBar("C","",0) END
Code:
'Date Created: 31-Oct-2013 08:37:43 AM 'Last Updated: 03-Apr-2014 12:42:25 PM 'Created By : Paul Verboom 'Updated By : Paul Verboom '----------- 'zQryPrvList '----------- 'Title for all Dialogs generated by this script DIM DialogTtl AS C = "Recall Previous eSum Generated Query (zQryPrvList)" DIM RunFromFB as L DIM Tbl as P 'Was script run from a form if so get the base table name IF is_object(topparent.this) THEN IF topparent.Class() = "form" .or. topparent.class() = "browse" THEN tbl = topparent.Table_Get() RunFromFB = .T. ELSE RunFromFB = .F. END IF ELSE RunFromFB = .F. END IF IF .NOT. is_object(PrvList) THEN 'If storage array does not exist nothing to recall MsgBox(DialogTtl,"No Previous eSum Generated Queries to Recall for this screen (1).",UI_ATTENTION_SYMBOL+UI_OK) end end if 'Run from form or browse so recall Query from those for this table IF RunFromFB 'Build contents of the list Table = FILE.FILENAME_PARSE(tbl.filename_get(),"n") 'determine how many recall entries exist CntRecalls = 0 ' for this entry FOR x = 1 TO PrvList.size(1) IF PrvList[x].TableName = Table THEN CntRecalls = CntRecalls + 1 END IF next IF CntRecalls = 0 THEN 'IF no entries exist advise user of same MsgBox(DialogTtl,"No Previous eSum Generated Queries to Recall for this screen (2).",UI_ATTENTION_SYMBOL+UI_OK) end END IF DIM SHARED QuerySelect as C 'selection returned in this variable DELETE a_QueryList 'build a Previous Query list to select from DIM a_QueryList[CntRecalls] as C 'stores the recalls available for current table Delete a_OrgNum 'stores orginal previous array element number DIM a_OrgNUm[CntRecalls] as C DIM NxtPrv as N=1 FOR x = 1 to PrvList.size(1) 'go through all previous entries and build IF PrvList[x].TableName = Table THEN 'lookup array a_QueryList[NxtPrv] = TrimNum(NxtPrv) + " " + PrvList[x].Time + " " + PrvList[x].Name a_OrgNum[NxtPrv] = x NxtPrv = NxtPrv + 1 END IF NEXT 'Now put up dialog box Text = <<%txt% Various scripts that are run from forms in eSum will present a list of records failed or processed at thier completion. The list are retained during the current session and can be retrieved with this script. These are list of record numbers. The Query or search that generated the list is not rerun when this option is selected. When records are deleted in eSum the record is marked for deletion and not removed till the table is packed. This function references records by thier physical record number. Therefore deleted records will remain visable within Queries recalled by this script. Only Queries generated from the Current form or browse are listed. Select the eSum generated Query that you want to recall. %txt% Dialog = <<%dlg% {region} {text=65,15:text}; {endregion}; {line=1,0}; {region}; Select:| [.55,5QuerySelect^#a_QueryList]; {endregion}; {line=1,0}; {region} <*15&Proceed!Proceed> <15&Cancel!CANCEL> {endregion}; %dlg% While .T. Result = ui_dlg_box(DialogTtl,Dialog) 'Put up the dialog box IF Result <>"Proceed" THEN end END IF NxtPrv = VAL(LEFT(QuerySelect,2)) 'get the index value and verify it IF NxtPrv > 0 exit while end if MsgBox(DialogTtl,"You must select a entry",UI_OK) wend 'Process users selection QueryList = PrvList[a_OrgNum[NxtPrv]].QueryList 'get previous list values QueryOrder = PrvList[a_OrgNum[NxtPrv]].QueryOrder CallFuncName = PrvList[a_OrgNum[NxtPrv]].Name 'now run the query zQryFromList(DialogTtl, Tbl, QueryList, RunFromFB, QueryOrder, CallFuncName,.T.) parentform.refresh_layout() ELSE MsgBox(DialogTtl,"Can only be run from a form",UI_OK) END IF