Implementing FoxPro's Scatter and Gather Memvar in Delphi

Implementing FoxPro's Scatter and Gather Memvar in Delphi.

Delphi Developer February 2001
Copyright Pinnacle Publishing, Inc. All rights reserved.



Implementing FoxPro's Scatter and Gather Memvar in Delphi


Steve Zimmelman



Technology is always moving forward, usually leading to more productive development. However, there are times when reaching into the past can be helpful, too. Replicating or comparing table data in FoxPro was a fairly simple task. Steve Zimmelman argues that perhaps this technology is worth reaching back.





FoxPro's Scatter and Gather commands were always useful for copying records from one table to another, comparing data, or record replication among multiple tables. For those of you who haven't had the pleasure of working with FoxPro, the Scatter and Gather commands work like this.



Suppose you need to copy a record from one table to another. You'd do something like:



Select Table1

Scatter Memvar

Select Table2

Gather Memvar




The Scatter command reads all of the fields for the current

record and places them into memory variables. Each variable that's

created with Scatter has the same name as the field from which it

originated. The Gather command updates the current record with memory variables that have names that correspond to the fields. So if Table1 has the fields Name, Address, and Phone, and the variables Name, Address, and Phone exist, then when the Gather command is executed it updates the record with the value stored in those variables.



There are many ways to accomplish this with Delphi, but there's nothing natively supplied in the VCL that works at the TDataSet level. In my latest application endeavor, I had a need for the old Scatter and Gather functionality. So, I ended up writing my own ScatterMemvar and GatherMemvar methods.





Creating the Scatter and Gather functions


Both of these methods are wrappers for an object called TMemvar. TMemvar maintains a dynamic array of a record called TMemVarFields. Each element of the MemVarFields array contains the FieldName, DataType, and Value of a corresponding field in a DataSet. So each instance of TMemvar contains the data from a single table record.





   Type

      MemVarField = Packed Record

      FieldName : String;

      Value : Variant ;

      DataType : TFieldType;

   End;



   TMemVarFields = Array Of TMemVarField ;




When the ScatterMemvar function is invoked, it creates an instance of TMemvar and returns a pointer to that instance. When TMemvar is created, it loads the fields from the designated DataSet into the array. To avoid DataSet duplication, each instance of TMemvar is identified by its DataSet property. Before a new instance of TMemvar is created, a search is performed for a matching DataSet in all existing instances of TMemvar. If one is found, the matching instance is reused. If not, a new instance is created.



Function ScatterMemvar(DataSet:TDataSet) : TMemVar ;

Begin

   If (DataSet = Nil) Then

      Raise Exception.Create('DataSet Cannot Be NIL');

      // Reuse the object if it already exists.

      Result := FindMemvarObject(DataSet);

      If (Result = Nil) Then Begin

         Result := TMemvar.Create(DataSet) ;

      End Else Begin

         Result.LoadFieldData ;

      End;

   End;



Constructor TMemVar.Create(DataSet:TDataSet) ;

Begin

   FFlds := Nil ;

   FDataSet := DataSet ;

   If (FDataSet = Nil) Then Begin

      Raise Exception.Create('DataSet Cannot Be NIL');

   End;

   If (FScatterList = Nil) Then

      FScatterList := TList.Create ;

   FScatterList.Add(Self);

   LoadFieldData ;

End;



Procedure TMemVar.LoadFieldData ;

Var

   i : Integer ;

Begin

   If Not DataSet.Active Then DataSet.Open ;

   FFlds := Nil ;

   // set the length for the record array.

   SetLength(FFlds,FieldCount);

   For i := 0 To (DataSet.FieldCount-1) Do Begin

      With DataSet.Fields[I] Do Begin

         FFlds[i].FieldName := FieldName ;

         FFlds[i].Value := Value;

         FFlds[i].DataType := DataType ;

      End;

   End;

End;




Normally when you create an object, it's necessary to free the object when it's no longer needed. But the unit that contains the code for this object maintains its own internal list of TMemvar instances and destroys them automatically when the application closes. So you can free the objects when they aren't needed, or ignore them and let the unit take care of itself.



To manage the TMemvar objects that are created for each ScatterMemvar usage, I add each new instance of TMemvar to FScatterList, a type of TList. The unit that handles all of this code contains Initialization and Finalization sections. The Initialization makes sure FScatterList is set to Nil. This is done so that the Create method of TMemvar can interrogate the value of FScatterList and create an instance of it only when necessary. This keeps the resources that the unit requires down to a minimum. The Finalization

section spins through the list and frees any TMemvar objects it references.



Procedure FreeScatterList ;

Var i : Integer ;

Begin

   If (FScatterList = Nil) Then Exit ;

   Try

      For i:=(FScatterList.Count-1) DownTo 0 Do Begin

         Try

            TMemVar(FScatterList.Items[i]).Free ;

         Except

         End;

      End;



   Finally

      FScatterList.Free ;

      FScatterList := Nil ;

   End;

End;



Initialization

   FScatterList := Nil ;

Finalization

   FreeScatterList ;




