jcledi.pas

East make Tray Icon in delphi

{**************************************************************************************************}
{                                                                                                  }
{ 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                }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ 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.16 2005/03/08 08:33:16 marquardt 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);

  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: Pointer;
    FCustomData2: Pointer;
    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: Pointer read FCustomData1 write FCustomData1;
    property CustomData2: Pointer 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