abstractdata.pas
unit abstractdata;
{ Implementation of item data manipulation classes.
Two conditional defines are used:
ACTIVE_X - turn on in item business logic module
LOG_ON - can be used for debug purposes. Allow to log
benchmarking information of apply procedures.
Developed by Alex Feigin. }
interface
uses
Windows, Classes, DBTables, Db, SysUtils, StrUtils, Databkr, ComObj, itemdm, Dialogs;
type
{ Class TItemSlice supports manipulation with item data slice }
TItemSlice = class(TPersistent)
private
{ Physical name of data field }
FFieldName:String;
{ Field value}
FValue:Variant;
public
constructor Create(EFieldName:string;EValue:Variant); virtual;
destructor Destroy; override;
property FieldName : string read FFieldName write FFieldName;
property Value : Variant read FValue write FValue;
end;
{ Class TItemData supports manipulations with item slices list }
TItemData = class(TPersistent)
private
{ Current index value}
currentIndex:integer;
{ TStringList, which includes references to item data slices }
ItemData:TStringList;
{ Reference to item logic RDM }
DMItemLog:TRemoteDataModule;
{ Function returns item slice, correspondend to the index value }
function GetItemSlice(I:Integer):TItemSlice;
{ Function process changes used to apply item slice to the appropriated
table. Available in item business logic module only. }
{$IFDEF ACTIVE_X}
function ProcessChanges(DataSet:TTable;ItemSlice:TItemSlice;var ParentKeySlice:TItemSlice):HResult;
{$ENDIF}
public
{$IFDEF LOG_ON}
ItemApplyTime:TDateTime;
DefaultApplyTime:TDateTime;
ProcessRecordTime:TDateTime;
checkIndexTime:TDateTime;
indexForFieldTime:TDateTime;
ProtocolApplyTime:TDateTime;
{$ENDIF}
constructor Create(DMItemLog:TRemoteDataModule;isSorted:Boolean=true);
destructor Destroy; override;
{ Function ApplyToDataSet used to apply item slices to the item database.
Available in item business logic module only. }
{$IFDEF ACTIVE_X}
function ApplyToDataSet(useDefaultLabel:Boolean;useDefaultCompItem:Boolean):HResult;
{$ENDIF}
{ Function, which adds new data slice to item data buffer}
function AddDataSlice(fieldName:string;Value:Variant):HResult;
{ Function, which reads first data slice from the item data buffer}
function ReadFirstDataSlice(var fieldName:string;var Value:Variant):HResult;
{ Function, which reads next data slice from the item data buffer}
function ReadNextDataSlice(var fieldName:string;var Value:Variant):HResult;
{ Function, InitFormDataSet was designed for retriving of item data buffer from the
item database. Not implemented in the current implementation, because there is no
users.}
function InitFromDataSet(Moniker:string):HResult;
{ Function makes search for item slice by field name }
function FindItemSlice(fieldName:String):TItemSlice;
{ Function reads item slice from item data buffer by field name }
function ReadSliceByName(fieldName:String):OleVariant;
{ Function returns field value, correspondend to the index value }
function GetItemValue(I:Integer) : Variant;
{ Procedure, which clears item data buffer }
procedure ClearItemData;
end;
implementation
{$IFDEF ACTIVE_X}
uses
dmLogItem;
{$ENDIF}
{ TItemSlice object constructor }
constructor TItemSlice.Create(EFieldName:string;EValue:Variant);
begin
inherited Create;
FieldName:=EFieldName;
Value:=EValue;
end;
{ TItemSlice object destructor }
destructor TItemSlice.Destroy;
begin
inherited Destroy;
end;
{ TItemData object constructor }
constructor TItemData.Create(DMItemLog:TRemoteDataModule;isSorted:Boolean);
begin
inherited Create;
{ Creation of string list, which will store references to item slices }
ItemData:=TStringList.Create;
ItemData.Sorted:=isSorted;
currentIndex:=0;
self.DMItemLog:=DMItemLog;
{$IFDEF LOG_ON}
ItemApplyTime:=0;
DefaultApplyTime:=0;
ProtocolApplyTime:=0;
ProcessRecordTime:=0;
checkIndexTime:=0;
indexForFieldTime:=0;
{$ENDIF}
end;
{ Function, which retrives item value by index from item data buffer
Input value : index
Returns : field value in case of success, otherwise returns varEmpty
}
function TItemData.GetItemValue(I:Integer) : Variant;
var
ItemSlice:TItemSlice;
begin
ItemSlice:=GetItemSlice(I);
if(ItemSlice<>nil) then
Result:=ItemSlice.Value;
end;
{ TItemData class destructor }
destructor TItemData.Destroy;
var
I:Integer;
begin
{ Destroing of item slice objects }
for I:=0 to ItemData.Count-1 do
ItemData.Objects[I].Destroy;
{ Destroying of item data buffer }
ItemData.Free;
inherited Destroy;
end;
{ Procedure to add new data slice to item data buffer.
Attention attempt to add value equal to varEmpty or varNull produce
an error.
Input values:
fieldName - physical field name
Value - field value
Returns NOERROR, if operation is successful. E_INVALIDARG in case of error. }
function TItemData.AddDataSlice(fieldName:string;Value:Variant):HResult;
begin
if(VarIsNull(Value) OR
VarIsEmpty(Value)) then
Result:=E_INVALIDARG
else
begin
ItemData.AddObject(fieldName,TItemSlice.Create(fieldName,Value));
Result:=NOERROR;
end;
end;
{ Function, which retrieves first data slice from item data buffer
Output values:
fieldName - physical field name
Value - field value
Returns NOERROR, if operation is successful, E_OUTOFMEMORY if item data
buffer is empty }
function TItemData.ReadFirstDataSlice(var fieldName:string;var Value:Variant):HResult;
var
ItemSlice:TItemSlice;
begin
currentIndex:=0;
if(currentIndexthen
begin
ItemSlice:=(ItemData.Objects[currentIndex] as TItemSlice);
fieldName:=ItemSlice.fieldName;
Value:=ItemSlice.Value;
Result:=NOERROR;
end
else
Result:=E_OUTOFMEMORY;
end;
{ Function, which retrieves next data slice from item data buffer
Output values:
fieldName - physical field name
Value - field value
Returns NOERROR, if operation is successful, E_OUTOFMEMORY if end of item data
buffer is reached }
function TItemData.ReadNextDataSlice(var fieldName:string;var Value:Variant):HResult;
var
ItemSlice:TItemSlice;
begin
Inc(currentIndex);
if(currentIndexthen
begin
ItemSlice:=(ItemData.Objects[currentIndex] as TItemSlice);
fieldName:=ItemSlice.fieldName;
Value:=ItemSlice.Value;
Result:=NOERROR;
end
else
Result:=E_OUTOFMEMORY;
end;
{ Function return item slice by index value.
Input value : I - index in item data buffer
Result : item slice object with index I, nil if appropriated
item slice is absent in item data buffer }
function TItemData.GetItemSlice(I:Integer):TItemSlice;
begin
if (I>=0) and (Ithen
Result:=TItemSlice(ItemData.Objects[I])
else
Result:=nil;
end;
{ Procedure, which clears item data buffer }
procedure TItemData.ClearItemData;
var
I:Integer;
begin
for I:=0 to ItemData.Count-1 do
ItemData.Objects[I].Destroy;
ItemData.Clear;
currentIndex:=0;
end;
{ Making search of slice from item data buffer by field name.
Input values : field name
Ouput values : item slice in case of success, nil if field
is not found }
function TItemData.FindItemSlice(fieldName:String):TItemSlice;
var
I:Integer;
isFound:Boolean;
begin
if(ItemData.Sorted) then
isFound:=ItemData.Find(fieldName,I)
else
begin
I:=ItemData.IndexOf(fieldName);
isFound:=(I<>-1);
end;
if(isFound) then
Result:=GetItemSlice(I)
else
Result:=nil;
end;
{ Reading of slice from item data buffer by field name.
Input values : field name
Ouput values : field value in case of success, varEmpty if field is not
found }
function TItemData.ReadSliceByName(fieldName:String):OleVariant;
var
ItemSlice:TItemSlice;
begin
ItemSlice:=FindItemSlice(fieldName);
if(ItemSlice<>nil) then
Result:=ItemSlice.Value;
end;
{ Not implemented }
function TItemData.InitFromDataSet(Moniker:string):HResult;
begin
Result:=NOERROR;
end;
{ Function process changes is available only in item business logic module.
Used to aaply item slice to the appropriated dataset.
Input values : DataSet - target table;
ItemsSlice - item data slice to apply;
Output value : ParenKeySlice - item slice, which stores data, correspondend to
item moniker value ('NUMBER');
Result : NOERROR - in case of success;
OLE_E_CANT_BINDTOSOURCE - current item slice includes one of the
index fields of the dataset, but concatenation
of parent key name and current field name does't
correspond to the availbale for the dataset index
E_PENDING - current item slice includes one of the
index fields of the dataset it is not complete index
and parent key is not initialized
OLE_E_STATIC - attempt to apply item splice, if record was not located
before (wrong order of the item slices. Right order must include
item slices with key values previous to data values.
E_IVALIDARG - attempt to add item slice, where field name is not found in the
current dataset.
}
{$IFDEF ACTIVE_X}
function TItemData.ProcessChanges(DataSet:TTable;ItemSlice:TItemSlice;var ParentKeySlice:TItemSlice):HResult;
var
IndexFields,currentIndexFieldName,detailIndex,boolStr:String;
currentPos:Integer;
isOccured:Boolean;
OleRes,CurrentValue:Variant;
CurrentField:TField;
{$IFDEF LOG_ON}
StartTime:TDateTime;
{$ENDIF}
begin
{ Comparison of current field and primary index fields }
{$IFDEF LOG_ON}
StartTime:=SysUtils.Now;
{$ENDIF}
currentPos:=1;
isOccured:=false;
if(DataSet.IndexDefs.Updated=false) then
DataSet.IndexDefs.Update;
if(DataSet.IndexDefs.Count=0) then
begin
Result:=OLE_E_CANT_BINDTOSOURCE;
Exit;
end;
{ Retrieving of primary index field names }
IndexFields:=DataSet.IndexDefs.Items[0].Fields;
while(currentPosdo
begin
currentIndexFieldName:=ExtractSubstr(IndexFields,currentPos,[';']);
{ Recognition of key fields in current item data slice }
if(currentIndexFieldName=ItemSlice.fieldName) then
begin
isOccured:=true;
break;
end;
end;
if(isOccured) then { There is a new key field value }
begin
{ Attempt to found index correspondend to found key field name in the current dataset }
if(DataSet.IndexDefs.GetIndexForFields(ItemSlice.fieldName,false)<>nil) then { Parent key is found}
begin
{ Parent key is found ( parent key here means key of item.db table }
parentKeySlice:=ItemSlice;
{ Attempt to locate record, correspondend to the parent key }
if(DataSet.Locate(parentKeySlice.fieldName,parentKeySlice.Value,[])) then
DataSet.Edit { Record is located. Will be modified }
else
DataSet.Insert; { Record is not located. New record addition.}
end
else
begin
{ Detail key recognition }
if(parentKeySlice<>nil) then
begin
DetailIndex:=parentKeySlice.FieldName+';'+ItemSlice.FieldName;
{ Attempt to found index correspondend to the detail index string in the current dataset }
if(DataSet.IndexDefs.GetIndexForFields(DetailIndex,false)<>nil) then
begin
{ Index is found. Attempt to locate record, correspondend to the detail key. }
if(DataSet.Locate(DetailIndex,VarArrayOf([parentKeySlice.Value,ItemSlice.Value]),[])) then
DataSet.Edit { Record is located. Will be modified }
else
begin
DataSet.Insert; { Record is not located. New record addition.}
{ Procedure RefreshNames produces automatic addition of new price, extended field,
compare item names to the system tables}
(DMItemLog as TDMItemLogic).ISysTbl.RefreshNames(WideString(ItemSlice.FieldName),ItemSlice.Value);
end;
end
else
begin
Result:=OLE_E_CANT_BINDTOSOURCE;
Exit;
end;
end
else
begin
Result:=E_PENDING;
Exit;
end;
end;
end;
{ Writing of information }
if (not (DataSet.State in [dsInsert,dsEdit])) then
begin
{ Dataset is not Edit or Insert mode and not ready to the writing of information }
Result:=OLE_E_STATIC;
Exit;
end
else
begin
{ Current field, correspondend to the item slice recognition }
CurrentField:=DataSet.FindField(ItemSlice.FieldName);
if(CurrentField<>nil) then
begin
{ If field is boolean special typecast procedure is performed. Values
'0', 'F' are converted to "false", the rest - to "true". }
if(CurrentField.DataType=ftBoolean) then
begin
try
CurrentValue:=Boolean(ItemSlice.Value);
except
boolStr:=VarToStr(ItemSlice.Value);
if(boolStr[1]='0') or (AnsiUppercase(boolStr[1])='F') then
CurrentValue:=false
else
CurrentValue:=true;
end;
end
else
CurrentValue:=ItemSlice.Value;
if(DataSet.State=dsEdit) then
begin
{ If field exists and don't overwrite flag is set in item defintion
table - new value is not applied }
OleRes:=(DMItemLog as TDMItemLogic).ISysTbl.IsKeepExistingInfo(WideString(ItemSlice.FieldName));
if(Boolean(OleRes)) then
begin
Result:=NOERROR;
Exit;
end;
end;
try
{ Apply of item slice value to the dataset field }
if((CurrentField.Value<>CurrentValue) and
(CurrentField.CanModify)) then
CurrentField.AsVariant:=CurrentValue;
except
CurrentField.AsVariant:=varNull;
end;
Result:=NOERROR;
end
else
Result:=E_INVALIDARG;
end;
{$IFDEF LOG_ON}
ProcessRecordTime:=ProcessRecordTime+StartTime-SysUtils.Now;
{$ENDIF}
end;
{ Procedure, which applies filled item data buffer
to item database.
Input values : useDefaultLabel switch. If it's "true" - default label
will be automatically added to each new item;
useDefaultCompItem switch. If it's "true" - default compare
item will be automatically added to each new item
Returns : NOERROR, if apply was finished successfully }
function TItemData.ApplyToDataSet(useDefaultLabel:Boolean;useDefaultCompItem:Boolean):HResult;
var
I,J:Integer;
Res:HResult;
currentSlice,ParentKeySlice:TItemSlice;
isOpenedHere:Boolean;
{$IFDEF LOG_ON}
StartTime:TDateTime;
{$ENDIF}
begin
ParentKeySlice:=nil;
Res:=NOERROR;
with TdmItemDBT((DMItemLog as TDMItemLogic).dmItemDbT) do
begin
{ If item data tables is not opened we should open it }
isOpenedHere:=NOT MasterTable.Active;
if(isOpenedHere) then
MasterTable.Open;
try
try
{ Item data buffer loop }
for I:=0 to ItemData.Count-1 do
begin
currentSlice:=GetItemSlice(I);
{ Attempt to find field, correspondend to the current item slice name
in tbItem }
if(MasterTable.FindField(currentSlice.fieldName)<>nil) then
Res:=ProcessChanges(MasterTable,currentSlice,ParentKeySlice) { Process changes if found }
else
begin
{ Attempt to find field, correspondend to the current item slice name
in detail tables }
for J:=0 to DETAIL_LINK_COUNT do
begin
if(detailTables[J].FindField(currentSlice.fieldName)<>nil) then
begin
Res:=ProcessChanges(detailTables[J],currentSlice,ParentKeySlice); { Process changes if found }
case Res of
NOERROR: Break;
OLE_E_STATIC: Continue; {It's normal situation. Current detail table doesn't includes field,
correspondend to the current item slice. We have to go to the next
detail table }
else
Abort;
end;
end;
end;
end;
if(Res<>NOERROR) then
Abort;
end;
{$IFDEF LOG_ON}
StartTime:=SysUtils.Now;
{$ENDIF}
{ Registration of virtual updates for update flag UF_ALWAYS }
if { (not CheckPendingUpdates) and} (updateFlag=UF_ALWAYS) and (ParentKeySlice<>nil) then
(DMItemLog as TDMItemLogic).RegisterUpdatedItem(WideString(ParentKeySlice.FieldName),ParentKeySlice.Value,userID,updateFlag,
ParentKeySlice.Value,ParentKeySlice.Value);
{ Apply of pending changes to the item database }
if(MasterTable.State in [dsInsert,dsEdit]) then
MasterTable.Post
else
CheckDetailBrowseMode;
{$IFDEF LOG_ON}
ItemApplyTime:=ItemApplyTime+StartTime-SysUtils.Now;
StartTime:=SysUtils.Now;
{$ENDIF}
if(useDefaultLabel) then { Default label addition }
begin
with tbItem2Lbl do
begin
Insert;
try
Post;
except
On E:Exception do
begin
Cancel;
end;
end;
end;
end;
if(useDefaultCompItem) then { Default compare item addition }
begin
with tbCompare do
begin
Insert;
try
Post;
except
On E:Exception do
begin
Cancel;
end;
end;
end;
end;
{$IFDEF LOG_ON}
DefaultApplyTime:=DefaultApplyTime+StartTime-SysUtils.Now;
{$ENDIF}
except
On E:Exception do
begin
MasterTable.Cancel;
if(Succeeded(Res)) then
raise Exception.Create(E.message)
else
raise Exception.Create(SysErrorMessage(Res));
end;
end;
finally
if(isOpenedHere) then
MasterTable.Close;
{ Apply of cached changes to the protocol }
{$IFDEF LOG_ON}
StartTime:=SysUtils.Now;
{$ENDIF}
(DMItemLog as TDMItemLogic).ProtocolApplyChanges;
{$IFDEF LOG_ON}
ProtocolApplyTime:=ProtocolApplyTime+StartTime-SysUtils.Now;
{$ENDIF}
Result:=Res;
end;
end;
end;
{$ENDIF}
end.
Back
to Parent Page