Mega Code Archive
Implementing foxpro’s scatter and gather memvar in delphi
<![CDATA[
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;
]]>