⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jcledi_ansix12.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    property ParentLoopId: string read FParentLoopId write FParentLoopId;
    property ParentTransactionSet: TEDITransactionSet read FParentTransactionSet
      write FParentTransactionSet;
  end;

  //  EDI Transaction Set Document and related types and classes
  TEDITransactionSetDocumentOptions = set of (doLinkSpecToDataObject);

  TEDITransactionSetDocument = class(TEDITransactionSetLoop)
  private
  protected
    FErrorOccured: Boolean;
    FEDITSDOptions: TEDITransactionSetDocumentOptions;
    FEDILoopStack: TEDILoopStack;
    // References
    FEDITransactionSet: TEDITransactionSet;
    FEDITransactionSetSpec: TEDITransactionSetSpec;
    function ValidateSegSpecIndex(DataSegmentId: string; SpecStartIndex: Integer): Integer;
    function AdvanceSegSpecIndex(DataIndex, SpecStartIndex, SpecEndIndex: Integer): Integer;
    procedure AddLoopToDoc(StackRecord: TEDILoopStackRecord;
      SegmentId, OwnerLoopId, ParentLoopId: string; var EDIObject: TEDIObject);
    procedure SetSpecificationPointers(DataSegment, SpecSegment: TEDISegment);
  protected
    procedure ValidateData(TSDocument: TEDITransactionSetDocument;
      LoopStack: TEDILoopStack;
      DataSegment, SpecSegment: TEDISegment;
      var DataIndex, SpecIndex: Integer;
      var ErrorOccured: Boolean); virtual;
  public
    constructor Create(Parent: TEDIDataObject; EDITransactionSet: TEDITransactionSet;
      EDITransactionSetSpec: TEDITransactionSetSpec); reintroduce;
    destructor Destroy; override;
    //
    //  ToDo:  More procedures and functions to manage internal structures
    //
    procedure FormatDocument; virtual;
  published
    property EDITSDOptions: TEDITransactionSetDocumentOptions read FEDITSDOptions
      write FEDITSDOptions;
    property ErrorOccured: Boolean read FErrorOccured;
  end;

  TEDITransactionSetDocumentArray = array of TEDITransactionSetDocument;

  //  EDI Functional Group
  TEDIFunctionalGroup = class(TEDIDataObjectGroup)
  private
    FGSSegment: TEDIFunctionalGroupSegment;
    FGESegment: TEDIFunctionalGroupSegment;
    function GetTransactionSet(Index: Integer): TEDITransactionSet;
    procedure SetTransactionSet(Index: Integer; TransactionSet: TEDITransactionSet);
    procedure SetGSSegment(const GSSegment: TEDIFunctionalGroupSegment);
    procedure SetGESegment(const GESegment: TEDIFunctionalGroupSegment);
  protected
    procedure InternalCreateHeaderTrailerSegments; virtual;
    function InternalCreateTransactionSet: TEDITransactionSet; virtual;
    function InternalAssignDelimiters: TEDIDelimiters; override;
    function InternalCreateEDIDataObject: TEDIDataObject; override;
  public
    constructor Create(Parent: TEDIDataObject; TransactionSetCount: Integer = 0); reintroduce;
    destructor Destroy; override;

    function AddTransactionSet: Integer;
    function AppendTransactionSet(TransactionSet: TEDITransactionSet): Integer;
    function InsertTransactionSet(InsertIndex: Integer): Integer; overload;
    function InsertTransactionSet(InsertIndex: Integer;
      TransactionSet: TEDITransactionSet): Integer; overload;
    procedure DeleteTransactionSet(Index: Integer); overload;
    procedure DeleteTransactionSet(TransactionSet: TEDITransactionSet); overload;

    function AddTransactionSets(Count: Integer): Integer;
    function AppendTransactionSets(TransactionSetArray: TEDITransactionSetArray): Integer;
    function InsertTransactionSets(InsertIndex, Count: Integer): Integer; overload;
    function InsertTransactionSets(InsertIndex: Integer;
      TransactionSetArray: TEDITransactionSetArray): Integer; overload;
    procedure DeleteTransactionSets; overload;
    procedure DeleteTransactionSets(Index, Count: Integer); overload;

    function Assemble: string; override;
    procedure Disassemble; override;

    property TransactionSet[Index: Integer]: TEDITransactionSet read GetTransactionSet
      write SetTransactionSet; default;
    property TransactionSets: TEDIDataObjectList read FEDIDataObjects;
  published
    property SegmentGS: TEDIFunctionalGroupSegment read FGSSegment write SetGSSegment;
    property SegmentGE: TEDIFunctionalGroupSegment read FGESegment write SetGESegment;
    property TransactionSetCount: Integer read GetCount;
  end;

  TEDIFunctionalGroupArray = array of TEDIFunctionalGroup;

  //  EDI Functional Specification
  TEDIFunctionalGroupSpec = class(TEDIFunctionalGroup)
  private
    FFunctionalGroupId: string;
    FFGDescription: string;
    FAgencyCodeId: string;
    FVersionReleaseId: string;
  public
    procedure InternalCreateHeaderTrailerSegments; override;
    function InternalCreateTransactionSet: TEDITransactionSet; override;
    function FindTransactionSetSpec(TransactionSetId: string): TEDITransactionSetSpec;
  published
    property Id: string read FFunctionalGroupId write FFunctionalGroupId;
    property FunctionalGroupId: string read FFunctionalGroupId write FFunctionalGroupId;
    property FGDescription: string read FFGDescription write FFGDescription;
    property AgencyCodeId: string read FAgencyCodeId write FAgencyCodeId;
    property VersionReleaseId: string read FVersionReleaseId write FVersionReleaseId;
  end;

  //  EDI Interchange Control
  TEDIInterchangeControl = class(TEDIDataObjectGroup)
  private
    FISASegment: TEDIInterchangeControlSegment;
    FIEASegment: TEDIInterchangeControlSegment;
    FTA1Segments: TEDIObjectList;
    function GetFunctionalGroup(Index: Integer): TEDIFunctionalGroup;
    procedure SetFunctionalGroup(Index: Integer; FunctionalGroup: TEDIFunctionalGroup);
    procedure SetISASegment(const ISASegment: TEDIInterchangeControlSegment);
    procedure SetIEASegment(const IEASegment: TEDIInterchangeControlSegment);
  protected
    procedure InternalCreateHeaderTrailerSegments; virtual;
    function InternalCreateFunctionalGroup: TEDIFunctionalGroup; 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;
    procedure DeleteFunctionalGroup(Index: Integer); overload;
    procedure DeleteFunctionalGroup(FunctionalGroup: TEDIFunctionalGroup); 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;
    procedure DeleteFunctionalGroups; overload;
    procedure DeleteFunctionalGroups(Index, Count: Integer); overload;

    function Assemble: string; override;
    procedure Disassemble; override;

    property FunctionalGroup[Index: Integer]: TEDIFunctionalGroup read GetFunctionalGroup
      write SetFunctionalGroup; default;
    property FunctionalGroups: TEDIDataObjectList read FEDIDataObjects;
  published
    property SegmentISA: TEDIInterchangeControlSegment read FISASegment write SetISASegment;
    property SegmentIEA: TEDIInterchangeControlSegment read FIEASegment write SetIEASegment;
    property TA1Segments: TEDIObjectList read FTA1Segments;
    property FunctionalGroupCount: Integer read GetCount;
  end;

  TEDIInterchangeControlArray = array of TEDIInterchangeControl;

  //  EDI Interchange Specification
  TEDIInterchangeControlSpec = class(TEDIInterchangeControl)
  private
    FStandardId: string;
    FVersionId: string;
    FICDescription: string;
  public
    procedure InternalCreateHeaderTrailerSegments; override;
    function InternalCreateFunctionalGroup: TEDIFunctionalGroup; override;
    function FindFunctionalGroupSpec(FunctionalGroupId, AgencyCodeId,
      VersionReleaseId: string): TEDIFunctionalGroupSpec;
    function FindTransactionSetSpec(FunctionalGroupId, AgencyCodeId, VersionReleaseId,
      TransactionSetId: string): TEDITransactionSetSpec;
  published
    property StandardId: string read FStandardId write FStandardId;
    property VersionId: string read FVersionId write FVersionId;
    property ICDescription: string read FICDescription write FICDescription;
  end;

  //  EDI File
  TEDIFileOptions = set of (foVariableDelimiterDetection, foUseAltDelimiterDetection, 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;

  //  EDI File Specification
  TEDIFileSpec = class(TEDIFile)
  public
    constructor Create(Parent: TEDIDataObject; InterchangeCount: Integer = 0); reintroduce;
    function FindTransactionSetSpec(StandardId, VersionId, FunctionalGroupId, AgencyCodeId,
      VersionReleaseId, TransactionSetId: string): TEDITransactionSetSpec;
    function FindFunctionalGroupSpec(StandardId, VersionId, FunctionalGroupId, AgencyCodeId,
      VersionReleaseId: string): TEDIFunctionalGroupSpec;
    function FindInterchangeControlSpec(StandardId, VersionId: string): TEDIInterchangeControlSpec;
    procedure InternalDelimitersDetection(StartPos: Integer); override;
    function InternalCreateInterchangeControl: TEDIInterchangeControl; override;
  end;

implementation

uses
  JclResources, JclStrings;

const
  { Reserved Data Field Values }
  Value_Unknown = 'Unknown';
  Value_NotAssigned = 'Not Assigned';
  Value_None = 'None';
  Value_Optional = 'O';
  Value_Mandatory = 'M';
  Value_AlphaNumeric = 'AN';

//=== { TEDIElement } ========================================================

constructor TEDIElement.Create(Parent: TEDIDataObject);
begin
  if Assigned(Parent) and (Parent is TEDISegment) 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;
begin
  Result := -1;
  if Assigned(Parent) and (Parent is TEDISegment) then
    for I := 0 to TEDISegment(Parent).ElementCount - 1 do
      if TEDISegment(Parent).Element[I] = Self then
      begin
        Result := I;
        Break;
      end;
end;

//=== { TEDISegment } ========================================================

constructor TEDISegment.Create(Parent: TEDIDataObject; ElementCount: Integer);
begin
  if Assigned(Parent) and (Parent is TEDITransactionSet) then
    inherited Create(Parent, ElementCount)
  else
    inherited Create(nil, ElementCount);
  FSegmentId := '';
  FEDIDOT := ediSegment;
end;

destructor TEDISegment.Destroy;
begin
  inherited Destroy;
end;

function TEDISegment.AddElements(Count: Integer): Integer;
begin
  Result := AddEDIDataObjects(Count);
end;

function TEDISegment.AddElement: Integer;
begin
  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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -