1642 lines
50 KiB
ObjectPascal
1642 lines
50 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) }
|
|
{ }
|
|
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
|
|
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
|
|
{ License at http://www.mozilla.org/MPL/ }
|
|
{ }
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
|
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
|
|
{ and limitations under the License. }
|
|
{ }
|
|
{ The Original Code is JclEDI.pas. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is Raymond Alexander. }
|
|
{ Portions created by Raymond Alexander are Copyright Raymond Alexander. All rights reserved. }
|
|
{ }
|
|
{ Contributor(s): }
|
|
{ Raymond Alexander (rayspostbox3), Robert Marquardt, Robert Rossmair, Petr Vones, }
|
|
{ Andreas Hausladen }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ Contains classes to eaisly parse EDI documents and data. Variable delimiter detection allows }
|
|
{ parsing of the file without knowledge of the standards at an Interchange level. This enables }
|
|
{ parsing and construction of EDI documents with different delimiters. }
|
|
{ }
|
|
{ Unit owner: Raymond Alexander }
|
|
{ Date created: Before February, 1, 2001 }
|
|
{ Additional Info: }
|
|
{ E-Mail at RaysDelphiBox3 att hotmail dott com }
|
|
{ For latest EDI specific demos see http://sourceforge.net/projects/edisdk }
|
|
{ See home page for latest news & events and online help. }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
// $Id: JclEDI.pas,v 1.17 2005/08/09 10:30:21 ahuser Exp $
|
|
|
|
unit JclEDI;
|
|
|
|
{$I jcl.inc}
|
|
|
|
{$IFDEF SUPPORTS_WEAKPACKAGEUNIT}
|
|
{$WEAKPACKAGEUNIT ON}
|
|
{$ENDIF SUPPORTS_WEAKPACKAGEUNIT}
|
|
|
|
// Add the following directive in project options for debugging memory leaks.
|
|
// {$DEFINE ENABLE_EDI_DEBUGGING}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes,
|
|
JclBase;
|
|
|
|
const
|
|
NA_LoopId = 'N/A'; // Constant used for loop id comparison
|
|
ElementSpecId_Reserved = 'Reserved';
|
|
|
|
EDIDataType_Numeric = 'N';
|
|
EDIDataType_Decimal = 'R';
|
|
EDIDataType_Identifier = 'ID';
|
|
EDIDataType_String = 'AN';
|
|
EDIDataType_Date = 'DT';
|
|
EDIDataType_Time = 'TM';
|
|
EDIDataType_Binary = 'B';
|
|
|
|
{$IFDEF ENABLE_EDI_DEBUGGING}
|
|
var
|
|
Debug_EDIDataObjectsCreated: Int64;
|
|
Debug_EDIDataObjectsDestroyed: Int64;
|
|
Debug_EDIDataObjectListCreated: Int64;
|
|
Debug_EDIDataObjectListDestroyed: Int64;
|
|
Debug_EDIDataObjectListItemsCreated: Int64;
|
|
Debug_EDIDataObjectListItemsDestroyed: Int64;
|
|
{$ENDIF ENABLE_EDI_DEBUGGING}
|
|
|
|
type
|
|
TEDIObject = class(TObject); // Base EDI Object
|
|
TEDIObjectArray = array of TEDIObject;
|
|
|
|
EJclEDIError = EJclError;
|
|
|
|
// EDI Forward Class Declarations
|
|
TEDIDataObject = class;
|
|
TEDIDataObjectGroup = class;
|
|
TEDIObjectListItem = class;
|
|
TEDIObjectList = class;
|
|
TEDIDataObjectListItem = class;
|
|
TEDIDataObjectList = class;
|
|
|
|
// EDI Delimiters Object
|
|
TEDIDelimiters = class(TEDIObject)
|
|
private
|
|
FSegmentDelimiter: string;
|
|
FElementDelimiter: string;
|
|
FSubElementSeperator: string; // Also known as: Component Data Seperator
|
|
FSegmentDelimiterLength: Integer;
|
|
FElementDelimiterLength: Integer;
|
|
FSubelementSeperatorLength: Integer;
|
|
procedure SetSD(const Delimiter: string);
|
|
procedure SetED(const Delimiter: string);
|
|
procedure SetSS(const Delimiter: string);
|
|
public
|
|
constructor Create; overload;
|
|
constructor Create(const SD, ED, SS: string); overload;
|
|
published
|
|
property SD: string read FSegmentDelimiter write SetSD;
|
|
property ED: string read FElementDelimiter write SetED;
|
|
property SS: string read FSubElementSeperator write SetSS;
|
|
property SDLen: Integer read FSegmentDelimiterLength;
|
|
property EDLen: Integer read FElementDelimiterLength;
|
|
property SSLen: Integer read FSubElementSeperatorLength;
|
|
end;
|
|
|
|
// EDI Data Object
|
|
TEDIDataObjectType =
|
|
(ediUnknown, ediElement, ediCompositeElement, ediSegment, ediLoop,
|
|
ediTransactionSet, ediMessage, ediFunctionalGroup,
|
|
ediInterchangeControl, ediFile, ediCustom);
|
|
|
|
TEDIDataObjectDataState = (ediCreated, ediAssembled, ediDisassembled);
|
|
|
|
{$IFDEF CLR}
|
|
TCustomData = TObject;
|
|
{$ELSE}
|
|
TCustomData = Pointer; // backward compatibility
|
|
{$ENDIF CLR}
|
|
|
|
TEDIDataObject = class(TEDIObject)
|
|
private
|
|
procedure SetDelimiters(const Delimiters: TEDIDelimiters);
|
|
protected
|
|
FEDIDOT: TEDIDataObjectType;
|
|
FState: TEDIDataObjectDataState;
|
|
FData: string;
|
|
FLength: Integer;
|
|
FParent: TEDIDataObject;
|
|
FDelimiters: TEDIDelimiters;
|
|
FErrorLog: TStrings;
|
|
FSpecPointer: TEDIObject;
|
|
FCustomData1: TCustomData;
|
|
FCustomData2: TCustomData;
|
|
function GetData: string;
|
|
procedure SetData(const Data: string);
|
|
public
|
|
constructor Create(Parent: TEDIDataObject); reintroduce;
|
|
destructor Destroy; override;
|
|
function Assemble: string; virtual; abstract;
|
|
procedure Disassemble; virtual; abstract;
|
|
property SpecPointer: TEDIObject read FSpecPointer write FSpecPointer;
|
|
property CustomData1: TCustomData read FCustomData1 write FCustomData1;
|
|
property CustomData2: TCustomData read FCustomData2 write FCustomData2;
|
|
published
|
|
property State: TEDIDataObjectDataState read FState;
|
|
property Data: string read GetData write SetData;
|
|
property DataLength: Integer read FLength;
|
|
property Parent: TEDIDataObject read FParent write FParent;
|
|
property Delimiters: TEDIDelimiters read FDelimiters write SetDelimiters;
|
|
end;
|
|
|
|
TEDIDataObjectArray = array of TEDIDataObject;
|
|
|
|
// EDI Data Object Group
|
|
TEDIDataObjectGroup = class(TEDIDataObject)
|
|
protected
|
|
FGroupIsParent: Boolean;
|
|
FEDIDataObjects: TEDIDataObjectList;
|
|
FCreateObjectType: TEDIDataObjectType;
|
|
function GetCount: Integer;
|
|
function GetEDIDataObject(Index: Integer): TEDIDataObject;
|
|
procedure SetEDIDataObject(Index: Integer; EDIDataObject: TEDIDataObject);
|
|
function InternalAssignDelimiters: TEDIDelimiters; virtual; abstract;
|
|
function InternalCreateEDIDataObject: TEDIDataObject; virtual; abstract;
|
|
public
|
|
constructor Create(Parent: TEDIDataObject; EDIDataObjectCount: Integer = 0); reintroduce;
|
|
destructor Destroy; override;
|
|
function IndexIsValid(Index: Integer): Boolean;
|
|
//
|
|
function AddEDIDataObject: Integer;
|
|
function AppendEDIDataObject(EDIDataObject: TEDIDataObject): Integer;
|
|
function InsertEDIDataObject(InsertIndex: Integer): Integer; overload;
|
|
function InsertEDIDataObject(InsertIndex: Integer; EDIDataObject:
|
|
TEDIDataObject): Integer; overload;
|
|
procedure DeleteEDIDataObject(Index: Integer); overload;
|
|
procedure DeleteEDIDataObject(EDIDataObject: TEDIDataObject); overload;
|
|
//
|
|
function AddEDIDataObjects(Count: Integer): Integer;
|
|
function AppendEDIDataObjects(EDIDataObjectArray: TEDIDataObjectArray): Integer;
|
|
function InsertEDIDataObjects(InsertIndex, Count: Integer): Integer; overload;
|
|
function InsertEDIDataObjects(InsertIndex: Integer;
|
|
EDIDataObjectArray: TEDIDataObjectArray): Integer; overload;
|
|
procedure DeleteEDIDataObjects; overload;
|
|
procedure DeleteEDIDataObjects(Index, Count: Integer); overload;
|
|
//
|
|
function GetIndexPositionFromParent: Integer; virtual;
|
|
//
|
|
property EDIDataObject[Index: Integer]: TEDIDataObject read GetEDIDataObject
|
|
write SetEDIDataObject; default;
|
|
property EDIDataObjects: TEDIDataObjectList read FEDIDataObjects;
|
|
published
|
|
property CreateObjectType: TEDIDataObjectType read FCreateObjectType;
|
|
property EDIDataObjectCount: Integer read GetCount;
|
|
end;
|
|
|
|
TEDIDataObjectGroupArray = array of TEDIDataObjectGroup;
|
|
|
|
// EDI Data Object Linked List Header and Item classes
|
|
TEDIObjectListItem = class(TEDIObject)
|
|
protected
|
|
FParent: TEDIObjectList;
|
|
FPriorItem: TEDIObjectListItem;
|
|
FNextItem: TEDIObjectListItem;
|
|
FEDIObject: TEDIObject;
|
|
FItemIndex: Integer;
|
|
FName: string;
|
|
public
|
|
constructor Create(Parent: TEDIObjectList; PriorItem: TEDIObjectListItem;
|
|
EDIObject: TEDIObject = nil);
|
|
destructor Destroy; override;
|
|
function GetIndexPositionFromParent: Integer;
|
|
procedure FreeAndNilEDIDataObject;
|
|
published
|
|
property ItemIndex: Integer read FItemIndex write FItemIndex;
|
|
property PriorItem: TEDIObjectListItem read FPriorItem write FPriorItem;
|
|
property NextItem: TEDIObjectListItem read FNextItem write FNextItem;
|
|
property EDIObject: TEDIObject read FEDIObject write FEDIObject;
|
|
property Name: string read FName write FName;
|
|
property Parent: TEDIObjectList read FParent write FParent;
|
|
end;
|
|
|
|
TEDIDataObjectListOptions = set of (loAutoUpdateIndexes);
|
|
|
|
TEDIObjectList = class(TEDIObject)
|
|
private
|
|
function GetItem(Index: Integer): TEDIObjectListItem;
|
|
protected
|
|
FOwnsObjects: Boolean;
|
|
FCount: Integer;
|
|
FOptions: TEDIDataObjectListOptions;
|
|
FFirstItem: TEDIObjectListItem;
|
|
FLastItem: TEDIObjectListItem;
|
|
FCurrentItem: TEDIObjectListItem;
|
|
function GetEDIObject(Index: Integer): TEDIObject;
|
|
procedure SetEDIObject(Index: Integer; const Value: TEDIObject);
|
|
function CreateListItem(PriorItem: TEDIObjectListItem;
|
|
EDIObject: TEDIObject = nil): TEDIObjectListItem; virtual;
|
|
public
|
|
constructor Create(OwnsObjects: Boolean = True);
|
|
destructor Destroy; override;
|
|
procedure Add(Item: TEDIObjectListItem; Name: string = ''); overload;
|
|
function Add(EDIObject: TEDIObject; Name: string = ''): TEDIObjectListItem; overload;
|
|
function Find(Item: TEDIObjectListItem): TEDIObjectListItem; overload;
|
|
function Find(EDIObject: TEDIObject): TEDIObjectListItem; overload;
|
|
function FindEDIObject(EDIObject: TEDIObject): TEDIObject;
|
|
function Extract(Item: TEDIObjectListItem): TEDIObjectListItem; overload; virtual;
|
|
function Extract(EDIObject: TEDIObject): TEDIObject; overload; virtual;
|
|
procedure Remove(Item: TEDIObjectListItem); overload;
|
|
procedure Remove(EDIObject: TEDIObject); overload;
|
|
function Insert(Item, BeforeItem: TEDIObjectListItem): TEDIObjectListItem; overload;
|
|
function Insert(EDIObject, BeforeEDIObject: TEDIObject): TEDIObjectListItem; overload;
|
|
function Insert(BeforeItem: TEDIObjectListItem): TEDIObjectListItem; overload;
|
|
function Insert(BeforeEDIObject: TEDIObject): TEDIObjectListItem; overload;
|
|
procedure Clear;
|
|
function First(Index: Integer = 0): TEDIObjectListItem; virtual;
|
|
function Next: TEDIObjectListItem; virtual;
|
|
function Prior: TEDIObjectListItem; virtual;
|
|
function Last: TEDIObjectListItem; virtual;
|
|
procedure UpdateCount;
|
|
// ...ByName procedures and functions
|
|
function FindItemByName(Name: string;
|
|
StartItem: TEDIObjectListItem = nil): TEDIObjectListItem; virtual;
|
|
function ReturnListItemsByName(Name: string): TEDIObjectList; virtual;
|
|
// Dynamic Array Emulation
|
|
function IndexOf(Item: TEDIObjectListItem): Integer; overload;
|
|
function IndexOf(EDIObject: TEDIObject): Integer; overload;
|
|
function IndexIsValid(Index: Integer): Boolean;
|
|
procedure Insert(InsertIndex: Integer; EDIObject: TEDIObject); overload;
|
|
procedure Delete(Index: Integer); overload;
|
|
procedure Delete(EDIObject: TEDIObject); overload;
|
|
procedure UpdateIndexes(StartItem: TEDIObjectListItem = nil);
|
|
//
|
|
property Item[Index: Integer]: TEDIObjectListItem read GetItem;
|
|
property EDIObject[Index: Integer]: TEDIObject read GetEDIObject
|
|
write SetEDIObject; default;
|
|
published
|
|
property Count: Integer read FCount;
|
|
property OwnsObjects: Boolean read FOwnsObjects write FOwnsObjects;
|
|
property Options: TEDIDataObjectListOptions read FOptions write FOptions;
|
|
property CurrentItem: TEDIObjectListItem read FCurrentItem;
|
|
end;
|
|
|
|
TEDIDataObjectListItem = class(TEDIObjectListItem)
|
|
private
|
|
function GetEDIDataObject: TEDIDataObject;
|
|
procedure SetEDIDataObject(const Value: TEDIDataObject);
|
|
published
|
|
property EDIDataObject: TEDIDataObject read GetEDIDataObject write SetEDIDataObject;
|
|
end;
|
|
|
|
TEDIDataObjectList = class(TEDIObjectList)
|
|
private
|
|
function GetEDIDataObject(Index: Integer): TEDIDataObject;
|
|
procedure SetEDIDataObject(Index: Integer; const Value: TEDIDataObject);
|
|
public
|
|
function CreateListItem(PriorItem: TEDIObjectListItem;
|
|
EDIObject: TEDIObject = nil): TEDIObjectListItem; override;
|
|
property EDIDataObject[Index: Integer]: TEDIDataObject read GetEDIDataObject
|
|
write SetEDIDataObject; default;
|
|
end;
|
|
|
|
// EDI Loop Stack
|
|
TEDILoopStackRecord = record
|
|
SegmentId: string;
|
|
SpecStartIndex: Integer;
|
|
OwnerLoopId: string;
|
|
ParentLoopId: string;
|
|
EDIObject: TEDIObject;
|
|
EDISpecObject: TEDIObject;
|
|
end;
|
|
|
|
TEDILoopStackArray = array of TEDILoopStackRecord;
|
|
|
|
TEDILoopStackFlags = (ediAltStackPointer, ediStackResized, ediLoopRepeated);
|
|
|
|
TEDILoopStackFlagSet = set of TEDILoopStackFlags;
|
|
|
|
TEDILoopStackOnAddLoopEvent = procedure(StackRecord: TEDILoopStackRecord;
|
|
SegmentId, OwnerLoopId, ParentLoopId: string; var EDIObject: TEDIObject) of object;
|
|
|
|
TEDILoopStack = class(TEDIObject)
|
|
private
|
|
function GetSize: Integer;
|
|
protected
|
|
FStack: TEDILoopStackArray;
|
|
FFlags: TEDILoopStackFlagSet;
|
|
FCheckAssignedEDIObject: Boolean;
|
|
FOnAddLoop: TEDILoopStackOnAddLoopEvent;
|
|
procedure DoAddLoop(StackRecord: TEDILoopStackRecord;
|
|
SegmentId, OwnerLoopId, ParentLoopId: string; var EDIObject: TEDIObject);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
// Basic Stack Routines
|
|
function Peek: TEDILoopStackRecord; overload;
|
|
function Peek(Index: Integer): TEDILoopStackRecord; overload;
|
|
procedure Pop(Index: Integer);
|
|
function Push(SegmentId, OwnerLoopId, ParentLoopId: string; StartIndex: Integer;
|
|
EDIObject: TEDIObject): Integer;
|
|
// Extended Stack Routines
|
|
function GetSafeStackIndex(Index: Integer): Integer;
|
|
function SetStackPointer(OwnerLoopId, ParentLoopId: string): Integer;
|
|
procedure UpdateStackObject(EDIObject: TEDIObject);
|
|
procedure UpdateStackData(SegmentId, OwnerLoopId, ParentLoopId: string; StartIndex: Integer;
|
|
EDIObject: TEDIObject);
|
|
// Extended Stack Routines
|
|
function ValidateLoopStack(SegmentId, OwnerLoopId, ParentLoopId: string; StartIndex: Integer;
|
|
EDIObject: TEDIObject): TEDILoopStackRecord;
|
|
function Debug: string;
|
|
//
|
|
property Stack: TEDILoopStackArray read FStack;
|
|
published
|
|
property Size: Integer read GetSize;
|
|
property Flags: TEDILoopStackFlagSet read FFlags write FFlags;
|
|
property OnAddLoop: TEDILoopStackOnAddLoopEvent read FOnAddLoop write FOnAddLoop;
|
|
end;
|
|
|
|
// Other
|
|
// Compatibility functions
|
|
function StringRemove(const S, Pattern: string; Flags: TReplaceFlags): string;
|
|
function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
|
|
|
|
implementation
|
|
|
|
uses
|
|
JclResources, JclStrings;
|
|
|
|
// Other
|
|
function StringRemove(const S, Pattern: string; Flags: TReplaceFlags): string;
|
|
var
|
|
SearchPattern: string;
|
|
I, Offset, SearchPatternLength: Integer;
|
|
begin
|
|
if rfIgnoreCase in Flags then
|
|
begin
|
|
Result := AnsiUpperCase(S);
|
|
SearchPattern := AnsiUpperCase(Pattern);
|
|
end
|
|
else
|
|
begin
|
|
Result := S;
|
|
SearchPattern := Pattern;
|
|
end;
|
|
SearchPatternLength := Length(SearchPattern);
|
|
Result := S;
|
|
|
|
I := 1;
|
|
Offset := 1;
|
|
while I <= Length(Result) do
|
|
begin
|
|
if SearchPatternLength = 1 then
|
|
begin
|
|
while Result[I] = SearchPattern[1] do
|
|
begin
|
|
Offset := Offset + SearchPatternLength;
|
|
if not (rfReplaceAll in Flags) then
|
|
Break;
|
|
Inc(I);
|
|
end;
|
|
end
|
|
else // SearchPatternLength > 1
|
|
begin
|
|
while Copy(Result, Offset, SearchPatternLength) = SearchPattern do
|
|
begin
|
|
Offset := Offset + SearchPatternLength;
|
|
if not (rfReplaceAll in Flags) then
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
if Offset <= Length(Result) then
|
|
Result[I] := S[Offset]
|
|
else
|
|
begin
|
|
Result[I] := #0;
|
|
SetLength(Result, I-1);
|
|
Break;
|
|
end;
|
|
|
|
if not (rfReplaceAll in Flags) then
|
|
Break;
|
|
|
|
Inc(I);
|
|
Inc(Offset);
|
|
end;
|
|
end;
|
|
|
|
function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
|
|
var
|
|
SearchString, SearchPattern: string;
|
|
I, SearchIndex, ReplaceIndex: Integer;
|
|
SearchPatternLength, ReplacePatternLength: Integer;
|
|
SearchResult, ReplaceCount: Integer;
|
|
begin
|
|
Result := '';
|
|
// Handle Case Sensitivity
|
|
if rfIgnoreCase in Flags then
|
|
begin
|
|
SearchString := AnsiUpperCase(S);
|
|
SearchPattern := AnsiUpperCase(OldPattern);
|
|
end
|
|
else
|
|
begin
|
|
SearchString := S;
|
|
SearchPattern := OldPattern;
|
|
end;
|
|
SearchPatternLength := Length(OldPattern);
|
|
ReplacePatternLength := Length(NewPattern);
|
|
// Calculate length of result string
|
|
ReplaceCount := 0;
|
|
SearchResult := StrSearch(SearchPattern, SearchString, 1);
|
|
if rfReplaceAll in Flags then
|
|
while SearchResult <> 0 do
|
|
begin
|
|
Inc(SearchResult);
|
|
Inc(ReplaceCount);
|
|
SearchResult := StrSearch(SearchPattern, SearchString, SearchResult);
|
|
end
|
|
else
|
|
if SearchResult <> 0 then
|
|
Inc(ReplaceCount);
|
|
SetLength(Result, Length(S) + ((ReplacePatternLength - SearchPatternLength) * ReplaceCount));
|
|
// Copy the characters by looping through the result and source at the same time
|
|
ReplaceCount := 0;
|
|
ReplaceIndex := 1;
|
|
SearchIndex := 1;
|
|
// Loop while the indexes are still in range
|
|
while (ReplaceIndex <= Length(Result)) and (SearchIndex <= Length(SearchString)) do
|
|
begin
|
|
// Enter algorithm if replacing a pattern or there have been no replacements yet
|
|
if (rfReplaceAll in Flags) or ((not (rfReplaceAll in Flags)) and (ReplaceCount = 0)) then
|
|
// Replace the pattern (including repeating patterns)
|
|
while Copy(SearchString, SearchIndex, SearchPatternLength) = SearchPattern do
|
|
begin
|
|
// Move forward in the search string
|
|
SearchIndex := SearchIndex + Length(SearchPattern);
|
|
// Replace an old pattern by writing the new pattern to the result
|
|
I := 1;
|
|
while (ReplaceIndex <= Length(Result)) and (I <= ReplacePatternLength) do
|
|
begin
|
|
Result[ReplaceIndex] := NewPattern[I];
|
|
Inc(I);
|
|
Inc(ReplaceIndex);
|
|
end;
|
|
//
|
|
Inc(ReplaceCount);
|
|
// If only making one replacement then break
|
|
if not (rfReplaceAll in Flags) then
|
|
Break;
|
|
end;
|
|
|
|
// Copy character
|
|
if (ReplaceIndex <= Length(Result)) and (SearchIndex <= Length(SearchString)) then
|
|
Result[ReplaceIndex] := S[SearchIndex];
|
|
|
|
// Set indexes for next copy
|
|
Inc(SearchIndex);
|
|
Inc(ReplaceIndex);
|
|
end;
|
|
end;
|
|
|
|
//=== { TEDIDelimiters } =====================================================
|
|
|
|
constructor TEDIDelimiters.Create;
|
|
begin
|
|
Create('~', '*', '>');
|
|
end;
|
|
|
|
constructor TEDIDelimiters.Create(const SD, ED, SS: string);
|
|
begin
|
|
inherited Create;
|
|
SetSD(SD);
|
|
SetED(ED);
|
|
SetSS(SS);
|
|
end;
|
|
|
|
procedure TEDIDelimiters.SetED(const Delimiter: string);
|
|
begin
|
|
FElementDelimiter := Delimiter;
|
|
FElementDelimiterLength := Length(FElementDelimiter);
|
|
end;
|
|
|
|
procedure TEDIDelimiters.SetSD(const Delimiter: string);
|
|
begin
|
|
FSegmentDelimiter := Delimiter;
|
|
FSegmentDelimiterLength := Length(FSegmentDelimiter);
|
|
end;
|
|
|
|
procedure TEDIDelimiters.SetSS(const Delimiter: string);
|
|
begin
|
|
FSubelementSeperator := Delimiter;
|
|
FSubelementSeperatorLength := Length(FSubElementSeperator);
|
|
end;
|
|
|
|
//=== { TEDIDataObject } =====================================================
|
|
|
|
constructor TEDIDataObject.Create(Parent: TEDIDataObject);
|
|
begin
|
|
inherited Create;
|
|
FState := ediCreated;
|
|
FEDIDOT := ediUnknown;
|
|
FData := '';
|
|
FLength := 0;
|
|
FParent := Parent;
|
|
FDelimiters := nil;
|
|
FSpecPointer := nil;
|
|
FCustomData1 := nil;
|
|
FCustomData2 := nil;
|
|
{$IFDEF ENABLE_EDI_DEBUGGING}
|
|
Inc(Debug_EDIDataObjectsCreated);
|
|
{$ENDIF ENABLE_EDI_DEBUGGING}
|
|
end;
|
|
|
|
destructor TEDIDataObject.Destroy;
|
|
begin
|
|
{$IFDEF ENABLE_EDI_DEBUGGING}
|
|
Inc(Debug_EDIDataObjectsDestroyed);
|
|
{$ENDIF ENABLE_EDI_DEBUGGING}
|
|
if not Assigned(FParent) then
|
|
FDelimiters.Free;
|
|
FDelimiters := nil;
|
|
FSpecPointer := nil;
|
|
FCustomData1 := nil;
|
|
FCustomData2 := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TEDIDataObject.GetData: string;
|
|
begin
|
|
Result := FData;
|
|
end;
|
|
|
|
procedure TEDIDataObject.SetData(const Data: string);
|
|
begin
|
|
FData := Data;
|
|
FLength := Length(FData);
|
|
end;
|
|
|
|
procedure TEDIDataObject.SetDelimiters(const Delimiters: TEDIDelimiters);
|
|
begin
|
|
if not Assigned(FParent) then
|
|
FreeAndNil(FDelimiters);
|
|
FDelimiters := Delimiters;
|
|
end;
|
|
|
|
//=== { TEDIDataObjectGroup } ================================================
|
|
|
|
constructor TEDIDataObjectGroup.Create(Parent: TEDIDataObject; EDIDataObjectCount: Integer);
|
|
begin
|
|
inherited Create(Parent);
|
|
FCreateObjectType := ediUnknown;
|
|
FGroupIsParent := True;
|
|
FEDIDataObjects := TEDIDataObjectList.Create;
|
|
if EDIDataObjectCount > 0 then
|
|
AddEDIDataObjects(EDIDataObjectCount);
|
|
end;
|
|
|
|
function TEDIDataObjectGroup.AddEDIDataObjects(Count: Integer): Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := FEDIDataObjects.Count; // Return position of 1st
|
|
for I := 1 to Count do
|
|
FEDIDataObjects.Add(InternalCreateEDIDataObject);
|
|
end;
|
|
|
|
function TEDIDataObjectGroup.AddEDIDataObject: Integer;
|
|
begin
|
|
Result := FEDIDataObjects.Count; // Return position
|
|
FEDIDataObjects.Add(InternalCreateEDIDataObject);
|
|
end;
|
|
|
|
function TEDIDataObjectGroup.AppendEDIDataObject(EDIDataObject: TEDIDataObject): Integer;
|
|
begin
|
|
Result := FEDIDataObjects.Count; // Return position
|
|
FEDIDataObjects.Add(EDIDataObject);
|
|
if FGroupIsParent then
|
|
EDIDataObject.Parent := Self;
|
|
end;
|
|
|
|
function TEDIDataObjectGroup.AppendEDIDataObjects(EDIDataObjectArray: TEDIDataObjectArray): Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := FEDIDataObjects.Count; // Return position of 1st
|
|
for I := Low(EDIDataObjectArray) to High(EDIDataObjectArray) do
|
|
begin
|
|
FEDIDataObjects.Add(EDIDataObjectArray[I]);
|
|
if FGroupIsParent then
|
|
EDIDataObjectArray[I].Parent := Self;
|
|
end;
|
|
end;
|
|
|
|
procedure TEDIDataObjectGroup.DeleteEDIDataObject(EDIDataObject: TEDIDataObject);
|
|
begin
|
|
if loAutoUpdateIndexes in FEDIDataObjects.Options then
|
|
FEDIDataObjects.Delete(EDIDataObject)
|
|
else
|
|
FEDIDataObjects.Remove(EDIDataObject);
|
|
end;
|
|
|
|
procedure TEDIDataObjectGroup.DeleteEDIDataObject(Index: Integer);
|
|
begin
|
|
if IndexIsValid(Index) then
|
|
FEDIDataObjects.Delete(Index)
|
|
else
|
|
{$IFNDEF CLR}
|
|
raise EJclEDIError.CreateResFmt(@RsEDIError010, [Self.ClassName, IntToStr(Index)]);
|
|
{$ELSE}
|
|
raise EJclEDIError.CreateFmt(RsEDIError010, [Self.ClassName, IntToStr(Index)]);
|
|
{$ENDIF ~CLR}
|
|
end;
|
|
|
|
procedure TEDIDataObjectGroup.DeleteEDIDataObjects;
|
|
begin
|
|
FEDIDataObjects.Clear;
|
|
end;
|
|
|
|
procedure TEDIDataObjectGroup.DeleteEDIDataObjects(Index, Count: Integer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if IndexIsValid(Index) then
|
|
begin
|
|
FEDIDataObjects.Options := FEDIDataObjects.Options - [loAutoUpdateIndexes];
|
|
try
|
|
for I := 1 to Count do
|
|
DeleteEDIDataObject(Index);
|
|
finally
|
|
FEDIDataObjects.Options := FEDIDataObjects.Options + [loAutoUpdateIndexes];
|
|
end;
|
|
end
|
|
else
|
|
{$IFNDEF CLR}
|
|
raise EJclEDIError.CreateResFmt(@RsEDIError011, [IntToStr(Index)]);
|
|
{$ELSE}
|
|
raise EJclEDIError.CreateFmt(RsEDIError011, [IntToStr(Index)]);
|
|
{$ENDIF ~CLR}
|
|
end;
|
|
|
|
destructor TEDIDataObjectGroup.Destroy;
|
|
begin
|
|
DeleteEDIDataObjects;
|
|
FreeAndNil(FEDIDataObjects);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TEDIDataObjectGroup.GetEDIDataObject(Index: Integer): TEDIDataObject;
|
|
begin
|
|
if FEDIDataObjects.Count > 0 then
|
|
if Index >= 0 then
|
|
if Index <= FEDIDataObjects.Count - 1 then
|
|
begin
|
|
if not Assigned(FEDIDataObjects[Index]) then
|
|
raise EJclEDIError.CreateFmt(RsEDIError006, [Self.ClassName, IntToStr(Index)]);
|
|
Result := FEDIDataObjects[Index];
|
|
end
|
|
else
|
|
raise EJclEDIError.CreateFmt(RsEDIError005, [Self.ClassName, IntToStr(Index)])
|
|
else
|
|
raise EJclEDIError.CreateFmt(RsEDIError004, [Self.ClassName, IntToStr(Index)])
|
|
else
|
|
raise EJclEDIError.CreateFmt(RsEDIError003, [Self.ClassName, IntToStr(Index)]);
|
|
end;
|
|
|
|
function TEDIDataObjectGroup.IndexIsValid(Index: Integer): Boolean;
|
|
begin
|
|
Result := FEDIDataObjects.IndexIsValid(Index);
|
|
end;
|
|
|
|
function TEDIDataObjectGroup.InsertEDIDataObject(InsertIndex: Integer): Integer;
|
|
begin
|
|
Result := InsertIndex; // Return position
|
|
if IndexIsValid(InsertIndex) then
|
|
FEDIDataObjects.Insert(InsertIndex, InternalCreateEDIDataObject)
|
|
else
|
|
Result := AddEDIDataObject;
|
|
end;
|
|
|
|
function TEDIDataObjectGroup.InsertEDIDataObject(InsertIndex: Integer;
|
|
EDIDataObject: TEDIDataObject): Integer;
|
|
begin
|
|
Result := InsertIndex; // Return position
|
|
if IndexIsValid(InsertIndex) then
|
|
begin
|
|
FEDIDataObjects.Insert(InsertIndex, EDIDataObject);
|
|
if FGroupIsParent then
|
|
EDIDataObject.Parent := Self;
|
|
end
|
|
else
|
|
Result := AppendEDIDataObject(EDIDataObject);
|
|
end;
|
|
|
|
function TEDIDataObjectGroup.InsertEDIDataObjects(InsertIndex: Integer;
|
|
EDIDataObjectArray: TEDIDataObjectArray): Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := InsertIndex; // Return position of 1st
|
|
if IndexIsValid(InsertIndex) then
|
|
begin
|
|
for I := High(EDIDataObjectArray) downto Low(EDIDataObjectArray) do
|
|
begin
|
|
FEDIDataObjects.Insert(InsertIndex, EDIDataObjectArray[I]);
|
|
if FGroupIsParent then
|
|
EDIDataObjectArray[I].Parent := Self;
|
|
end;
|
|
end
|
|
else
|
|
Result := AppendEDIDataObjects(EDIDataObjectArray);
|
|
end;
|
|
|
|
function TEDIDataObjectGroup.InsertEDIDataObjects(InsertIndex, Count: Integer): Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := InsertIndex; // Return position of 1st
|
|
if IndexIsValid(InsertIndex) then
|
|
begin
|
|
for I := 1 to Count do
|
|
FEDIDataObjects.Insert(InsertIndex, InternalCreateEDIDataObject);
|
|
end
|
|
else
|
|
Result := AddEDIDataObjects(Count);
|
|
end;
|
|
|
|
procedure TEDIDataObjectGroup.SetEDIDataObject(Index: Integer; EDIDataObject: TEDIDataObject);
|
|
begin
|
|
if FEDIDataObjects.Count > 0 then
|
|
if Index >= 0 then
|
|
if Index <= FEDIDataObjects.Count - 1 then
|
|
begin
|
|
FEDIDataObjects.Item[Index].FreeAndNilEDIDataObject;
|
|
FEDIDataObjects[Index] := EDIDataObject;
|
|
if FGroupIsParent then
|
|
FEDIDataObjects[Index].Parent := Self;
|
|
end
|
|
else
|
|
raise EJclEDIError.CreateFmt(RsEDIError009, [Self.ClassName, IntToStr(Index)])
|
|
else
|
|
raise EJclEDIError.CreateFmt(RsEDIError008, [Self.ClassName, IntToStr(Index)])
|
|
else
|
|
raise EJclEDIError.CreateFmt(RsEDIError007, [Self.ClassName, IntToStr(Index)]);
|
|
end;
|
|
|
|
function TEDIDataObjectGroup.GetIndexPositionFromParent: Integer;
|
|
var
|
|
I: Integer;
|
|
ParentGroup: TEDIDataObjectGroup;
|
|
begin
|
|
Result := -1;
|
|
if Assigned(Parent) and (Parent is TEDIDataObjectGroup) then
|
|
begin
|
|
ParentGroup := TEDIDataObjectGroup(Parent);
|
|
for I := 0 to ParentGroup.EDIDataObjectCount - 1 do
|
|
if ParentGroup.EDIDataObject[I] = Self then
|
|
begin
|
|
Result := I;
|
|
Break;
|
|
end;
|
|
end; // if
|
|
end;
|
|
|
|
function TEDIDataObjectGroup.GetCount: Integer;
|
|
begin
|
|
Result := FEDIDataObjects.Count;
|
|
end;
|
|
|
|
//=== { TEDIObjectListItem } =================================================
|
|
|
|
constructor TEDIObjectListItem.Create(Parent: TEDIObjectList;
|
|
PriorItem: TEDIObjectListItem; EDIObject: TEDIObject = nil);
|
|
begin
|
|
inherited Create;
|
|
FName := '';
|
|
FParent := Parent;
|
|
FItemIndex := 0;
|
|
FEDIObject := EDIObject;
|
|
FPriorItem := PriorItem;
|
|
FNextItem := nil;
|
|
if FPriorItem <> nil then
|
|
FItemIndex := FPriorItem.ItemIndex + 1;
|
|
{$IFDEF ENABLE_EDI_DEBUGGING}
|
|
Inc(Debug_EDIDataObjectListItemsCreated);
|
|
{$ENDIF ENABLE_EDI_DEBUGGING}
|
|
end;
|
|
|
|
destructor TEDIObjectListItem.Destroy;
|
|
begin
|
|
{$IFDEF ENABLE_EDI_DEBUGGING}
|
|
Inc(Debug_EDIDataObjectListItemsDestroyed);
|
|
{$ENDIF ENABLE_EDI_DEBUGGING}
|
|
FPriorItem := nil;
|
|
FNextItem := nil;
|
|
if FParent.OwnsObjects then
|
|
FreeAndNilEDIDataObject;
|
|
FEDIObject := nil;
|
|
FParent := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TEDIObjectListItem.FreeAndNilEDIDataObject;
|
|
begin
|
|
FreeAndNil(FEDIObject);
|
|
end;
|
|
|
|
function TEDIObjectListItem.GetIndexPositionFromParent: Integer;
|
|
begin
|
|
Result := FParent.IndexOf(Self);
|
|
end;
|
|
|
|
//=== { TEDIObjectList } =====================================================
|
|
|
|
constructor TEDIObjectList.Create(OwnsObjects: Boolean = True);
|
|
begin
|
|
inherited Create;
|
|
FOwnsObjects := OwnsObjects;
|
|
FFirstItem := nil;
|
|
FLastItem := nil;
|
|
FCurrentItem := nil;
|
|
FCount := 0;
|
|
FOptions := [loAutoUpdateIndexes];
|
|
{$IFDEF ENABLE_EDI_DEBUGGING}
|
|
Inc(Debug_EDIDataObjectListCreated);
|
|
{$ENDIF ENABLE_EDI_DEBUGGING}
|
|
end;
|
|
|
|
destructor TEDIObjectList.Destroy;
|
|
begin
|
|
{$IFDEF ENABLE_EDI_DEBUGGING}
|
|
Inc(Debug_EDIDataObjectListDestroyed);
|
|
{$ENDIF ENABLE_EDI_DEBUGGING}
|
|
Clear;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TEDIObjectList.Clear;
|
|
var
|
|
ListItem: TEDIObjectListItem;
|
|
TempItem: TEDIObjectListItem;
|
|
begin
|
|
ListItem := FFirstItem;
|
|
while ListItem <> nil do
|
|
begin
|
|
TempItem := ListItem;
|
|
ListItem := ListItem.NextItem;
|
|
TempItem.Free;
|
|
end;
|
|
FFirstItem := nil;
|
|
FLastItem := nil;
|
|
FCurrentItem := nil;
|
|
FCount := 0;
|
|
end;
|
|
|
|
function TEDIObjectList.First(Index: Integer): TEDIObjectListItem;
|
|
begin
|
|
if Index = 0 then
|
|
Result := FFirstItem
|
|
else
|
|
Result := GetItem(Index);
|
|
FCurrentItem := Result;
|
|
end;
|
|
|
|
function TEDIObjectList.Last: TEDIObjectListItem;
|
|
begin
|
|
FCurrentItem := FLastItem;
|
|
Result := FCurrentItem;
|
|
end;
|
|
|
|
function TEDIObjectList.Next: TEDIObjectListItem;
|
|
begin
|
|
FCurrentItem := FCurrentItem.NextItem;
|
|
Result := FCurrentItem;
|
|
end;
|
|
|
|
function TEDIObjectList.Prior: TEDIObjectListItem;
|
|
begin
|
|
FCurrentItem := FCurrentItem.PriorItem;
|
|
Result := FCurrentItem;
|
|
end;
|
|
|
|
function TEDIObjectList.Add(EDIObject: TEDIObject; Name: string): TEDIObjectListItem;
|
|
begin
|
|
Result := CreateListItem(FLastItem, EDIObject);
|
|
Result.Name := Name;
|
|
if FLastItem <> nil then
|
|
FLastItem.NextItem := Result;
|
|
if FFirstItem = nil then
|
|
FFirstItem := Result;
|
|
FLastItem := Result;
|
|
FCurrentItem := Result;
|
|
Inc(FCount);
|
|
end;
|
|
|
|
function TEDIObjectList.FindItemByName(Name: string;
|
|
StartItem: TEDIObjectListItem): TEDIObjectListItem;
|
|
var
|
|
ListItem: TEDIObjectListItem;
|
|
begin
|
|
Result := nil;
|
|
if StartItem <> nil then
|
|
ListItem := StartItem
|
|
else
|
|
ListItem := First;
|
|
while ListItem <> nil do
|
|
begin
|
|
if ListItem.Name = Name then
|
|
begin
|
|
Result := ListItem;
|
|
Break;
|
|
end;
|
|
ListItem := Next;
|
|
end;
|
|
end;
|
|
|
|
procedure TEDIObjectList.Insert(InsertIndex: Integer; EDIObject: TEDIObject);
|
|
var
|
|
ListItem: TEDIObjectListItem;
|
|
begin
|
|
FCurrentItem := GetItem(InsertIndex);
|
|
if FCurrentItem <> nil then
|
|
begin
|
|
//Link new item
|
|
ListItem := CreateListItem(FCurrentItem.PriorItem);
|
|
ListItem.NextItem := FCurrentItem;
|
|
ListItem.EDIObject := EDIObject;
|
|
//Relink current item
|
|
if FCurrentItem.PriorItem <> nil then
|
|
FCurrentItem.PriorItem.NextItem := ListItem
|
|
else
|
|
FFirstItem := ListItem;
|
|
FCurrentItem.PriorItem := ListItem;
|
|
//
|
|
FCurrentItem := ListItem;
|
|
Inc(FCount);
|
|
// Update the indexes starting at the current item.
|
|
if loAutoUpdateIndexes in FOptions then
|
|
UpdateIndexes(FCurrentItem); //Pass nil to force update of all items
|
|
end
|
|
else
|
|
Add(EDIObject);
|
|
end;
|
|
|
|
function TEDIObjectList.GetItem(Index: Integer): TEDIObjectListItem;
|
|
var
|
|
I: Integer;
|
|
ListItem: TEDIObjectListItem;
|
|
begin
|
|
Result := nil;
|
|
if FCurrentItem <> nil then // Attempt to search from the current item.
|
|
begin
|
|
if Index = FCurrentItem.ItemIndex then // The index already points to the current item.
|
|
Result := FCurrentItem
|
|
else
|
|
if Index > FCurrentItem.ItemIndex then // Search forward in the list.
|
|
begin
|
|
I := FCurrentItem.ItemIndex - 1;
|
|
ListItem := FCurrentItem;
|
|
while ListItem <> nil do
|
|
begin
|
|
Inc(I);
|
|
if I = Index then
|
|
begin
|
|
Result := ListItem;
|
|
Break;
|
|
end;
|
|
ListItem := ListItem.NextItem;
|
|
end;
|
|
FCurrentItem := Result;
|
|
end
|
|
else // if Index < FCurrentItem.ItemIndex then // Search backward in the list.
|
|
begin
|
|
I := FCurrentItem.ItemIndex + 1;
|
|
ListItem := FCurrentItem;
|
|
while ListItem <> nil do
|
|
begin
|
|
Dec(I);
|
|
if I = Index then
|
|
begin
|
|
Result := ListItem;
|
|
Break;
|
|
end;
|
|
ListItem := ListItem.PriorItem;
|
|
end;
|
|
FCurrentItem := Result;
|
|
end;
|
|
end
|
|
else // No current item was assigned so search from the beginning of the structure.
|
|
begin
|
|
I := -1;
|
|
FCurrentItem := FFirstItem;
|
|
ListItem := FFirstItem;
|
|
while ListItem <> nil do
|
|
begin
|
|
Inc(I);
|
|
if I = Index then
|
|
begin
|
|
Result := ListItem;
|
|
Break;
|
|
end;
|
|
ListItem := ListItem.NextItem;
|
|
end;
|
|
FCurrentItem := Result;
|
|
end;
|
|
end;
|
|
|
|
procedure TEDIObjectList.Delete(Index: Integer);
|
|
var
|
|
ListItem: TEDIObjectListItem;
|
|
begin
|
|
ListItem := GetItem(Index);
|
|
if ListItem <> nil then
|
|
begin
|
|
Remove(ListItem);
|
|
// Update the indexes starting at the current item.
|
|
if loAutoUpdateIndexes in FOptions then
|
|
UpdateIndexes(FCurrentItem.PriorItem); //Pass nil to force update of all items
|
|
end;
|
|
end;
|
|
|
|
procedure TEDIObjectList.Delete(EDIObject: TEDIObject);
|
|
begin
|
|
Remove(EDIObject);
|
|
// Update the indexes starting at the current item.
|
|
if loAutoUpdateIndexes in FOptions then
|
|
UpdateIndexes(nil); //Pass nil to force update of all items
|
|
end;
|
|
|
|
procedure TEDIObjectList.UpdateIndexes(StartItem: TEDIObjectListItem = nil);
|
|
var
|
|
I: Integer;
|
|
ListItem: TEDIObjectListItem;
|
|
begin
|
|
if StartItem <> nil then
|
|
begin
|
|
ListItem := StartItem;
|
|
I := StartItem.ItemIndex - 1;
|
|
end
|
|
else
|
|
begin
|
|
ListItem := FFirstItem;
|
|
I := -1;
|
|
end;
|
|
while ListItem <> nil do
|
|
begin
|
|
Inc(I);
|
|
ListItem.ItemIndex := I;
|
|
ListItem := ListItem.NextItem;
|
|
end;
|
|
end;
|
|
|
|
procedure TEDIObjectList.UpdateCount;
|
|
var
|
|
ListItem: TEDIObjectListItem;
|
|
begin
|
|
FCount := 0;
|
|
ListItem := FFirstItem;
|
|
while ListItem <> nil do
|
|
begin
|
|
ListItem := ListItem.NextItem;
|
|
Inc(FCount);
|
|
end;
|
|
end;
|
|
|
|
procedure TEDIObjectList.Remove(EDIObject: TEDIObject);
|
|
var
|
|
ListItem: TEDIObjectListItem;
|
|
begin
|
|
ListItem := Find(EDIObject);
|
|
if ListItem <> nil then
|
|
begin
|
|
// Remove the item from the list
|
|
ListItem := Extract(ListItem);
|
|
// Free the list item
|
|
FreeAndNil(ListItem);
|
|
end;
|
|
end;
|
|
|
|
function TEDIObjectList.Extract(EDIObject: TEDIObject): TEDIObject;
|
|
var
|
|
ListItem: TEDIObjectListItem;
|
|
begin
|
|
Result := nil;
|
|
ListItem := Find(EDIObject);
|
|
if ListItem <> nil then
|
|
begin
|
|
// Extract the EDI Data Object
|
|
Result := ListItem.EDIObject;
|
|
ListItem.EDIObject := nil;
|
|
// Remove the item from the list
|
|
ListItem := Extract(ListItem);
|
|
// Free the list item
|
|
FreeAndNil(ListItem);
|
|
end;
|
|
end;
|
|
|
|
function TEDIObjectList.IndexOf(EDIObject: TEDIObject): Integer;
|
|
var
|
|
I: Integer;
|
|
ListItem: TEDIObjectListItem;
|
|
begin
|
|
Result := -1;
|
|
I := 0;
|
|
ListItem := FFirstItem;
|
|
while ListItem <> nil do
|
|
begin
|
|
if ListItem.EDIObject = EDIObject then
|
|
begin
|
|
FCurrentItem := ListItem;
|
|
FCurrentItem.ItemIndex := I;
|
|
Result := I;
|
|
Break;
|
|
end;
|
|
ListItem := ListItem.NextItem;
|
|
Inc(I);
|
|
end;
|
|
end;
|
|
|
|
function TEDIObjectList.GetEDIObject(Index: Integer): TEDIObject;
|
|
var
|
|
ListItem: TEDIObjectListItem;
|
|
begin
|
|
Result := nil;
|
|
ListItem := GetItem(Index);
|
|
if ListItem <> nil then
|
|
Result := ListItem.EDIObject;
|
|
end;
|
|
|
|
procedure TEDIObjectList.SetEDIObject(Index: Integer; const Value: TEDIObject);
|
|
var
|
|
ListItem: TEDIObjectListItem;
|
|
begin
|
|
ListItem := GetItem(Index);
|
|
if ListItem <> nil then
|
|
ListItem.EDIObject := Value;
|
|
end;
|
|
|
|
function TEDIObjectList.ReturnListItemsByName(Name: string): TEDIObjectList;
|
|
var
|
|
ListItem: TEDIObjectListItem;
|
|
begin
|
|
Result := TEDIObjectList.Create(False);
|
|
ListItem := First;
|
|
while ListItem <> nil do
|
|
begin
|
|
if ListItem.Name = Name then
|
|
Result.Add(ListItem.EDIObject, ListItem.Name);
|
|
ListItem := Next;
|
|
end; //while
|
|
end;
|
|
|
|
function TEDIObjectList.IndexOf(Item: TEDIObjectListItem): Integer;
|
|
var
|
|
I: Integer;
|
|
ListItem: TEDIObjectListItem;
|
|
begin
|
|
Result := -1;
|
|
I := 0;
|
|
ListItem := FFirstItem;
|
|
while ListItem <> nil do
|
|
begin
|
|
if ListItem = Item then
|
|
begin
|
|
FCurrentItem := ListItem;
|
|
FCurrentItem.ItemIndex := I;
|
|
Result := I;
|
|
Break;
|
|
end;
|
|
ListItem := ListItem.NextItem;
|
|
Inc(I);
|
|
end;
|
|
end;
|
|
|
|
procedure TEDIObjectList.Remove(Item: TEDIObjectListItem);
|
|
begin
|
|
// Remove the item from the list
|
|
Item := Extract(Item);
|
|
// Free the list item
|
|
FreeAndNil(Item);
|
|
end;
|
|
|
|
function TEDIObjectList.Extract(Item: TEDIObjectListItem): TEDIObjectListItem;
|
|
begin
|
|
Result := Item;
|
|
// Set current item
|
|
if Item.NextItem <> nil then
|
|
FCurrentItem := Item.NextItem
|
|
else
|
|
FCurrentItem := Item.PriorItem;
|
|
// Extract the item and relink existing items.
|
|
if Item.NextItem <> nil then
|
|
Item.NextItem.PriorItem := Item.PriorItem;
|
|
if Item.PriorItem <> nil then
|
|
Item.PriorItem.NextItem := Item.NextItem;
|
|
if Item = FFirstItem then
|
|
FFirstItem := Item.NextItem;
|
|
if Item = FLastItem then
|
|
FLastItem := Item.PriorItem;
|
|
// Update the count
|
|
Dec(FCount);
|
|
end;
|
|
|
|
procedure TEDIObjectList.Add(Item: TEDIObjectListItem; Name: string);
|
|
begin
|
|
Item.Parent := Self;
|
|
Item.Name := Name;
|
|
Item.NextItem := nil;
|
|
Item.PriorItem := nil;
|
|
if FLastItem <> nil then
|
|
begin
|
|
Item.PriorItem := FLastItem;
|
|
FLastItem.NextItem := Item;
|
|
end;
|
|
if FFirstItem = nil then
|
|
FFirstItem := Item;
|
|
FLastItem := Item;
|
|
FCurrentItem := Item;
|
|
Inc(FCount);
|
|
end;
|
|
|
|
function TEDIObjectList.FindEDIObject(EDIObject: TEDIObject): TEDIObject;
|
|
var
|
|
ListItem: TEDIObjectListItem;
|
|
begin
|
|
Result := nil;
|
|
ListItem := FFirstItem;
|
|
while ListItem <> nil do
|
|
begin
|
|
if ListItem.EDIObject = EDIObject then
|
|
begin
|
|
FCurrentItem := ListItem;
|
|
Result := ListItem.EDIObject;
|
|
Break;
|
|
end;
|
|
ListItem := ListItem.NextItem;
|
|
end;
|
|
end;
|
|
|
|
function TEDIObjectList.Find(Item: TEDIObjectListItem): TEDIObjectListItem;
|
|
var
|
|
ListItem: TEDIObjectListItem;
|
|
begin
|
|
Result := nil;
|
|
ListItem := FFirstItem;
|
|
while ListItem <> nil do
|
|
begin
|
|
if ListItem = Item then
|
|
begin
|
|
FCurrentItem := ListItem;
|
|
Result := ListItem;
|
|
Break;
|
|
end;
|
|
ListItem := ListItem.NextItem;
|
|
end;
|
|
end;
|
|
|
|
function TEDIObjectList.Find(EDIObject: TEDIObject): TEDIObjectListItem;
|
|
var
|
|
ListItem: TEDIObjectListItem;
|
|
begin
|
|
Result := nil;
|
|
ListItem := FFirstItem;
|
|
while ListItem <> nil do
|
|
begin
|
|
if ListItem.EDIObject = EDIObject then
|
|
begin
|
|
FCurrentItem := ListItem;
|
|
Result := ListItem;
|
|
Break;
|
|
end;
|
|
ListItem := ListItem.NextItem;
|
|
end;
|
|
end;
|
|
|
|
function TEDIObjectList.IndexIsValid(Index: Integer): Boolean;
|
|
begin
|
|
Result := False;
|
|
if (FCount > 0) and (Index >= 0) and (Index <= FCount - 1) then
|
|
Result := True;
|
|
end;
|
|
|
|
function TEDIObjectList.Insert(Item, BeforeItem: TEDIObjectListItem): TEDIObjectListItem;
|
|
begin
|
|
Result := Item;
|
|
if Result = nil then
|
|
Result := CreateListItem(BeforeItem, nil);
|
|
Result.Parent := Self;
|
|
Result.PriorItem := nil;
|
|
Result.NextItem := nil;
|
|
if BeforeItem <> nil then // Insert item
|
|
begin
|
|
Result.PriorItem := BeforeItem.PriorItem;
|
|
BeforeItem.PriorItem := Result;
|
|
if Result.PriorItem <> nil then
|
|
Result.PriorItem.NextItem := Result;
|
|
Result.NextItem := BeforeItem;
|
|
end
|
|
else
|
|
if FFirstItem <> nil then // Insert as first item
|
|
begin
|
|
FFirstItem.PriorItem := Result;
|
|
Result.NextItem := FFirstItem;
|
|
FFirstItem := Result;
|
|
end
|
|
else
|
|
Add(Result); // Add as first item
|
|
FCurrentItem := Result;
|
|
Inc(FCount);
|
|
end;
|
|
|
|
function TEDIObjectList.Insert(EDIObject, BeforeEDIObject: TEDIObject): TEDIObjectListItem;
|
|
var
|
|
BeforeItem: TEDIObjectListItem;
|
|
begin
|
|
BeforeItem := Find(BeforeEDIObject);
|
|
Result := CreateListItem(BeforeItem, EDIObject);
|
|
Insert(Result, BeforeItem);
|
|
end;
|
|
|
|
function TEDIObjectList.Insert(BeforeItem: TEDIObjectListItem): TEDIObjectListItem;
|
|
begin
|
|
Result := CreateListItem(BeforeItem, nil);
|
|
Insert(Result, BeforeItem);
|
|
end;
|
|
|
|
function TEDIObjectList.Insert(BeforeEDIObject: TEDIObject): TEDIObjectListItem;
|
|
begin
|
|
Result := Insert(nil, BeforeEDIObject);
|
|
end;
|
|
|
|
//=== { TEDIDataObjectListItem } =============================================
|
|
|
|
function TEDIDataObjectListItem.GetEDIDataObject: TEDIDataObject;
|
|
begin
|
|
Result := TEDIDataObject(FEDIObject);
|
|
end;
|
|
|
|
procedure TEDIDataObjectListItem.SetEDIDataObject(const Value: TEDIDataObject);
|
|
begin
|
|
FEDIObject := Value;
|
|
end;
|
|
|
|
//=== { TEDIDataObjectList } =================================================
|
|
|
|
function TEDIDataObjectList.CreateListItem(PriorItem: TEDIObjectListItem;
|
|
EDIObject: TEDIObject): TEDIObjectListItem;
|
|
begin
|
|
Result := TEDIDataObjectListItem.Create(Self, PriorItem, EDIObject);
|
|
end;
|
|
|
|
function TEDIDataObjectList.GetEDIDataObject(Index: Integer): TEDIDataObject;
|
|
begin
|
|
Result := TEDIDataObject(GetEDIObject(Index));
|
|
end;
|
|
|
|
procedure TEDIDataObjectList.SetEDIDataObject(Index: Integer; const Value: TEDIDataObject);
|
|
begin
|
|
SetEDIObject(Index, Value);
|
|
end;
|
|
|
|
function TEDIObjectList.CreateListItem(PriorItem: TEDIObjectListItem;
|
|
EDIObject: TEDIObject = nil): TEDIObjectListItem;
|
|
begin
|
|
Result := TEDIObjectListItem.Create(Self, PriorItem, EDIObject);
|
|
end;
|
|
|
|
//=== { TEDILoopStack } ======================================================
|
|
|
|
constructor TEDILoopStack.Create;
|
|
begin
|
|
inherited Create;
|
|
SetLength(FStack, 0);
|
|
FFlags := [];
|
|
end;
|
|
|
|
destructor TEDILoopStack.Destroy;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := Low(FStack) to High(FStack) do
|
|
FStack[I].EDIObject := nil;
|
|
SetLength(FStack, 0);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TEDILoopStack.Debug: string;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := 'Loop Stack' + AnsiLineBreak;
|
|
for I := 0 to High(FStack) do
|
|
Result := Result + FStack[I].SegmentId + ', ' +
|
|
FStack[I].OwnerLoopId + ', ' +
|
|
FStack[I].ParentLoopId + ', ' +
|
|
IntToStr(FStack[I].SpecStartIndex) + AnsiLineBreak;
|
|
end;
|
|
|
|
procedure TEDILoopStack.DoAddLoop(StackRecord: TEDILoopStackRecord;
|
|
SegmentId, OwnerLoopId, ParentLoopId: string; var EDIObject: TEDIObject);
|
|
begin
|
|
if Assigned(FOnAddLoop) then
|
|
FOnAddLoop(StackRecord, SegmentId, OwnerLoopId, ParentLoopId, EDIObject);
|
|
end;
|
|
|
|
function TEDILoopStack.GetSafeStackIndex(Index: Integer): Integer;
|
|
begin
|
|
if Length(FStack) > 0 then
|
|
begin
|
|
if Index >= Low(FStack) then
|
|
begin
|
|
if Index <= High(FStack) then
|
|
Result := Index
|
|
else
|
|
Result := High(FStack);
|
|
end
|
|
else
|
|
Result := Low(FStack);
|
|
end
|
|
else
|
|
{$IFNDEF CLR}
|
|
raise EJclEDIError.CreateResFmt(@RsEDIError057, [IntToStr(Index)]);
|
|
{$ELSE}
|
|
raise EJclEDIError.CreateFmt(RsEDIError057, [IntToStr(Index)]);
|
|
{$ENDIF ~CLR}
|
|
end;
|
|
|
|
function TEDILoopStack.GetSize: Integer;
|
|
begin
|
|
Result := Length(FStack);
|
|
end;
|
|
|
|
function TEDILoopStack.Peek: TEDILoopStackRecord;
|
|
begin
|
|
Result := FStack[High(FStack)];
|
|
end;
|
|
|
|
function TEDILoopStack.Peek(Index: Integer): TEDILoopStackRecord;
|
|
begin
|
|
if Length(FStack) > 0 then
|
|
if Index >= Low(FStack) then
|
|
if Index <= High(FStack) then
|
|
Result := FStack[Index]
|
|
else
|
|
raise EJclEDIError.CreateFmt(RsEDIError054, [IntToStr(Index)])
|
|
else
|
|
raise EJclEDIError.CreateFmt(RsEDIError055, [IntToStr(Index)])
|
|
else
|
|
raise EJclEDIError.CreateFmt(RsEDIError056, [IntToStr(Index)]);
|
|
end;
|
|
|
|
procedure TEDILoopStack.Pop(Index: Integer);
|
|
begin
|
|
// Resize loop stack if the index is less than the length
|
|
if (Index >= 0) and (Index < Length(FStack)) then
|
|
begin
|
|
SetLength(FStack, Index);
|
|
FFlags := FFlags + [ediStackResized];
|
|
end;
|
|
end;
|
|
|
|
function TEDILoopStack.Push(SegmentId, OwnerLoopId, ParentLoopId: string; StartIndex: Integer;
|
|
EDIObject: TEDIObject): Integer;
|
|
begin
|
|
// Add to loop stack
|
|
SetLength(FStack, Length(FStack) + 1);
|
|
UpdateStackData(SegmentId, OwnerLoopId, ParentLoopId, StartIndex, EDIObject);
|
|
Result := High(FStack);
|
|
end;
|
|
|
|
function TEDILoopStack.SetStackPointer(OwnerLoopId,
|
|
ParentLoopId: string): Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FFlags := FFlags - [ediStackResized];
|
|
FFlags := FFlags - [ediAltStackPointer];
|
|
Result := -1; // Entry not found
|
|
// Find the loop in the stack
|
|
for I := High(FStack) downto 0 do
|
|
begin
|
|
if (OwnerLoopId = FStack[I].OwnerLoopId) and
|
|
(ParentLoopId = FStack[I].ParentLoopId) then
|
|
begin
|
|
Result := I;
|
|
// Pop entries from the stack starting at the index after the found loop
|
|
Pop(I + 1);
|
|
Break;
|
|
end;
|
|
end;
|
|
// Check if an exact entry was found
|
|
if Result = -1 then
|
|
begin
|
|
// Find the parent loop in the stack
|
|
for I := High(FStack) downto 0 do
|
|
begin
|
|
if (ParentLoopId = FStack[I].ParentLoopId) and
|
|
(FStack[I].OwnerLoopId <> NA_LoopId) then
|
|
begin
|
|
FFlags := FFlags + [ediAltStackPointer];
|
|
Result := GetSafeStackIndex(I);
|
|
// Pop entries from the stack starting at the index after the found loop
|
|
Pop(I + 1);
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TEDILoopStack.UpdateStackData(SegmentId, OwnerLoopId, ParentLoopId: string;
|
|
StartIndex: Integer; EDIObject: TEDIObject);
|
|
begin
|
|
FStack[High(FStack)].SegmentId := SegmentId;
|
|
FStack[High(FStack)].OwnerLoopId := OwnerLoopId;
|
|
FStack[High(FStack)].ParentLoopId := ParentLoopId;
|
|
FStack[High(FStack)].SpecStartIndex := StartIndex;
|
|
FStack[High(FStack)].EDIObject := EDIObject;
|
|
end;
|
|
|
|
procedure TEDILoopStack.UpdateStackObject(EDIObject: TEDIObject);
|
|
begin
|
|
FStack[High(FStack)].EDIObject := EDIObject;
|
|
end;
|
|
|
|
function TEDILoopStack.ValidateLoopStack(SegmentId, OwnerLoopId, ParentLoopId: string;
|
|
StartIndex: Integer; EDIObject: TEDIObject): TEDILoopStackRecord;
|
|
var
|
|
I: Integer;
|
|
StackRecord: TEDILoopStackRecord;
|
|
begin
|
|
if Length(FStack) <= 0 then
|
|
// Add entry to stack
|
|
Push(SegmentId, OwnerLoopId, ParentLoopId, StartIndex, EDIObject)
|
|
else
|
|
begin
|
|
I := SetStackPointer(OwnerLoopId, ParentLoopId);
|
|
if I >= 0 then // Entry found
|
|
begin
|
|
if ediLoopRepeated in FFlags then
|
|
begin
|
|
// Get the previous stack record so the repeated loop will not be nested
|
|
StackRecord := Peek(I-1);
|
|
// In event handler add loop to external data structure since it repeated
|
|
// See JclEDI_ANSIX12.TEDITransactionSetDocument class for implementation example.
|
|
DoAddLoop(StackRecord, SegmentId, OwnerLoopId, ParentLoopId, EDIObject);
|
|
// Update stack object only
|
|
UpdateStackObject(EDIObject);
|
|
// Debug
|
|
// ShowMessage('LoopRepeated');
|
|
end
|
|
else
|
|
if ediAltStackPointer in FFlags then
|
|
begin
|
|
// Get the previous stack record because the loop
|
|
// is not to be nested at the current stack pointer
|
|
StackRecord := Peek(I-1);
|
|
// In event handler add loop to external data structure since it is new
|
|
// See JclEDI_ANSIX12.TEDITransactionSetDocument class for implementation example.
|
|
DoAddLoop(StackRecord, SegmentId, OwnerLoopId, ParentLoopId, EDIObject);
|
|
// Update stack entry
|
|
UpdateStackData(SegmentId, OwnerLoopId, ParentLoopId, StartIndex, EDIObject);
|
|
// Debug
|
|
// ShowMessage('AltStackPointer');
|
|
end
|
|
else
|
|
if ediStackResized in FFlags then
|
|
begin
|
|
// Debug
|
|
// ShowMessage('Stack Size Decreased');
|
|
end
|
|
else
|
|
begin
|
|
// Segment is part of loop
|
|
end;
|
|
end
|
|
else
|
|
if I = -1 then // Entry not found.
|
|
begin
|
|
// In event handler add loop since it is new
|
|
StackRecord := Peek;
|
|
// In event handler add loop to external data structure since it is new
|
|
DoAddLoop(StackRecord, SegmentId, OwnerLoopId, ParentLoopId, EDIObject);
|
|
// Add entry to stack
|
|
Push(SegmentId, OwnerLoopId, ParentLoopId, StartIndex, EDIObject);
|
|
// Debug
|
|
// ShowMessage('Stack Size Increased');
|
|
end;
|
|
end;
|
|
Result := Peek;
|
|
end;
|
|
|
|
end.
|