To avoid potential access exceptions, TMemvar removes itself from the FScatterList when it's freed. You'll also notice that if all items have been deleted from FScatterList, the list is freed. Again, this is done to keep resource usage down.



Destructor TMemVar.Destroy ;

   Var i : Integer ;

Begin

   // Clear the array elements.

   FFlds := Nil ;

   For i := 0 To (FScatterList.Count-1) Do Begin

      Try

         If (TMemvar(FScatterList.Items[i]).DataSet = FDataSet) Then Begin

            FScatterList.Delete(i);

         End;

      Except

      End;

   End;

   If (FScatterList.Count = 0) Then Begin

      FScatterList.Free ;

      FScatterList := Nil ;

   End;

   Inherited ;

End;




After ScatterMemvar has been used to place a DataSet in memory, that specific TMemvar object can be accessed from any unit in the application. Because each instance of TMemvar is stored in FScatterList, it can be considered a Global object that can be accessed by any unit that has a reference to the Memvar unit in its Uses statement.



The method GatherMemvar is used to put the data into the same table from which it originally came or, if necessary, a different table. GatherMemvar spins through the fields stored in the TMemvar object and updates the target record with fields that match the FieldName and DataType. So the fields in the TMemvar object don't have to be an exact structural match to the target. Fields that don't match the FieldName and DataType are ignored. In addition, TMemvar's field values can be modified before using GatherMemvar, so you can replicate slightly different data should the need arise.



GatherMemvar is implemented in two flavors, using the Overload directive in the method declaration:



Procedure GatherMemVar(Source:TMemVar;Target:TDataSet;

                               Options:TGatherOptions);Overload;



Procedure GatherMemVar(Source,Target:TDataSet;

                       Options:TGatherOptions);Overload;




The only difference between these two methods is the first parameter. The first implementation uses the actual TMemvar object reference. The second uses the DataSet that was used to create the instance of TMemvar. Other than that, they're both identical. In fact, the first implementation actually calls the second. There are also some options that allow you to control how the GatherMemvar method gathers the data. You can Replace or Append data, issue a Post, or Free the object once the gather is complete. If no

options are present in the parameter, the default is to Replace the

Target's DataSet record and leave it in Edit state after it modifies the field data.



TGatherOption = (goReplace, goAppend, goPost, goFree);

TGatherOptions = Set Of TGatherOption ;



Procedure GatherMemVar(Source:TMemVar;Target:TDataSet;

                       Options:TGatherOptions);

Begin

   If (Source = Nil) Then

      Raise Exception.Create('Source TMemVar Object Cannot Be NIL');



   GatherMemVar(Source.DataSet,Target,Options);

End;



Procedure GatherMemVar(Source,Target:TDataSet; Options:TGatherOptions);

Var

   i : Integer ;

   iIndex : Integer ;

   MemObj : TMemvar ;

   FR : TMemvarField ;

Begin

   MemObj := FindMemvarObject(Source) ;

   If (MemObj = Nil) Then Begin

      Raise Exception.Create('Source DataSet ('+

                             Source.Name+') Has Not Been Scattered!');

   End;

   If (goAppend In Options) Then Begin

      Target.Append ;

   End Else Begin

      If Not (Target.State In [dsEdit,dsInsert]) Then

         Target.Edit ;

   End;



   For i := 0 To (Target.FieldCount-1) Do Begin

      iIndex := MemObj.FindFieldIndex(Target.Fields[i].FieldName);

      If iIndex >= 0 Then Begin

         If (Target.Fields[i].DataType = MemObj.Fields[iIndex].DataType) Then

            Target.Fields[i].Value := MemObj.Fields[iIndex].Value ;

      End;

   End;

   If (goPost In Options) Then

      Target.Post ;



   If (goFree In Options) Then

      MemObj.Free ;

End;

 




Putting the new functions to use

Here are a couple of examples of how these methods can be used.



Procedure MyExample1 copies field data from Table1 and appends a record to Table2 with the data from Table1. The options parameter goPost and goFree instruct the method to issue a Post to Table2, then free the TMemvar object.



Procedure MyExample1 ;

   Var

      MemObj : TMemvar ;

Begin

   MemObj := ScatterMemvar(Table1);

   // <do some table stuff>



   // Append a record to Table2, Post it,

   // then free the TMemvar object.

   GatherMemvar(MemObj,Table2,[goAppend,goPost,goFree]);

End;




Procedure MyExample2 copies field data from Table1, appends a record to Table2 with the data from Table1, then modifies the Name field before appending a record to Table3. In both GatherMemvar instances, the record is posted. The last also frees the TMemvar object.



Procedure MyExample2 ;

   Var

      MemObj : TMemvar

Begin

   MemObj := ScatterMemvar(Table1);

   // <do some table stuff>



   // Append a record to Table2 & Table3, Post it,

   // then free the TMemvar object.

   GatherMemvar(Table1,Table2,[goAppend,goPost]);



   // Change a memvar field value before appending

   // a record to Table3.

   MemObj.FieldValue['Name'] := 'Steve Zimmelman';



   GatherMemvar(Table1,Table3,[goAppend,goPost,goFree]);



End;







 

Share this article!

Follow us!

Find more helpful articles: