{**************************************************************************************************} { } { 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_UNEDIFACT.pas. } { } { The Initial Developer of the Original Code is Raymond Alexander. } { Portions created by Raymond Alexander are Copyright (C) Raymond Alexander. All rights reserved. } { } { Contributor(s): } { Raymond Alexander (rayspostbox3), Robert Marquardt, Robert Rossmair, Petr Vones } { } {**************************************************************************************************} { } { Contains classes to easily 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: May 22, 2003 } { 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_UNEDIFACT.pas,v 1.16 2005/03/08 16:10:08 marquardt Exp $ unit JclEDI_UNEDIFACT; {$I jcl.inc} {$IFDEF SUPPORTS_WEAKPACKAGEUNIT} {$WEAKPACKAGEUNIT ON} {$ENDIF SUPPORTS_WEAKPACKAGEUNIT} // (Default) Enable the following directive to use the optimized JclEDI.StringReplace function. {$DEFINE OPTIMIZED_STRINGREPLACE} interface uses SysUtils, Classes, JclEDI; const // UN/EDIFACT Segment Id's UNASegmentId = 'UNA'; // Service String Advice Segment Id UNBSegmentId = 'UNB'; // Interchange Control Header Segment Id UNZSegmentId = 'UNZ'; // Interchange Control Trailer Segment Id UNGSegmentId = 'UNG'; // Functional Group Header Segment Id UNESegmentId = 'UNE'; // Functional Group Trailer Segment Id UNHSegmentId = 'UNH'; // Message (Transaction Set) Header Segment Id UNTSegmentId = 'UNT'; // Message (Transaction Set) Trailer Segment Id type // EDI Forward Class Declarations TEDIElement = class; TEDICompositeElement = class; TEDISegment = class; TEDIMessage = class; // (Transaction Set) TEDIFunctionalGroup = class; TEDIInterchangeControl = class; TEDIFile = class; // EDI Element TEDIElement = class(TEDIDataObject) public constructor Create(Parent: TEDIDataObject); reintroduce; function Assemble: string; override; procedure Disassemble; override; function GetIndexPositionFromParent: Integer; end; TEDIElementArray = array of TEDIElement; // EDI Composite Element Classes TEDICompositeElement = class(TEDIDataObjectGroup) private function GetElement(Index: Integer): TEDIElement; procedure SetElement(Index: Integer; Element: TEDIElement); protected function InternalCreateElement: TEDIElement; virtual; function InternalAssignDelimiters: TEDIDelimiters; override; function InternalCreateEDIDataObject: TEDIDataObject; override; public constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; destructor Destroy; override; // function AddElement: Integer; function AppendElement(Element: TEDIElement): Integer; function InsertElement(InsertIndex: Integer): Integer; overload; function InsertElement(InsertIndex: Integer; Element: TEDIElement): Integer; overload; procedure DeleteElement(Index: Integer); overload; procedure DeleteElement(Element: TEDIElement); overload; // function AddElements(Count: Integer): Integer; function AppendElements(ElementArray: TEDIElementArray): Integer; function InsertElements(InsertIndex, Count: Integer): Integer; overload; function InsertElements(InsertIndex: Integer; ElementArray: TEDIElementArray): Integer; overload; procedure DeleteElements; overload; procedure DeleteElements(Index, Count: Integer); overload; // function Assemble: string; override; procedure Disassemble; override; // property Element[Index: Integer]: TEDIElement read GetElement write SetElement; default; property Elements: TEDIDataObjectList read FEDIDataObjects; end; TEDICompositeElementArray = array of TEDICompositeElement; // EDI Segment Classes TEDISegment = class(TEDIDataObjectGroup) private FSegmentID: string; //FSegmentIdData: T??? // ToDo: ex: AAA:1:1:2+data1+data2' protected function InternalCreateElement: TEDIElement; virtual; function InternalCreateCompositeElement: TEDICompositeElement; virtual; function InternalAssignDelimiters: TEDIDelimiters; override; function InternalCreateEDIDataObject: TEDIDataObject; override; public constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; destructor Destroy; override; // function AddElement: Integer; function AppendElement(Element: TEDIElement): Integer; function InsertElement(InsertIndex: Integer): Integer; overload; function InsertElement(InsertIndex: Integer; Element: TEDIElement): Integer; overload; procedure DeleteElement(Index: Integer); overload; procedure DeleteElement(Element: TEDIElement); overload; // function AddElements(Count: Integer): Integer; function AppendElements(ElementArray: TEDIElementArray): Integer; function InsertElements(InsertIndex, Count: Integer): Integer; overload; function InsertElements(InsertIndex: Integer; ElementArray: TEDIElementArray): Integer; overload; procedure DeleteElements; overload; procedure DeleteElements(Index, Count: Integer); overload; // function AddCompositeElement: Integer; function AppendCompositeElement(CompositeElement: TEDICompositeElement): Integer; function InsertCompositeElement(InsertIndex: Integer): Integer; overload; function InsertCompositeElement(InsertIndex: Integer; CompositeElement: TEDICompositeElement): Integer; overload; // function AddCompositeElements(Count: Integer): Integer; function AppendCompositeElements(CompositeElementArray: TEDICompositeElementArray): Integer; function InsertCompositeElements(InsertIndex, Count: Integer): Integer; overload; function InsertCompositeElements(InsertIndex: Integer; CompositeElementArray: TEDICompositeElementArray): Integer; overload; // function Assemble: string; override; procedure Disassemble; override; published property SegmentID: string read FSegmentID write FSegmentID; property ElementCount: Integer read GetCount; end; TEDISegmentArray = array of TEDISegment; TEDIMessageSegment = class(TEDISegment) public constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; function InternalAssignDelimiters: TEDIDelimiters; override; end; TEDIFunctionalGroupSegment = class(TEDISegment) public constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; function InternalAssignDelimiters: TEDIDelimiters; override; end; TEDIInterchangeControlSegment = class(TEDISegment) public constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; function InternalAssignDelimiters: TEDIDelimiters; override; end; // EDI Transaction Set Loop TEDIMessageLoop = class(TEDIDataObjectGroup) protected FOwnerLoopId: string; FParentLoopId: string; FParentMessage: TEDIMessage; function InternalAssignDelimiters: TEDIDelimiters; override; function InternalCreateEDIDataObject: TEDIDataObject; override; public constructor Create(Parent: TEDIDataObject); reintroduce; destructor Destroy; override; function Assemble: string; override; procedure Disassemble; override; // // ToDo: More procedures and functions to manage internal structures // function FindLoop(LoopId: string; var StartIndex: Integer): TEDIMessageLoop; function FindSegment(SegmentId: string; var StartIndex: Integer): TEDISegment; overload; function FindSegment(SegmentId: string; var StartIndex: Integer; ElementConditions: TStrings): TEDISegment; overload; // function AddLoop(OwnerLoopId, ParentLoopId: string): Integer; procedure AppendSegment(Segment: TEDISegment); procedure DeleteEDIDataObjects; published property OwnerLoopId: string read FOwnerLoopId write FOwnerLoopId; property ParentLoopId: string read FParentLoopId write FParentLoopId; property ParentMessage: TEDIMessage read FParentMessage write FParentMessage; end; // EDI Message (Transaction Set) TEDIMessage = class(TEDIDataObjectGroup) private FUNHSegment: TEDIMessageSegment; FUNTSegment: TEDIMessageSegment; function GetSegment(Index: Integer): TEDISegment; procedure SetSegment(Index: Integer; Segment: TEDISegment); procedure SetUNHSegment(const UNHSegment: TEDIMessageSegment); procedure SetUNTSegment(const UNTSegment: TEDIMessageSegment); protected procedure InternalCreateHeaderTrailerSegments; virtual; function InternalCreateSegment: TEDISegment; virtual; function InternalAssignDelimiters: TEDIDelimiters; override; function InternalCreateEDIDataObject: TEDIDataObject; override; public constructor Create(Parent: TEDIDataObject; SegmentCount: Integer = 0); reintroduce; destructor Destroy; override; function AddSegment: Integer; function AppendSegment(Segment: TEDISegment): Integer; function InsertSegment(InsertIndex: Integer): Integer; overload; function InsertSegment(InsertIndex: Integer; Segment: TEDISegment): Integer; overload; procedure DeleteSegment(Index: Integer); overload; procedure DeleteSegment(Segment: TEDISegment); overload; function AddSegments(Count: Integer): Integer; function AppendSegments(SegmentArray: TEDISegmentArray): Integer; function InsertSegments(InsertIndex, Count: Integer): Integer; overload; function InsertSegments(InsertIndex: Integer; SegmentArray: TEDISegmentArray): Integer; overload; procedure DeleteSegments; overload; procedure DeleteSegments(Index, Count: Integer); overload; function Assemble: string; override; procedure Disassemble; override; property Segment[Index: Integer]: TEDISegment read GetSegment write SetSegment; default; property Segments: TEDIDataObjectList read FEDIDataObjects; published property SegmentUNH: TEDIMessageSegment read FUNHSegment write SetUNHSegment; property SegmentUNT: TEDIMessageSegment read FUNTSegment write SetUNTSegment; property SegmentCount: Integer read GetCount; end; TEDIMessageArray = array of TEDIMessage; // EDI Functional Group TEDIFunctionalGroup = class(TEDIDataObjectGroup) private FUNGSegment: TEDIFunctionalGroupSegment; FUNESegment: TEDIFunctionalGroupSegment; function GetMessage(Index: Integer): TEDIMessage; procedure SetMessage(Index: Integer; Message: TEDIMessage); procedure SetUNGSegment(const UNGSegment: TEDIFunctionalGroupSegment); procedure SetUNESegment(const UNESegment: TEDIFunctionalGroupSegment); protected procedure InternalCreateHeaderTrailerSegments; virtual; function InternalCreateMessage: TEDIMessage; virtual; function InternalAssignDelimiters: TEDIDelimiters; override; function InternalCreateEDIDataObject: TEDIDataObject; override; public constructor Create(Parent: TEDIDataObject; MessageCount: Integer = 0); reintroduce; destructor Destroy; override; function AddMessage: Integer; function AppendMessage(Message: TEDIMessage): Integer; function InsertMessage(InsertIndex: Integer): Integer; overload; function InsertMessage(InsertIndex: Integer; Message: TEDIMessage): Integer; overload; procedure DeleteMessage(Index: Integer); overload; procedure DeleteMessage(Message: TEDIMessage); overload; function AddMessages(Count: Integer): Integer; function AppendMessages(MessageArray: TEDIMessageArray): Integer; function InsertMessages(InsertIndex, Count: Integer): Integer; overload; function InsertMessages(InsertIndex: Integer; MessageArray: TEDIMessageArray): Integer; overload; procedure DeleteMessages; overload; procedure DeleteMessages(Index, Count: Integer); overload; function Assemble: string; override; procedure Disassemble; override; property Message[Index: Integer]: TEDIMessage read GetMessage write SetMessage; default; property Messages: TEDIDataObjectList read FEDIDataObjects; published property SegmentUNG: TEDIFunctionalGroupSegment read FUNGSegment write SetUNGSegment; property SegmentUNE: TEDIFunctionalGroupSegment read FUNESegment write SetUNESegment; property MessageCount: Integer read GetCount; end; TEDIFunctionalGroupArray = array of TEDIFunctionalGroup; // EDI Interchange Control TEDIInterchangeControl = class(TEDIDataObjectGroup) private FUNASegment: TEDIInterchangeControlSegment; FUNBSegment: TEDIInterchangeControlSegment; FUNZSegment: TEDIInterchangeControlSegment; procedure SetUNBSegment(const UNBSegment: TEDIInterchangeControlSegment); procedure SetUNZSegment(const UNZSegment: TEDIInterchangeControlSegment); protected FCreateObjectType: TEDIDataObjectType; procedure InternalCreateHeaderTrailerSegments; virtual; function InternalCreateFunctionalGroup: TEDIFunctionalGroup; virtual; function InternalCreateMessage: TEDIMessage; virtual; function InternalAssignDelimiters: TEDIDelimiters; override; function InternalCreateEDIDataObject: TEDIDataObject; override; public constructor Create(Parent: TEDIDataObject; FunctionalGroupCount: Integer = 0); reintroduce; destructor Destroy; override; function AddFunctionalGroup: Integer; function AppendFunctionalGroup(FunctionalGroup: TEDIFunctionalGroup): Integer; function InsertFunctionalGroup(InsertIndex: Integer): Integer; overload; function InsertFunctionalGroup(InsertIndex: Integer; FunctionalGroup: TEDIFunctionalGroup): Integer; overload; function AddFunctionalGroups(Count: Integer): Integer; function AppendFunctionalGroups(FunctionalGroupArray: TEDIFunctionalGroupArray): Integer; function InsertFunctionalGroups(InsertIndex, Count: Integer): Integer; overload; function InsertFunctionalGroups(InsertIndex: Integer; FunctionalGroupArray: TEDIFunctionalGroupArray): Integer; overload; function AddMessage: Integer; function AppendMessage(Message: TEDIMessage): Integer; function InsertMessage(InsertIndex: Integer): Integer; overload; function InsertMessage(InsertIndex: Integer; Message: TEDIMessage): Integer; overload; function AddMessages(Count: Integer): Integer; function AppendMessages(MessageArray: TEDIMessageArray): Integer; function InsertMessages(InsertIndex, Count: Integer): Integer; overload; function InsertMessages(InsertIndex: Integer; MessageArray: TEDIMessageArray): Integer; overload; function Assemble: string; override; procedure Disassemble; override; published property SegmentUNA: TEDIInterchangeControlSegment read FUNASegment; property SegmentUNB: TEDIInterchangeControlSegment read FUNBSegment write SetUNBSegment; property SegmentUNZ: TEDIInterchangeControlSegment read FUNZSegment write SetUNZSegment; end; TEDIInterchangeControlArray = array of TEDIInterchangeControl; // EDI File TEDIFileOptions = set of (foVariableDelimiterDetection, foRemoveCrLf, foRemoveCr, foRemoveLf, foIgnoreGarbageAtEndOfFile); TEDIFile = class(TEDIDataObjectGroup) private FFileID: Integer; FFileName: string; FEDIFileOptions: TEDIFileOptions; function GetInterchangeControl(Index: Integer): TEDIInterchangeControl; procedure SetInterchangeControl(Index: Integer; Interchange: TEDIInterchangeControl); procedure InternalLoadFromFile; protected procedure InternalDelimitersDetection(StartPos: Integer); virtual; procedure InternalAlternateDelimitersDetection(StartPos: Integer); function InternalCreateInterchangeControl: TEDIInterchangeControl; virtual; function InternalAssignDelimiters: TEDIDelimiters; override; function InternalCreateEDIDataObject: TEDIDataObject; override; public constructor Create(Parent: TEDIDataObject; InterchangeCount: Integer = 0); reintroduce; destructor Destroy; override; procedure LoadFromFile(const FileName: string); procedure ReLoadFromFile; procedure SaveToFile; procedure SaveAsToFile(const FileName: string); function AddInterchange: Integer; function AppendInterchange(Interchange: TEDIInterchangeControl): Integer; function InsertInterchange(InsertIndex: Integer): Integer; overload; function InsertInterchange(InsertIndex: Integer; Interchange: TEDIInterchangeControl): Integer; overload; procedure DeleteInterchange(Index: Integer); overload; procedure DeleteInterchange(Interchange: TEDIInterchangeControl); overload; function AddInterchanges(Count: Integer): Integer; function AppendInterchanges( InterchangeControlArray: TEDIInterchangeControlArray): Integer; function InsertInterchanges(InsertIndex, Count: Integer): Integer; overload; function InsertInterchanges(InsertIndex: Integer; InterchangeControlArray: TEDIInterchangeControlArray): Integer; overload; procedure DeleteInterchanges; overload; procedure DeleteInterchanges(Index, Count: Integer); overload; function Assemble: string; override; procedure Disassemble; override; property Interchange[Index: Integer]: TEDIInterchangeControl read GetInterchangeControl write SetInterchangeControl; default; property Interchanges: TEDIDataObjectList read FEDIDataObjects; published property FileID: Integer read FFileID write FFileID; property FileName: string read FFileName write FFileName; property Options: TEDIFileOptions read FEDIFileOptions write FEDIFileOptions; property InterchangeControlCount: Integer read GetCount; end; TEDIFileArray = array of TEDIFile; implementation uses JclResources, JclStrings; //=== { TEDIElement } ======================================================== constructor TEDIElement.Create(Parent: TEDIDataObject); begin if Assigned(Parent) and ((Parent is TEDISegment) or (Parent is TEDICompositeElement)) then inherited Create(Parent) else inherited Create(nil); FEDIDOT := ediElement; end; function TEDIElement.Assemble: string; begin Result := FData; FState := ediAssembled; end; procedure TEDIElement.Disassemble; begin FState := ediDisassembled; end; function TEDIElement.GetIndexPositionFromParent: Integer; var I: Integer; EDISegment: TEDISegment; EDICompositeElement: TEDICompositeElement; begin Result := -1; if Assigned(Parent) and (Parent is TEDISegment) then begin EDISegment := TEDISegment(Parent); for I := 0 to EDISegment.EDIDataObjectCount - 1 do if EDISegment.EDIDataObjects[I] = Self then begin Result := I; Break; end; end else if Assigned(Parent) and (Parent is TEDICompositeElement) then begin EDICompositeElement := TEDICompositeElement(Parent); for I := 0 to EDICompositeElement.EDIDataObjectCount - 1 do if EDICompositeElement.EDIDataObjects[I] = Self then begin Result := I; Break; end; end; end; //=== { TEDISegment } ======================================================== constructor TEDISegment.Create(Parent: TEDIDataObject; ElementCount: Integer); begin if Assigned(Parent) and (Parent is TEDIMessage) then inherited Create(Parent, ElementCount) else inherited Create(nil, ElementCount); FSegmentID := ''; FEDIDOT := ediSegment; FCreateObjectType := ediElement; //FSegmentIdData := T???.Create(Self); end; destructor TEDISegment.Destroy; begin //FSegmentIdData.Free; inherited Destroy; end; function TEDISegment.AddElements(Count: Integer): Integer; begin FCreateObjectType := ediElement; Result := AddEDIDataObjects(Count); end; function TEDISegment.AddElement: Integer; begin FCreateObjectType := ediElement; Result := AddEDIDataObject; end; function TEDISegment.AppendElement(Element: TEDIElement): Integer; begin Result := AppendEDIDataObject(Element); end; function TEDISegment.AppendElements(ElementArray: TEDIElementArray): Integer; begin Result := AppendEDIDataObjects(TEDIDataObjectArray(ElementArray)); end; function TEDISegment.Assemble: string; var I: Integer; begin FData := ''; FLength := 0; Result := ''; if not Assigned(FDelimiters) then // Attempt to assign the delimiters begin FDelimiters := InternalAssignDelimiters; if not Assigned(FDelimiters) then raise EJclEDIError.CreateRes(@RsEDIError036); end; FData := FSegmentID; if GetCount > 0 then for I := 0 to GetCount - 1 do if Assigned(FEDIDataObjects[I]) then FData := FData + FDelimiters.ED + FEDIDataObjects[I].Assemble else FData := FData + FDelimiters.ED; FData := FData + FDelimiters.SD; FLength := Length(FData); Result := FData; // Return assembled string DeleteElements; FState := ediAssembled; end; procedure TEDISegment.DeleteElement(Index: Integer); begin DeleteEDIDataObject(Index); end; procedure TEDISegment.DeleteElement(Element: TEDIElement); begin DeleteEDIDataObject(Element); end; procedure TEDISegment.DeleteElements(Index, Count: Integer); begin DeleteEDIDataObjects(Index, Count); end; procedure TEDISegment.DeleteElements; begin DeleteEDIDataObjects; end; procedure TEDISegment.Disassemble; var I, StartPos, SearchResult: Integer; ElementData: string; begin // Data Input Scenarios // 4.) SegID+data+data' // Composite Element Data Input Secnarios // 9.) SegID+data+data:data' FSegmentID := ''; DeleteElements; if not Assigned(FDelimiters) then // Attempt to assign the delimiters begin FDelimiters := InternalAssignDelimiters; if not Assigned(FDelimiters) then raise EJclEDIError.CreateRes(@RsEDIError035); end; // Continue StartPos := 1; SearchResult := StrSearch(FDelimiters.ED, FData, StartPos); FSegmentID := Copy(FData, 1, SearchResult - 1); StartPos := SearchResult + 1; SearchResult := StrSearch(FDelimiters.ED, FData, StartPos); while SearchResult <> 0 do begin ElementData := Copy(FData, ((StartPos + FDelimiters.EDLen) - 1), (SearchResult - StartPos)); if StrSearch(FDelimiters.SS, ElementData, 1) <= 0 then I := AddElement else I := AddCompositeElement; if (SearchResult - StartPos) > 0 then // data exists begin FEDIDataObjects[I].Data := ElementData; FEDIDataObjects[I].Disassemble; end; StartPos := SearchResult + 1; SearchResult := StrSearch(FDelimiters.ED, FData, StartPos); end; // Get last element before next segment SearchResult := StrSearch(FDelimiters.SD, FData, StartPos); if SearchResult <> 0 then if (SearchResult - StartPos) > 0 then // data exists begin ElementData := Copy(FData, ((StartPos + FDelimiters.EDLen) - 1), (SearchResult - StartPos)); if StrSearch(FDelimiters.SS, ElementData, 1) <= 0 then I := AddElement else I := AddCompositeElement; FEDIDataObjects[I].Data := ElementData; FEDIDataObjects[I].Disassemble; end; FData := ''; FState := ediDisassembled; end; function TEDISegment.InsertElement(InsertIndex: Integer): Integer; begin FCreateObjectType := ediElement; Result := InsertEDIDataObject(InsertIndex); end; function TEDISegment.InsertElement(InsertIndex: Integer; Element: TEDIElement): Integer; begin Result := InsertEDIDataObject(InsertIndex, Element); end; function TEDISegment.InsertElements(InsertIndex: Integer; ElementArray: TEDIElementArray): Integer; begin Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(ElementArray)); end; function TEDISegment.InsertElements(InsertIndex, Count: Integer): Integer; begin FCreateObjectType := ediElement; Result := InsertEDIDataObjects(InsertIndex, Count); end; function TEDISegment.InternalAssignDelimiters: TEDIDelimiters; begin Result := nil; if not Assigned(FDelimiters) then // Attempt to assign the delimiters begin // Get the delimiters from the Message if Assigned(Parent) and (Parent is TEDIMessage) then begin if Assigned(Parent.Delimiters) then begin Result := Parent.Delimiters; Exit; end; // Get the delimiters from the functional group if Assigned(Parent.Parent) and (Parent.Parent is TEDIFunctionalGroup) then begin if Assigned(Parent.Parent.Delimiters) then begin Result := Parent.Parent.Delimiters; Exit; end; // Get the delimiters from the interchange control header if Assigned(Parent.Parent.Parent) and (Parent.Parent.Parent is TEDIInterchangeControl) then Result := Parent.Parent.Parent.Delimiters; end; end; end; end; function TEDISegment.InternalCreateElement: TEDIElement; begin Result := TEDIElement.Create(Self); end; function TEDISegment.InternalCreateEDIDataObject: TEDIDataObject; begin case FCreateObjectType of ediElement: Result := InternalCreateElement; ediCompositeElement: Result := InternalCreateCompositeElement; else Result := nil; end; end; function TEDISegment.InternalCreateCompositeElement: TEDICompositeElement; begin Result := TEDICompositeElement.Create(Self); end; function TEDISegment.AddCompositeElement: Integer; begin FCreateObjectType := ediCompositeElement; Result := AddEDIDataObject; end; function TEDISegment.AddCompositeElements(Count: Integer): Integer; begin FCreateObjectType := ediCompositeElement; Result := AddEDIDataObjects(Count); end; function TEDISegment.AppendCompositeElement(CompositeElement: TEDICompositeElement): Integer; begin Result := AppendEDIDataObject(CompositeElement); end; function TEDISegment.AppendCompositeElements( CompositeElementArray: TEDICompositeElementArray): Integer; begin Result := AppendEDIDataObjects(TEDIDataObjectArray(CompositeElementArray)); end; function TEDISegment.InsertCompositeElement(InsertIndex: Integer): Integer; begin FCreateObjectType := ediCompositeElement; Result := InsertEDIDataObject(InsertIndex); end; function TEDISegment.InsertCompositeElement(InsertIndex: Integer; CompositeElement: TEDICompositeElement): Integer; begin Result := InsertEDIDataObject(InsertIndex, CompositeElement); end; function TEDISegment.InsertCompositeElements(InsertIndex, Count: Integer): Integer; begin FCreateObjectType := ediCompositeElement; Result := InsertEDIDataObjects(InsertIndex, Count); end; function TEDISegment.InsertCompositeElements(InsertIndex: Integer; CompositeElementArray: TEDICompositeElementArray): Integer; begin Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(CompositeElementArray)); end; //=== { TEDIMessageSegment } ================================================= constructor TEDIMessageSegment.Create(Parent: TEDIDataObject; ElementCount: Integer); begin inherited Create(Parent, ElementCount); if Assigned(Parent) and (Parent is TEDIMessage) then FParent := Parent; end; function TEDIMessageSegment.InternalAssignDelimiters: TEDIDelimiters; begin Result := inherited InternalAssignDelimiters; end; //=== { TEDIFunctionalGroupSegment } ========================================= constructor TEDIFunctionalGroupSegment.Create(Parent: TEDIDataObject; ElementCount: Integer); begin inherited Create(Parent, ElementCount); if Assigned(Parent) and (Parent is TEDIFunctionalGroup) then FParent := Parent; end; function TEDIFunctionalGroupSegment.InternalAssignDelimiters: TEDIDelimiters; begin Result := nil; // Attempt to assign the delimiters if not Assigned(FDelimiters) then begin // Get the delimiters from the functional group if Assigned(Parent) and (Parent is TEDIFunctionalGroup) then begin if Assigned(Parent.Delimiters) then begin Result := Parent.Delimiters; Exit; end; // Get the delimiters from the interchange control if Assigned(Parent.Parent) and (Parent.Parent is TEDIInterchangeControl) then Result := Parent.Parent.Delimiters; end; end; end; //=== { TEDIInterchangeControlSegment } ====================================== constructor TEDIInterchangeControlSegment.Create(Parent: TEDIDataObject; ElementCount: Integer); begin inherited Create(Parent, ElementCount); if Assigned(Parent) and (Parent is TEDIInterchangeControl) then FParent := Parent; end; function TEDIInterchangeControlSegment.InternalAssignDelimiters: TEDIDelimiters; begin Result := nil; // Attempt to assign the delimiters if not Assigned(FDelimiters) then // Get the delimiters from the interchange control if Assigned(Parent) and (Parent is TEDIInterchangeControl) then Result := Parent.Delimiters; end; //=== { TEDIMessage } ======================================================== constructor TEDIMessage.Create(Parent: TEDIDataObject; SegmentCount: Integer); begin if Assigned(Parent) and ((Parent is TEDIFunctionalGroup) or (Parent is TEDIInterchangeControl)) then inherited Create(Parent, SegmentCount) else inherited Create(nil, SegmentCount); FEDIDOT := ediMessage; InternalCreateHeaderTrailerSegments; end; destructor TEDIMessage.Destroy; begin FUNTSegment.Free; FUNHSegment.Free; inherited Destroy; end; function TEDIMessage.AddSegment: Integer; begin Result := AddEDIDataObject; end; function TEDIMessage.AddSegments(Count: Integer): Integer; begin Result := AddEDIDataObjects(Count); end; function TEDIMessage.AppendSegment(Segment: TEDISegment): Integer; begin Result := AppendEDIDataObject(Segment); end; function TEDIMessage.AppendSegments(SegmentArray: TEDISegmentArray): Integer; begin Result := AppendEDIDataObjects(TEDIDataObjectArray(SegmentArray)); end; function TEDIMessage.Assemble: string; var I: Integer; begin FData := ''; FLength := 0; Result := ''; if not Assigned(FDelimiters) then // Attempt to assign the delimiters begin FDelimiters := InternalAssignDelimiters; if not Assigned(FDelimiters) then raise EJclEDIError.CreateRes(@RsEDIError031); end; FData := FUNHSegment.Assemble; FUNHSegment.Data := ''; if GetCount > 0 then for I := 0 to GetCount - 1 do if Assigned(FEDIDataObjects[I]) then FData := FData + FEDIDataObjects[I].Assemble; DeleteSegments; FData := FData + FUNTSegment.Assemble; FUNTSegment.Data := ''; FLength := Length(FData); Result := FData; FState := ediAssembled; end; procedure TEDIMessage.DeleteSegment(Index: Integer); begin DeleteEDIDataObject(Index); end; procedure TEDIMessage.DeleteSegment(Segment: TEDISegment); begin DeleteEDIDataObject(Segment); end; procedure TEDIMessage.DeleteSegments; begin DeleteEDIDataObjects; end; procedure TEDIMessage.DeleteSegments(Index, Count: Integer); begin DeleteEDIDataObjects(Index, Count); end; procedure TEDIMessage.Disassemble; var I, StartPos, SearchResult: Integer; S, S2: string; begin FUNHSegment.Data := ''; FUNHSegment.DeleteElements; FUNTSegment.Data := ''; FUNTSegment.DeleteElements; DeleteSegments; // Check delimiter assignment if not Assigned(FDelimiters) then begin FDelimiters := InternalAssignDelimiters; if not Assigned(FDelimiters) then raise EJclEDIError.CreateRes(@RsEDIError030); end; // Find the first segment StartPos := 1; SearchResult := StrSearch(FDelimiters.SD, FData, StartPos); while SearchResult <> 0 do begin S := Copy(FData, StartPos, Length(UNHSegmentId)); S2 := Copy(FData, StartPos, Length(UNTSegmentId)); if (S <> UNHSegmentId) and (S2 <> UNTSegmentId) then begin I := AddSegment; if (SearchResult - StartPos) > 0 then // data exists begin FEDIDataObjects[I].Data := Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.SDLen)); FEDIDataObjects[I].Disassemble; end; end else if S = UNHSegmentId then begin if (SearchResult - StartPos) > 0 then // data exists begin FUNHSegment.Data := Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.SDLen)); FUNHSegment.Disassemble; end; end else if S2 = UNTSegmentId then begin if (SearchResult - StartPos) > 0 then // data exists begin FUNTSegment.Data := Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.SDLen)); FUNTSegment.Disassemble; end; end; StartPos := SearchResult + FDelimiters.SDLen; SearchResult := StrSearch(FDelimiters.SD, FData, StartPos); end; FData := ''; FState := ediDisassembled; end; function TEDIMessage.GetSegment(Index: Integer): TEDISegment; begin Result := TEDISegment(GetEDIDataObject(Index)); end; function TEDIMessage.InsertSegment(InsertIndex: Integer): Integer; begin Result := InsertEDIDataObject(InsertIndex); end; function TEDIMessage.InsertSegment(InsertIndex: Integer; Segment: TEDISegment): Integer; begin Result := InsertEDIDataObject(InsertIndex, Segment); end; function TEDIMessage.InsertSegments(InsertIndex, Count: Integer): Integer; begin Result := InsertEDIDataObjects(InsertIndex, Count); end; function TEDIMessage.InsertSegments(InsertIndex: Integer; SegmentArray: TEDISegmentArray): Integer; begin Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(SegmentArray)); end; function TEDIMessage.InternalAssignDelimiters: TEDIDelimiters; begin Result := nil; if FDelimiters = nil then // Attempt to assign the delimiters if Assigned(Parent) and ((Parent is TEDIFunctionalGroup) or (Parent is TEDIInterchangeControl)) then if Assigned(Parent.Delimiters) then Result := Parent.Delimiters else if Assigned(Parent.Parent) and (Parent.Parent is TEDIInterchangeControl) then Result := Parent.Parent.Delimiters; end; function TEDIMessage.InternalCreateSegment: TEDISegment; begin Result := TEDISegment.Create(Self); end; procedure TEDIMessage.InternalCreateHeaderTrailerSegments; begin FUNHSegment := TEDIMessageSegment.Create(Self); FUNTSegment := TEDIMessageSegment.Create(Self); end; procedure TEDIMessage.SetSegment(Index: Integer; Segment: TEDISegment); begin SetEDIDataObject(Index, Segment); end; procedure TEDIMessage.SetUNTSegment(const UNTSegment: TEDIMessageSegment); begin FreeAndNil(FUNTSegment); FUNTSegment := UNTSegment; if Assigned(FUNTSegment) then FUNTSegment.Parent := Self; end; procedure TEDIMessage.SetUNHSegment(const UNHSegment: TEDIMessageSegment); begin FreeAndNil(FUNHSegment); FUNHSegment := UNHSegment; if Assigned(FUNHSegment) then FUNHSegment.Parent := Self; end; function TEDIMessage.InternalCreateEDIDataObject: TEDIDataObject; begin Result := InternalCreateSegment; end; //=== { TEDIFunctionalGroup } ================================================ constructor TEDIFunctionalGroup.Create(Parent: TEDIDataObject; MessageCount: Integer); begin if Assigned(Parent) and (Parent is TEDIInterchangeControl) then inherited Create(Parent, MessageCount) else inherited Create(nil, MessageCount); FEDIDOT := ediFunctionalGroup; InternalCreateHeaderTrailerSegments; end; destructor TEDIFunctionalGroup.Destroy; begin FUNGSegment.Free; FUNESegment.Free; inherited Destroy; end; function TEDIFunctionalGroup.AddMessage: Integer; begin Result := AddEDIDataObject; end; function TEDIFunctionalGroup.AddMessages(Count: Integer): Integer; begin Result := AddEDIDataObjects(Count); end; function TEDIFunctionalGroup.AppendMessage(Message: TEDIMessage): Integer; begin Result := AppendEDIDataObject(Message); end; function TEDIFunctionalGroup.AppendMessages( MessageArray: TEDIMessageArray): Integer; begin Result := AppendEDIDataObjects(TEDIDataObjectArray(MessageArray)); end; function TEDIFunctionalGroup.Assemble: string; var I: Integer; begin FData := ''; FLength := 0; Result := ''; if not Assigned(FDelimiters) then // Attempt to assign the delimiters begin FDelimiters := InternalAssignDelimiters; if not Assigned(FDelimiters) then raise EJclEDIError.CreateRes(@RsEDIError020); end; FData := FUNGSegment.Assemble; FUNGSegment.Data := ''; if GetCount > 0 then for I := 0 to GetCount - 1 do if Assigned(FEDIDataObjects[I]) then FData := FData + FEDIDataObjects[I].Assemble; DeleteMessages; FData := FData + FUNESegment.Assemble; FUNESegment.Data := ''; FLength := Length(FData); Result := FData; FState := ediAssembled; end; procedure TEDIFunctionalGroup.DeleteMessage(Index: Integer); begin DeleteEDIDataObject(Index); end; procedure TEDIFunctionalGroup.DeleteMessage(Message: TEDIMessage); begin DeleteEDIDataObject(Message); end; procedure TEDIFunctionalGroup.DeleteMessages; begin DeleteEDIDataObjects; end; procedure TEDIFunctionalGroup.DeleteMessages(Index, Count: Integer); begin DeleteEDIDataObjects(Index, Count); end; procedure TEDIFunctionalGroup.Disassemble; var I, StartPos, SearchResult: Integer; begin FUNGSegment.Data := ''; FUNGSegment.DeleteElements; FUNESegment.Data := ''; FUNESegment.DeleteElements; DeleteMessages; // Check delimiter assignment if not Assigned(FDelimiters) then begin FDelimiters := InternalAssignDelimiters; if not Assigned(FDelimiters) then raise EJclEDIError.CreateRes(@RsEDIError019); end; // Find Functional Group Header Segment StartPos := 1; // Search for Functional Group Header if UNGSegmentId + FDelimiters.ED = Copy(FData, 1, Length(UNGSegmentId + FDelimiters.ED)) then begin // Search for Functional Group Header Segment Terminator SearchResult := StrSearch(FDelimiters.SD, FData, 1); if (SearchResult - StartPos) > 0 then // data exists begin FUNGSegment.Data := Copy(FData, 1, (SearchResult + FDelimiters.SDLen) - 1); FUNGSegment.Disassemble; end else raise EJclEDIError.CreateRes(@RsEDIError021); end else raise EJclEDIError.CreateRes(@RsEDIError022); // Search for Message Header SearchResult := StrSearch(FDelimiters.SD + UNHSegmentId + FDelimiters.ED, FData, StartPos); if SearchResult <= 0 then raise EJclEDIError.CreateRes(@RsEDIError032); // Set next start position StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter // Continue while SearchResult <> 0 do begin // Search for Message Trailer SearchResult := StrSearch(FDelimiters.SD + UNTSegmentId + FDelimiters.ED, FData, StartPos); if SearchResult <> 0 then begin // Set the next start position SearchResult := SearchResult + FDelimiters.SDLen; // Move past the delimiter // Search for the end of Message Trailer SearchResult := StrSearch(FDelimiters.SD, FData, SearchResult); if SearchResult <> 0 then begin I := AddMessage; FEDIDataObjects[I].Data := Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.SDLen)); FEDIDataObjects[I].Disassemble; end else raise EJclEDIError.CreateRes(@RsEDIError033); end else raise EJclEDIError.CreateRes(@RsEDIError034); // Set the next start position StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter // // Verify the next record is a Message Header if (UNHSegmentId + FDelimiters.ED) <> Copy(FData, StartPos, (Length(UNHSegmentId) + FDelimiters.EDLen)) then Break; end; // Set the next start position StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter // Find Functional Group Trailer Segment if (UNESegmentId + FDelimiters.ED) = Copy(FData, StartPos, Length(UNESegmentId + FDelimiters.ED)) then begin // Find Functional Group Trailer Segment Terminator SearchResult := StrSearch(FDelimiters.SD, FData, StartPos + FDelimiters.SDLen); if (SearchResult - StartPos) > 0 then // data exists begin FUNESegment.Data := Copy(FData, StartPos, (SearchResult + FDelimiters.SDLen)); FUNESegment.Disassemble; end else raise EJclEDIError.CreateRes(@RsEDIError023); end else raise EJclEDIError.CreateRes(@RsEDIError024); FData := ''; FState := ediDisassembled; end; function TEDIFunctionalGroup.GetMessage(Index: Integer): TEDIMessage; begin Result := TEDIMessage(GetEDIDataObject(Index)); end; function TEDIFunctionalGroup.InsertMessage(InsertIndex: Integer): Integer; begin Result := InsertEDIDataObject(InsertIndex); end; function TEDIFunctionalGroup.InsertMessage(InsertIndex: Integer; Message: TEDIMessage): Integer; begin Result := InsertEDIDataObject(InsertIndex, Message); end; function TEDIFunctionalGroup.InsertMessages(InsertIndex: Integer; MessageArray: TEDIMessageArray): Integer; begin Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(MessageArray)); end; function TEDIFunctionalGroup.InsertMessages(InsertIndex, Count: Integer): Integer; begin Result := InsertEDIDataObjects(InsertIndex, Count); end; function TEDIFunctionalGroup.InternalAssignDelimiters: TEDIDelimiters; begin Result := nil; // Attempt to assign the delimiters if not Assigned(FDelimiters) then if Assigned(Parent) and (Parent is TEDIInterchangeControl) then Result := Parent.Delimiters; end; function TEDIFunctionalGroup.InternalCreateMessage: TEDIMessage; begin Result := TEDIMessage.Create(Self); end; procedure TEDIFunctionalGroup.InternalCreateHeaderTrailerSegments; begin FUNGSegment := TEDIFunctionalGroupSegment.Create(Self); FUNESegment := TEDIFunctionalGroupSegment.Create(Self); end; procedure TEDIFunctionalGroup.SetMessage(Index: Integer; Message: TEDIMessage); begin SetEDIDataObject(Index, Message); end; procedure TEDIFunctionalGroup.SetUNESegment(const UNESegment: TEDIFunctionalGroupSegment); begin FreeAndNil(FUNESegment); FUNESegment := UNESegment; if Assigned(FUNESegment) then FUNESegment.Parent := Self; end; procedure TEDIFunctionalGroup.SetUNGSegment(const UNGSegment: TEDIFunctionalGroupSegment); begin FreeAndNil(FUNGSegment); FUNGSegment := UNGSegment; if Assigned(FUNGSegment) then FUNGSegment.Parent := Self; end; function TEDIFunctionalGroup.InternalCreateEDIDataObject: TEDIDataObject; begin Result := InternalCreateMessage; end; //=== { TEDIInterchangeControl } ============================================= constructor TEDIInterchangeControl.Create(Parent: TEDIDataObject; FunctionalGroupCount: Integer); begin if Assigned(Parent) and (Parent is TEDIFile) then inherited Create(Parent, FunctionalGroupCount) else inherited Create(nil, FunctionalGroupCount); FEDIDOT := ediInterchangeControl; InternalCreateHeaderTrailerSegments; FCreateObjectType := ediFunctionalGroup; end; destructor TEDIInterchangeControl.Destroy; begin FUNASegment.Free; FUNBSegment.Free; FUNZSegment.Free; FreeAndNil(FDelimiters); inherited Destroy; end; function TEDIInterchangeControl.AddFunctionalGroup: Integer; begin FCreateObjectType := ediFunctionalGroup; Result := AddEDIDataObject; end; function TEDIInterchangeControl.AddFunctionalGroups(Count: Integer): Integer; begin FCreateObjectType := ediFunctionalGroup; Result := AddEDIDataObjects(Count); end; function TEDIInterchangeControl.AppendFunctionalGroup( FunctionalGroup: TEDIFunctionalGroup): Integer; begin FCreateObjectType := ediFunctionalGroup; Result := AppendEDIDataObject(FunctionalGroup); end; function TEDIInterchangeControl.AppendFunctionalGroups( FunctionalGroupArray: TEDIFunctionalGroupArray): Integer; begin Result := AppendEDIDataObjects(TEDIDataObjectArray(FunctionalGroupArray)); end; function TEDIInterchangeControl.Assemble: string; var I: Integer; begin FData := ''; FLength := 0; Result := ''; if not Assigned(FDelimiters) then raise EJclEDIError.CreateRes(@RsEDIError013); FData := FUNBSegment.Assemble; FUNBSegment.Data := ''; if GetCount > 0 then for I := 0 to GetCount - 1 do if Assigned(FEDIDataObjects[I]) then FData := FData + FEDIDataObjects[I].Assemble; DeleteEDIDataObjects; FData := FData + FUNZSegment.Assemble; FUNZSegment.Data := ''; FLength := Length(FData); Result := FData; FState := ediAssembled; end; procedure TEDIInterchangeControl.Disassemble; var I, StartPos, SearchResult: Integer; begin FUNBSegment.Data := ''; FUNBSegment.DeleteElements; FUNZSegment.Data := ''; FUNZSegment.DeleteElements; DeleteEDIDataObjects; if not Assigned(FDelimiters) then raise EJclEDIError.CreateRes(@RsEDIError012); StartPos := 1; // Search for Interchange Control Header if UNBSegmentId + FDelimiters.ED = Copy(FData, 1, Length(UNBSegmentId + FDelimiters.ED)) then begin SearchResult := StrSearch(FDelimiters.SD, FData, StartPos); if (SearchResult - StartPos) > 0 then // data exists begin FUNBSegment.Data := Copy(FData, 1, (SearchResult + FDelimiters.SDLen) - 1); FUNBSegment.Disassemble; end else raise EJclEDIError.CreateRes(@RsEDIError014); end else raise EJclEDIError.CreateRes(@RsEDIError015); // Search for Functional Group Header SearchResult := StrSearch(FDelimiters.SD + UNGSegmentId + FDelimiters.ED, FData, StartPos); if SearchResult > 0 then begin // Set next start positon StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter // Continue while ((StartPos + Length(UNGSegmentId)) < Length(FData)) and (SearchResult > 0) do begin // Search for Functional Group Trailer SearchResult := StrSearch(FDelimiters.SD + UNESegmentId + FDelimiters.ED, FData, StartPos); if SearchResult > 0 then begin // Set next start positon SearchResult := SearchResult + FDelimiters.SDLen; // Move past the delimiter // Search for end of Functional Group Trailer Segment Terminator SearchResult := StrSearch(FDelimiters.SD, FData, SearchResult); if SearchResult > 0 then begin I := AddFunctionalGroup; FEDIDataObjects[I].Data := Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.SDLen)); FEDIDataObjects[I].Disassemble; end else raise EJclEDIError.CreateRes(@RsEDIError023); end else raise EJclEDIError.CreateRes(@RsEDIError024); // Set next start positon StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter // Verify the next record is a Functional Group Header if (UNGSegmentId + FDelimiters.ED) <> Copy(FData, StartPos, (Length(UNGSegmentId) + FDelimiters.EDLen)) then Break; end; end else begin // Search for Message Header SearchResult := StrSearch(FDelimiters.SD + UNHSegmentId + FDelimiters.ED, FData, StartPos); if SearchResult <= 0 then raise EJclEDIError.CreateRes(@RsEDIError032); // Set next start position StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter // Continue while SearchResult <> 0 do begin // Search for Message Trailer SearchResult := StrSearch(FDelimiters.SD + UNTSegmentId + FDelimiters.ED, FData, StartPos); if SearchResult <> 0 then begin // Set the next start position SearchResult := SearchResult + FDelimiters.SDLen; // Move past the delimiter // Search for the end of Message Trailer SearchResult := StrSearch(FDelimiters.SD, FData, SearchResult); if SearchResult <> 0 then begin I := AddMessage; FEDIDataObjects[I].Data := Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.SDLen)); FEDIDataObjects[I].Disassemble; end else raise EJclEDIError.CreateRes(@RsEDIError033); end else raise EJclEDIError.CreateRes(@RsEDIError034); // Set the next start position StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter // Verify the next record is a Message Header if (UNHSegmentId + FDelimiters.ED) <> Copy(FData, StartPos, (Length(UNHSegmentId) + FDelimiters.EDLen)) then Break; end; end; // Verify the next record is a Interchange Control Trailer if (UNZSegmentId + FDelimiters.ED) = Copy(FData, StartPos, Length(UNZSegmentId + FDelimiters.ED)) then begin // Search for the end of Interchange Control Trailer Segment Terminator SearchResult := StrSearch(FDelimiters.SD, FData, StartPos); if (SearchResult - StartPos) > 0 then // data exists begin FUNZSegment.Data := Copy(FData, StartPos, (SearchResult + FDelimiters.SDLen)); FUNZSegment.Disassemble; end else raise EJclEDIError.CreateRes(@RsEDIError016); end else raise EJclEDIError.CreateRes(@RsEDIError017); FData := ''; FState := ediDisassembled; end; function TEDIInterchangeControl.InsertFunctionalGroup(InsertIndex: Integer; FunctionalGroup: TEDIFunctionalGroup): Integer; begin Result := InsertEDIDataObject(InsertIndex, FunctionalGroup); end; function TEDIInterchangeControl.InsertFunctionalGroup(InsertIndex: Integer): Integer; begin FCreateObjectType := ediFunctionalGroup; Result := InsertEDIDataObject(InsertIndex); end; function TEDIInterchangeControl.InsertFunctionalGroups(InsertIndex, Count: Integer): Integer; begin FCreateObjectType := ediFunctionalGroup; Result := InsertEDIDataObjects(InsertIndex, Count); end; function TEDIInterchangeControl.InsertFunctionalGroups(InsertIndex: Integer; FunctionalGroupArray: TEDIFunctionalGroupArray): Integer; begin Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(FunctionalGroupArray)); end; function TEDIInterchangeControl.InternalCreateFunctionalGroup: TEDIFunctionalGroup; begin Result := TEDIFunctionalGroup.Create(Self); end; procedure TEDIInterchangeControl.InternalCreateHeaderTrailerSegments; begin FUNASegment := TEDIInterchangeControlSegment.Create(Self); FUNBSegment := TEDIInterchangeControlSegment.Create(Self); FUNZSegment := TEDIInterchangeControlSegment.Create(Self); end; procedure TEDIInterchangeControl.SetUNZSegment(const UNZSegment: TEDIInterchangeControlSegment); begin FreeAndNil(FUNZSegment); FUNZSegment := UNZSegment; if Assigned(FUNZSegment) then FUNZSegment.Parent := Self; end; procedure TEDIInterchangeControl.SetUNBSegment(const UNBSegment: TEDIInterchangeControlSegment); begin FreeAndNil(FUNBSegment); FUNBSegment := UNBSegment; if Assigned(FUNBSegment) then FUNBSegment.Parent := Self; end; function TEDIInterchangeControl.InternalCreateEDIDataObject: TEDIDataObject; begin case FCreateObjectType of ediFunctionalGroup: Result := InternalCreateFunctionalGroup; ediMessage: Result := InternalCreateMessage; else Result := nil; end; end; function TEDIInterchangeControl.InternalAssignDelimiters: TEDIDelimiters; begin Result := nil; end; function TEDIInterchangeControl.InternalCreateMessage: TEDIMessage; begin Result := TEDIMessage.Create(Self); end; function TEDIInterchangeControl.AddMessage: Integer; begin FCreateObjectType := ediMessage; Result := AddEDIDataObject; end; function TEDIInterchangeControl.AddMessages(Count: Integer): Integer; begin FCreateObjectType := ediMessage; Result := AddEDIDataObjects(Count); end; function TEDIInterchangeControl.AppendMessage(Message: TEDIMessage): Integer; begin FCreateObjectType := ediMessage; Result := AppendEDIDataObject(Message); end; function TEDIInterchangeControl.AppendMessages(MessageArray: TEDIMessageArray): Integer; begin Result := AppendEDIDataObjects(TEDIDataObjectArray(MessageArray)); end; function TEDIInterchangeControl.InsertMessage(InsertIndex: Integer; Message: TEDIMessage): Integer; begin Result := InsertEDIDataObject(InsertIndex, Message); end; function TEDIInterchangeControl.InsertMessage(InsertIndex: Integer): Integer; begin FCreateObjectType := ediMessage; Result := InsertEDIDataObject(InsertIndex); end; function TEDIInterchangeControl.InsertMessages(InsertIndex, Count: Integer): Integer; begin FCreateObjectType := ediMessage; Result := InsertEDIDataObjects(InsertIndex, Count); end; function TEDIInterchangeControl.InsertMessages(InsertIndex: Integer; MessageArray: TEDIMessageArray): Integer; begin Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(MessageArray)); end; //=== { TEDIFile } =========================================================== constructor TEDIFile.Create(Parent: TEDIDataObject; InterchangeCount: Integer); begin if Assigned(Parent) then inherited Create(Parent, InterchangeCount) else inherited Create(nil, InterchangeCount); FEDIFileOptions := [foVariableDelimiterDetection, foRemoveCrLf, foRemoveCr, foRemoveLf]; FEDIDOT := ediFile; end; destructor TEDIFile.Destroy; begin inherited Destroy; end; function TEDIFile.AddInterchange: Integer; begin Result := AddEDIDataObject; end; function TEDIFile.AddInterchanges(Count: Integer): Integer; begin Result := AddEDIDataObjects(Count); end; function TEDIFile.AppendInterchange(Interchange: TEDIInterchangeControl): Integer; begin Result := AppendEDIDataObject(Interchange); end; function TEDIFile.AppendInterchanges(InterchangeControlArray: TEDIInterchangeControlArray): Integer; begin Result := AppendEDIDataObjects(TEDIDataObjectArray(InterchangeControlArray)); end; function TEDIFile.Assemble: string; var I: Integer; EDIInterchangeControl: TEDIInterchangeControl; begin FData := ''; FLength := 0; Result := ''; if GetCount > 0 then for I := 0 to GetCount - 1 do begin if Assigned(FEDIDataObjects[I]) then begin EDIInterchangeControl := TEDIInterchangeControl(FEDIDataObjects[I]); if EDIInterchangeControl.SegmentUNA.EDIDataObjectCount > 0 then begin FData := FData + EDIInterchangeControl.SegmentUNA.Assemble; EDIInterchangeControl.SegmentUNA.Data := ''; end; FData := FData + FEDIDataObjects[I].Assemble; end; FEDIDataObjects[I].Data := ''; end; FLength := Length(FData); Result := FData; DeleteInterchanges; FState := ediAssembled; end; procedure TEDIFile.DeleteInterchange(Index: Integer); begin DeleteEDIDataObject(Index); end; procedure TEDIFile.DeleteInterchanges(Index, Count: Integer); begin DeleteEDIDataObjects(Index, Count); end; procedure TEDIFile.DeleteInterchanges; begin DeleteEDIDataObjects; end; procedure TEDIFile.Disassemble; var I, StartPos, SearchResult: Integer; UNASegmentData: string; begin DeleteInterchanges; if not Assigned(FDelimiters) then begin FDelimiters := InternalAssignDelimiters; FEDIFileOptions := FEDIFileOptions + [foVariableDelimiterDetection]; end; if foRemoveCrLf in FEDIFileOptions then {$IFDEF OPTIMIZED_STRINGREPLACE} FData := JclEDI.StringReplace(FData, AnsiCrLf, '', [rfReplaceAll]); {$ELSE} FData := SysUtils.StringReplace(FData, AnsiCrLf, '', [rfReplaceAll]); {$ENDIF OPTIMIZED_INTERNAL_STRUCTURE} if foRemoveCr in FEDIFileOptions then {$IFDEF OPTIMIZED_STRINGREPLACE} FData := JclEDI.StringReplace(FData, AnsiCarriageReturn, '', [rfReplaceAll]); {$ELSE} FData := SysUtils.StringReplace(FData, AnsiCarriageReturn, '', [rfReplaceAll]); {$ENDIF OPTIMIZED_STRINGREPLACE} if foRemoveLf in FEDIFileOptions then {$IFDEF OPTIMIZED_STRINGREPLACE} FData := JclEDI.StringReplace(FData, AnsiLineFeed, '', [rfReplaceAll]); {$ELSE} FData := SysUtils.StringReplace(FData, AnsiLineFeed, '', [rfReplaceAll]); {$ENDIF OPTIMIZED_STRINGREPLACE} StartPos := 1; if UNASegmentId = Copy(FData, StartPos, Length(UNASegmentId)) then begin if foVariableDelimiterDetection in FEDIFileOptions then InternalDelimitersDetection(StartPos); SearchResult := StrSearch(FDelimiters.SD + UNBSegmentId + FDelimiters.ED, FData, StartPos); UNASegmentData := Copy(FData, StartPos, (SearchResult - StartPos) + FDelimiters.SDLen); StartPos := SearchResult + FDelimiters.SDLen; end else if UNBSegmentId = Copy(FData, StartPos, Length(UNBSegmentId)) then begin if foVariableDelimiterDetection in FEDIFileOptions then InternalAlternateDelimitersDetection(StartPos); end else raise EJclEDIError.CreateRes(@RsEDIError015); // Continue while (StartPos + Length(UNBSegmentId)) < Length(FData) do begin // Search for Interchange Control Trailer SearchResult := StrSearch(FDelimiters.SD + UNZSegmentId + FDelimiters.ED, FData, StartPos); if SearchResult > 0 then begin SearchResult := SearchResult + FDelimiters.SDLen; // Move past the delimiter // Search for the end of Interchange Control Trailer SearchResult := StrSearch(FDelimiters.SD, FData, SearchResult); if SearchResult > 0 then begin I := AddInterchange; FEDIDataObjects[I].Delimiters := TEDIDelimiters.Create(FDelimiters.SD, FDelimiters.ED, FDelimiters.SS); TEDIInterchangeControl(FEDIDataObjects[I]).SegmentUNA.Data := UNASegmentData; TEDIInterchangeControl(FEDIDataObjects[I]).SegmentUNA.Disassemble; FEDIDataObjects[I].Data := Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.SDLen)); FEDIDataObjects[I].Disassemble; end else raise EJclEDIError.CreateRes(@RsEDIError016); end else raise EJclEDIError.CreateRes(@RsEDIError017); // Set next start position, Move past the delimiter StartPos := SearchResult + FDelimiters.SDLen; // if UNASegmentId = Copy(FData, StartPos, Length(UNASegmentId)) then begin if foVariableDelimiterDetection in FEDIFileOptions then InternalDelimitersDetection(StartPos); SearchResult := StrSearch(FDelimiters.SD + UNBSegmentId + FDelimiters.ED, FData, StartPos); UNASegmentData := Copy(FData, StartPos, (SearchResult - StartPos) + FDelimiters.SDLen); StartPos := SearchResult + FDelimiters.SDLen; end else if UNBSegmentId = Copy(FData, StartPos, Length(UNBSegmentId)) then begin if foVariableDelimiterDetection in FEDIFileOptions then InternalAlternateDelimitersDetection(StartPos); end else if (StartPos + Length(UNBSegmentId)) < Length(FData) then begin if foIgnoreGarbageAtEndOfFile in FEDIFileOptions then Break else raise EJclEDIError.CreateRes(@RsEDIError018); end; end; FData := ''; FState := ediDisassembled; end; function TEDIFile.GetInterchangeControl(Index: Integer): TEDIInterchangeControl; begin Result := TEDIInterchangeControl(GetEDIDataObject(Index)); end; function TEDIFile.InsertInterchange(InsertIndex: Integer; Interchange: TEDIInterchangeControl): Integer; begin Result := InsertEDIDataObject(InsertIndex, Interchange); end; function TEDIFile.InsertInterchange(InsertIndex: Integer): Integer; begin Result := InsertEDIDataObject(InsertIndex); end; function TEDIFile.InsertInterchanges(InsertIndex, Count: Integer): Integer; begin Result := InsertEDIDataObjects(InsertIndex, Count); end; function TEDIFile.InsertInterchanges(InsertIndex: Integer; InterchangeControlArray: TEDIInterchangeControlArray): Integer; begin Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(InterchangeControlArray)); end; procedure TEDIFile.InternalLoadFromFile; var EDIFileStream: TFileStream; begin FData := ''; if FFileName <> '' then begin EDIFileStream := TFileStream.Create(FFileName, fmOpenRead or fmShareDenyNone); try SetLength(FData, EDIFileStream.Size); EDIFileStream.Read(Pointer(FData)^, EDIFileStream.Size); finally EDIFileStream.Free; end; end else raise EJclEDIError.CreateRes(@RsEDIError001); end; procedure TEDIFile.LoadFromFile(const FileName: string); begin FFileName := FileName; InternalLoadFromFile; end; procedure TEDIFile.ReLoadFromFile; begin InternalLoadFromFile; end; procedure TEDIFile.SaveAsToFile(const FileName: string); var EDIFileStream: TFileStream; begin FFileName := FileName; if FFileName <> '' then begin EDIFileStream := TFileStream.Create(FFileName, fmCreate or fmShareDenyNone); try EDIFileStream.Write(Pointer(FData)^, Length(FData)); finally EDIFileStream.Free; end; end else raise EJclEDIError.CreateRes(@RsEDIError002); end; procedure TEDIFile.SaveToFile; var EDIFileStream: TFileStream; begin if FFileName <> '' then begin EDIFileStream := TFileStream.Create(FFileName, fmCreate or fmShareDenyNone); try EDIFileStream.Write(Pointer(FData)^, Length(FData)); finally EDIFileStream.Free; end; end else raise EJclEDIError.CreateRes(@RsEDIError002); end; procedure TEDIFile.SetInterchangeControl(Index: Integer; Interchange: TEDIInterchangeControl); begin SetEDIDataObject(Index, Interchange); end; procedure TEDIFile.InternalDelimitersDetection(StartPos: Integer); begin FDelimiters.SS := Copy(FData, StartPos + Length(UNASegmentId), 1); FDelimiters.ED := Copy(FData, StartPos + Length(UNASegmentId) + 1, 1); if Copy(FData, StartPos + Length(UNASegmentId) + 5, 2) = AnsiCrLf then FDelimiters.SD := Copy(FData, StartPos + Length(UNASegmentId) + 5, 2) else FDelimiters.SD := Copy(FData, StartPos + Length(UNASegmentId) + 5, 1); end; procedure TEDIFile.InternalAlternateDelimitersDetection(StartPos: Integer); var SearchResult, I: Integer; Delimiter: string; begin SearchResult := 1; FDelimiters.ED := Copy(FData, StartPos + Length(UNBSegmentId), 1); SearchResult := StrSearch(UNGSegmentId + FDelimiters.ED, FData, SearchResult); if SearchResult <= 0 then SearchResult := StrSearch(UNHSegmentId + FDelimiters.ED, FData, 1); if Copy(FData, SearchResult - 2, 2) = AnsiCrLf then FDelimiters.SD := Copy(FData, SearchResult - 2, 2) else FDelimiters.SD := Copy(FData, SearchResult - 1, 1); SearchResult := SearchResult - 2; for I := SearchResult downto 1 do begin Delimiter := Copy(FData, I, 1); if not (Delimiter[1] in AnsiLetters + AnsiDecDigits + [FDelimiters.ED[1], FDelimiters.SD[1]]) then begin FDelimiters.SS := Copy(FData, I, 1); Break; end; end; end; function TEDIFile.InternalCreateInterchangeControl: TEDIInterchangeControl; begin Result := TEDIInterchangeControl.Create(Self); end; procedure TEDIFile.DeleteInterchange(Interchange: TEDIInterchangeControl); begin DeleteEDIDataObject(Interchange); end; function TEDIFile.InternalAssignDelimiters: TEDIDelimiters; begin Result := TEDIDelimiters.Create('''', '+', ':'); end; function TEDIFile.InternalCreateEDIDataObject: TEDIDataObject; begin Result := InternalCreateInterchangeControl; end; //=== { TEDICompositeElement } =============================================== constructor TEDICompositeElement.Create(Parent: TEDIDataObject; ElementCount: Integer); begin if Assigned(Parent) and (Parent is TEDISegment) then inherited Create(Parent, ElementCount) else inherited Create(nil, ElementCount); FEDIDOT := ediElement; end; destructor TEDICompositeElement.Destroy; begin inherited Destroy; end; function TEDICompositeElement.AddElement: Integer; begin Result := AddEDIDataObject; end; function TEDICompositeElement.AddElements(Count: Integer): Integer; begin Result := AddEDIDataObjects(Count); end; function TEDICompositeElement.AppendElement(Element: TEDIElement): Integer; begin Result := AppendEDIDataObject(Element); end; function TEDICompositeElement.AppendElements(ElementArray: TEDIElementArray): Integer; begin Result := AppendEDIDataObjects(TEDIDataObjectArray(ElementArray)); end; function TEDICompositeElement.Assemble: string; var I: Integer; begin FData := ''; FLength := 0; Result := ''; if not Assigned(FDelimiters) then // Attempt to assign the delimiters begin FDelimiters := InternalAssignDelimiters; if not Assigned(FDelimiters) then raise EJclEDIError.CreateRes(@RsEDIError038); end; if GetCount > 0 then for I := 0 to GetCount - 1 do if Assigned(FEDIDataObjects[I]) then begin if FData <> '' then FData := FData + FDelimiters.SS + FEDIDataObjects[I].Assemble else FData := FData + FEDIDataObjects[I].Assemble; end else begin // If I is not equal to the last item then add the subelement seperator. if I <> GetCount - 1 then FData := FData + FDelimiters.SS; end; FLength := Length(FData); Result := FData; // Return assembled string DeleteElements; FState := ediAssembled; end; procedure TEDICompositeElement.DeleteElement(Element: TEDIElement); begin DeleteEDIDataObject(Element); end; procedure TEDICompositeElement.DeleteElement(Index: Integer); begin DeleteEDIDataObject(Index); end; procedure TEDICompositeElement.DeleteElements; begin DeleteEDIDataObjects; end; procedure TEDICompositeElement.DeleteElements(Index, Count: Integer); begin DeleteEDIDataObjects(Index, Count); end; procedure TEDICompositeElement.Disassemble; var StartPos, SearchResult, I: Integer; begin DeleteElements; if not Assigned(FDelimiters) then // Attempt to assign the delimiters begin FDelimiters := InternalAssignDelimiters; if not Assigned(FDelimiters) then raise EJclEDIError.CreateRes(@RsEDIError037); end; StartPos := 1; SearchResult := StrSearch(FDelimiters.SS, FData, StartPos); while SearchResult > 0 do begin I := AddElement; if (SearchResult - StartPos) > 0 then // data exists begin FEDIDataObjects[I].Data := Copy(FData, StartPos, (SearchResult - StartPos)); FEDIDataObjects[I].Disassemble; end; StartPos := SearchResult + 1; SearchResult := StrSearch(FDelimiters.SS, FData, StartPos); end; if StartPos <= Length(FData) then begin I := AddElement; FEDIDataObjects[I].Data := Copy(FData, StartPos, (Length(FData) - StartPos) + 1); FEDIDataObjects[I].Disassemble; end; end; function TEDICompositeElement.GetElement(Index: Integer): TEDIElement; begin Result := TEDIElement(GetEDIDataObject(Index)); end; function TEDICompositeElement.InsertElement(InsertIndex: Integer): Integer; begin Result := InsertEDIDataObject(InsertIndex); end; function TEDICompositeElement.InsertElement(InsertIndex: Integer; Element: TEDIElement): Integer; begin Result := InsertEDIDataObject(InsertIndex, Element); end; function TEDICompositeElement.InsertElements(InsertIndex: Integer; ElementArray: TEDIElementArray): Integer; begin Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(ElementArray)); end; function TEDICompositeElement.InsertElements(InsertIndex, Count: Integer): Integer; begin Result := InsertEDIDataObjects(InsertIndex, Count); end; function TEDICompositeElement.InternalAssignDelimiters: TEDIDelimiters; begin Result := nil; if not Assigned(FDelimiters) then // Attempt to assign the delimiters // Get the delimiters from the segment if Assigned(Parent) and (Parent is TEDISegment) then Result := Parent.Delimiters; end; function TEDICompositeElement.InternalCreateEDIDataObject: TEDIDataObject; begin Result := InternalCreateElement; end; function TEDICompositeElement.InternalCreateElement: TEDIElement; begin Result := TEDIElement.Create(Self); end; procedure TEDICompositeElement.SetElement(Index: Integer; Element: TEDIElement); begin SetEDIDataObject(Index, Element); end; //=== { TEDIMessageLoop } ==================================================== // EDI Transaction Set Loop constructor TEDIMessageLoop.Create(Parent: TEDIDataObject); begin inherited Create(Parent); FCreateObjectType := ediLoop; FGroupIsParent := False; if Assigned(Parent) and (Parent is TEDIMessage) then FParentMessage := TEDIMessage(Parent) else if Assigned(Parent) and (Parent is TEDIMessageLoop) then FParentMessage := TEDIMessageLoop(Parent).ParentMessage else FParentMessage := nil; FEDIDOT := ediLoop; FEDIDataObjects.OwnsObjects := False; end; destructor TEDIMessageLoop.Destroy; begin DeleteEDIDataObjects; inherited Destroy; end; function TEDIMessageLoop.InternalAssignDelimiters: TEDIDelimiters; begin Result := nil; if FDelimiters = nil then // Attempt to assign the delimiters if Assigned(FParentMessage) then Result := FParentMessage.Delimiters; end; function TEDIMessageLoop.InternalCreateEDIDataObject: TEDIDataObject; begin case FCreateObjectType of ediLoop: begin Result := TEDIMessageLoop.Create(Self); TEDIMessageLoop(Result).OwnerLoopId := OwnerLoopId; TEDIMessageLoop(Result).ParentLoopId := ParentLoopId; TEDIMessageLoop(Result).Parent := Self; end; else Result := nil; end; end; function TEDIMessageLoop.Assemble: string; begin Result := ''; end; procedure TEDIMessageLoop.Disassemble; begin // Do Nothing end; function TEDIMessageLoop.AddLoop(OwnerLoopId, ParentLoopId: string): Integer; var Loop: TEDIMessageLoop; begin FCreateObjectType := ediLoop; Loop := TEDIMessageLoop(InternalCreateEDIDataObject); Loop.OwnerLoopId := OwnerLoopId; Loop.ParentLoopId := ParentLoopId; Loop.Parent := Self; Result := AppendEDIDataObject(Loop); end; procedure TEDIMessageLoop.AppendSegment(Segment: TEDISegment); begin AppendEDIDataObject(Segment); end; procedure TEDIMessageLoop.DeleteEDIDataObjects; var I: Integer; begin for I := 0 to FEDIDataObjects.Count - 1 do if Assigned(FEDIDataObjects[I]) then try // Delete if FEDIDataObjects[I] is TEDIMessageLoop then FEDIDataObjects.Item[I].FreeAndNilEDIDataObject else // Do not free segments because they are not owned by FEDIDataObjects[I] := nil; except // This exception block was put here to capture the case where FEDIDataObjects[I] was // actually destroyed prior to destroying this object. FEDIDataObjects[I] := nil; end; // Resize FEDIDataObjects.Clear; end; function TEDIMessageLoop.FindLoop(LoopId: string; var StartIndex: Integer): TEDIMessageLoop; var I, J: Integer; begin Result := nil; J := StartIndex; for I := StartIndex to GetCount {FEDIDataObjects.Count} - 1 do begin StartIndex := I; if FEDIDataObjects[I] is TEDIMessageLoop then begin Result := TEDIMessageLoop(GetEDIDataObject(I)); if Result.OwnerLoopId = LoopId then begin Inc(StartIndex); Break; end; Result := nil; end; end; if Result = nil then StartIndex := J; end; function TEDIMessageLoop.FindSegment(SegmentId: string; var StartIndex: Integer): TEDISegment; var I, J: Integer; begin Result := nil; J := StartIndex; for I := StartIndex to GetCount {FEDIDataObjects.Count} - 1 do begin StartIndex := I; if FEDIDataObjects[I] is TEDISegment then begin Result := TEDISegment(GetEDIDataObject(I)); if Result.SegmentId = SegmentId then begin Inc(StartIndex); Break; end; Result := nil; end; end; if Result = nil then StartIndex := J; end; function TEDIMessageLoop.FindSegment(SegmentId: string; var StartIndex: Integer; ElementConditions: TStrings): TEDISegment; var I, TrueCount, ElementIndex: Integer; Name: string; begin Result := FindSegment(SegmentId, StartIndex); while Result <> nil do begin TrueCount := 0; for I := 0 to ElementConditions.Count - 1 do begin Name := ElementConditions.Names[I]; ElementIndex := StrToInt(Name); if Result[ElementIndex].Data = ElementConditions.Values[Name] then Inc(TrueCount); end; if TrueCount = ElementConditions.Count then Break; Result := FindSegment(SegmentId, StartIndex); end; end; end.