#ifndef TRUE #define TRUE .T. #define FALSE .F. #endif *--------------------------------------------------------------------------- ** Test it ** use MyTable in 0 ** make a cursor with the same layout as MyTable, eg copy MyTable to a cursor ** delete a few records from the cursor ** modify a few record from the cursor ** add a few records to the cursor && ?UpdateTable('MyTable', 'MyCursor', 'Field1+Field2', 'OrderTag') ** use the _Filter when you only want to update part of the table ** the cursor then only holds part of the table ** eg ** use MyTable in 0 ** select * ; from Mytable where country = 'USA' ; into cursor MyCursor ** select MyCursor ** delete a few records from the cursor ** modify a few record from the cursor (leave country USA) ** add a few records to the cursor ( with country USA) && ?UpdateTable('MyTable', 'MyCursor', 'Field1+Field2', 'OrderTag', [(country = 'USA')]) ** NOTE: TableKeyTag must be either Primary or Candidate *--------------------------------------------------------------------------- procedure UpdateTable(TableAlias, NewContents, TableKeyExpr, TableKeyTag, _Filter , WithArray) local s, Table_recno, Table_Buffering, _key, n, t, NewContents_recno local obj_new, obj_table, Success, TableArray[1] local sTalk, sDeleted, sError s = select(0) Table_recno = recno(TableAlias) Table_Buffering = CursorGetProp('Buffering', TableAlias) if( Table_Buffering <> DB_BUFOPTRECORD ) =CursorSetProp('Buffering', DB_BUFOPTRECORD, TableAlias) endif NewContents_recno = recno(NewContents) sTalk = set('Talk') set Talk Off sDeleted = Set('Deleted') Set Deleted On sError = on('Error') select (TableAlias) if( empty(_Filter) ) _Filter = '.T.' endif local ToDelete, ToDelete_ ToDelete = NewCursorName() ToDelete_ = NewCursorName() select recno() as RecToDelete ; from (TableAlias) ; into cursor (ToDelete_) ; where &_Filter select (ToDelete_) =CreateCursorCopy(ToDelete) use in (ToDelete_) select (ToDelete) index on bintoc(RecToDelete) tag ToDelete Success = TRUE private HadError HadError = FALSE on Error HadError = TRUE *on error suspend Begin Transaction select (NewContents) && t = therm(Reccount(), 'Obsolete in ' + TableAlias ) n = 0 scan all while Success and !HadError n = n + 1 && =iif( empty(mod(n,20)), t.Update(n), TRUE ) _key = eval(TableKeyExpr) if( seek(_key, TableAlias, TableKeyTag) ) if( seek( bintoc(recno(TableAlias)), ToDelete ) ) delete in (ToDelete) else assert FALSE endif endif endscan Success = Success and !HadError t = Null if( Success ) select (ToDelete) && t = therm(RecordCount(), ' Deleting ...' ) n = 0 if( !IsRunTime() ) on error endif scan all while Success and !HadError n = n + 1 && =t.Update(n) select (TableAlias) go (&ToDelete..RecToDelete) if( (IsRLocked() and !Deleted()) or !RLock() ) assert FALSE Success = FALSE else delete if( !TableUpdate() ) Success = FALSE assert FALSE endif unlock record (recno()) endif select (ToDelete) assert !HadError endscan t = Null endif Success = Success and !HadError select (NewContents) && t = therm(Reccount(), 'Updating ' + TableAlias + ' with ' + NewContents ) n = 0 scan all while Success and !HadError n = n + 1 && =iif( empty(mod(n,20)), t.Update(n), TRUE ) _key = eval(TableKeyExpr) scatter memo name obj_new if( seek(_key, TableAlias, TableKeyTag) ) select (TableAlias) scatter memo name obj_Table if( !compobj(obj_New, obj_Table) ) if( WithArray ) select (NewContents) scatter memo to TableArray select (TableAlias) gather from TableArray memo else gather name obj_new memo endif if( !TableUpdate() ) assert FALSE Success = FALSE endif endif else if( WithArray ) scatter memo to TableArray endif select (TableAlias) append blank if( WithArray ) gather from TableArray memo else gather name obj_new memo endif if( !TableUpdate() ) assert FALSE Success = FALSE endif endif select (NewContents) endscan Success = Success and !HadError t = Null if( Success ) end Transaction else rollback endif on Error &sError use in (ToDelete) =RestoreRecordNumber(NewContents_recno, NewContents) =RestoreRecordNumber(Table_recno, TableAlias) if( Table_Buffering <> DB_BUFOPTRECORD ) =CursorSetProp('Buffering', Table_Buffering, TableAlias) endif set Deleted &sDeleted set Talk &sTalk select (s) return Success endproc *------------------------------------------------------------------------- procedure CreateCursorCopy(Cursor, _Filter) =CreateCursor(Cursor) =CopyAlias(alias(), Cursor, _Filter) && from alias() endproc *-------------------------------------------------------------------------- procedure CreateCursor(Cursor) local x[1], i, j, s =afields(x) * Eleminate Field Validation Rules, triggers, and the like for i = 1 to alen(x,1) for j = 6 to alen(x,2) x[i,j] = '' endfor endfor s = select(0) if( used(Cursor) ) use in (Cursor) endif select 0 create cursor (Cursor) from array x select (s) endproc *-------------------------------------------------------------------------- procedure CopyAlias(AliasFrom, AliasTo, _Filter) if( empty(_Filter) ) _Filter = '' else _Filter = 'And ' + _Filter endif local s, sTalk sTalk = set('Talk') set Talk Off s = select(0) select (AliasTo) append from dbf(AliasFrom) for !deleted() &_Filter select (s) set Talk &sTalk endproc *-------------------------------------------------------------------------- function NewCursorName() return sys(2015) endfunc *--------------------------------------------------------------------------- procedure RestoreRecordNumber(r, alias_) if( empty(alias_) ) alias_ = alias() endif local sTalk sTalk = set('Talk') set Talk Off if( r <= reccount(alias_) ) go r in (alias_) else && eof condi go bottom in (alias_) if( !eof(alias_) ) skip in (alias_) endif endif set Talk &sTalk endproc *--------------------------------------------------------------------------- function IsRunTime() return empty(Version(2)) endfunc *---------------------------------------------------------------------------