jcledixml.pas

East make Tray Icon in delphi

  public
    constructor Create;
    destructor Destroy; override;
    procedure ParseXMLHeader(XMLHeader: string);
    function OutputXMLHeader: string;
  published
    property Delimiters: TEDIXMLDelimiters read FDelimiters;
    property Attributes: TEDIXMLAttributes read FAttributes;
    property XMLNameSpaceOption: TEDIXMLNameSpaceOption read FXMLNameSpaceOption
      write FXMLNameSpaceOption;
  end;

  //  EDI XML File
  TEDIXMLFile = class(TEDIXMLDataObjectGroup)
  private
    FFileID: Integer;
    FFileName: string;
    FEDIXMLFileHeader: TEDIXMLFileHeader;
    procedure InternalLoadFromFile;
  public
    constructor Create(Parent: TEDIXMLDataObject); reintroduce;
    destructor Destroy; override;

    function InternalAssignDelimiters: TEDIXMLDelimiters; override;
    function InternalCreateDataObjectGroup: TEDIXMLDataObjectGroup; override;

    procedure LoadFromFile(const FileName: string);
    procedure ReLoadFromFile;
    procedure SaveToFile;
    procedure SaveAsToFile(const FileName: string);

    function Assemble: string; override;
    procedure Disassemble; override;
  published
    property FileID: Integer read FFileID write FFileID;
    property FileName: string read FFileName write FFileName;
    property XMLFileHeader: TEDIXMLFileHeader read FEDIXMLFileHeader;
  end;

  //  EDI XML Format Translator
  TEDIXMLANSIX12FormatTranslator = class(TEDIObject)
  private
    procedure ConvertTransactionSetLoopToXML(EDILoop: TEDITransactionSetLoop;
      XMLLoop: TEDIXMLTransactionSetLoop);
    procedure ConvertTransactionSetLoopToEDI(EDITransactionSet: TEDITransactionSet;
      XMLLoop: TEDIXMLTransactionSetLoop);
  protected
  public
    constructor Create;
    destructor Destroy; override;
    //
    function ConvertToXMLSegment(EDISegment: TEDISegment): TEDIXMLSegment;
    function ConvertToXMLTransaction(
      EDITransactionSet: TEDITransactionSet): TEDIXMLTransactionSet; overload;
    function ConvertToXMLTransaction(EDITransactionSet: TEDITransactionSet;
      EDITransactionSetSpec: TEDITransactionSetSpec): TEDIXMLTransactionSet; overload;
    function ConvertToEDISegment(XMLSegment: TEDIXMLSegment): TEDISegment;
    function ConvertToEDITransaction(
      XMLTransactionSet: TEDIXMLTransactionSet): TEDITransactionSet;
  end;

implementation

uses
  JclResources, JclStrings;

const
  EDIXML_Ampersand = '&';
  EDIXML_LessThanSign = '<';
  EDIXML_GreaterThanSign = '>';
  EDIXML_QuotationMark = '"';
  EDIXML_Apostrophe = '''';

  EDIXML_HTMLAmpersand = '&amp;';
  EDIXML_HTMLLessThanSign = '&lt;';
  EDIXML_HTMLGreaterThanSign = '&gt;';
  EDIXML_HTMLQuotationMark = '&quot;';
  EDIXML_HTMLApostrophe = '&apos;';

  EDIXMLDelimiter_ForwardSlash = '/';
  EDIXMLDelimiter_EqualToSign = '=';
  EDIXMLDelimiter_CDATABegin = '<![CDATA[';
  EDIXMLDelimiter_CDATAEnd = ']]>';
  EDIXMLDelimiter_FileHeaderBegin = '<?';
  EDIXMLDelimiter_FileHeaderEnd = '?>';

  EDIXMLAttributeStr_version = 'version';
  EDIXMLAttributeStr_encoding = 'encoding';
  EDIXMLAttributeStr_xmlns = 'xmlns';
  EDIXMLAttributeStr_xmlnsEDI = 'xmlns:EDI';

  Value_xml = 'xml';
  Value_Version10 = '1.0';
  Value_Windows1252 = 'windows-1252';
  Value_EDITRANSDOC = 'EDITRANSDOC';  

//=== { TEDIXMLDelimiters } ==================================================

constructor TEDIXMLDelimiters.Create;
begin
  inherited Create;
  SetBeginTagDelimiter(EDIXML_LessThanSign);
  SetBeginOfEndTagDelimiter(FBeginTagDelimiter + EDIXMLDelimiter_ForwardSlash);
  SetEndTagDelimiter(EDIXML_GreaterThanSign);
  FSpaceDelimiter := AnsiSpace;
  FAssignmentDelimiter := EDIXMLDelimiter_EqualToSign;
  FSingleQuote := EDIXML_Apostrophe;
  FDoubleQuote := EDIXML_QuotationMark;
  SetBeginCDataDelimiter(EDIXMLDelimiter_CDATABegin);
  SetEndCDataDelimiter(EDIXMLDelimiter_CDATAEnd);
end;

procedure TEDIXMLDelimiters.SetBeginCDataDelimiter(const Value: string);
begin
  FBeginCDataDelimiter := Value;
  FBeginCDataLength := Length(FBeginCDataDelimiter);
end;

procedure TEDIXMLDelimiters.SetBeginOfEndTagDelimiter(const Value: string);
begin
  FBeginOfEndTagDelimiter := Value;
  FBeginOfEndTagLength := Length(FBeginOfEndTagDelimiter);
end;

procedure TEDIXMLDelimiters.SetBeginTagDelimiter(const Value: string);
begin
  FBeginTagDelimiter := Value;
  FBeginTagLength := Length(FBeginTagDelimiter);
end;

procedure TEDIXMLDelimiters.SetEndCDataDelimiter(const Value: string);
begin
  FEndCDataDelimiter := Value;
  FEndCDataLength := Length(FEndCDataDelimiter);
end;

procedure TEDIXMLDelimiters.SetEndTagDelimiter(const Value: string);
begin
  FEndTagDelimiter := Value;
  FEndTagLength := Length(FEndTagDelimiter);
end;

//=== { TEDIXMLAttributes } ==================================================

constructor TEDIXMLAttributes.Create;
begin
  inherited Create;
  FAttributes := TStringList.Create;
  FDelimiters := TEDIXMLDelimiters.Create;
end;

destructor TEDIXMLAttributes.Destroy;
begin
  FDelimiters.Free;
  FAttributes.Free;
  inherited Destroy;
end;

function TEDIXMLAttributes.CheckAttribute(Name, Value: string): Integer;
begin
  Result := -1;
  if FAttributes.Values[Name] = Value then
    Result := FAttributes.IndexOfName(Name);
end;

function TEDIXMLAttributes.CombineAttributes: string;
var
  I, J, K: Integer;
  QuoteDelimiter: string;
begin
  Result := '';
  for I := 0 to FAttributes.Count - 1 do
  begin
    {$IFDEF COMPILER7_UP}
    J := StrSearch(FDelimiters.SingleQuote, FAttributes.ValueFromIndex[I]);
    K := StrSearch(FDelimiters.DoubleQuote, FAttributes.ValueFromIndex[I]);
    {$ELSE}
    J := StrSearch(FDelimiters.SingleQuote, FAttributes.Values[FAttributes.Names[I]]);
    K := StrSearch(FDelimiters.DoubleQuote, FAttributes.Values[FAttributes.Names[I]]);
    {$ENDIF COMPILER7_UP}
    if J > K then
      QuoteDelimiter := FDelimiters.SingleQuote
    else
      QuoteDelimiter := FDelimiters.DoubleQuote;
    if Result <> '' then
      Result := Result + FDelimiters.SpaceDelimiter;
    {$IFDEF COMPILER7_UP}
    Result := Result + FAttributes.Names[I] + FDelimiters.AssignmentDelimiter +
      QuoteDelimiter + FAttributes.ValueFromIndex[I] + QuoteDelimiter;
    {$ELSE}
    Result := Result + FAttributes.Names[I] + FDelimiters.AssignmentDelimiter +
      QuoteDelimiter + FAttributes.Values[FAttributes.Names[I]] + QuoteDelimiter;
    {$ENDIF COMPILER7_UP}
  end;
end;

function TEDIXMLAttributes.GetAttributeString(Name: string): string;
var
  J, K: Integer;
  QuoteDelimiter: string;
begin
  Result := '';
  J := StrSearch(FDelimiters.SingleQuote, FAttributes.Values[Name]);
  K := StrSearch(FDelimiters.DoubleQuote, FAttributes.Values[Name]);
  if J > K then
    QuoteDelimiter := FDelimiters.SingleQuote
  else
    QuoteDelimiter := FDelimiters.DoubleQuote;
  Result := Name + FDelimiters.AssignmentDelimiter +
    QuoteDelimiter + FAttributes.Values[Name] + QuoteDelimiter;
end;

function TEDIXMLAttributes.GetAttributeValue(Name: string): string;
begin
  Result := FAttributes.Values[Name];
end;

procedure TEDIXMLAttributes.ParseAttributes(XMLStartTag: string);
var
  SearchResult: Integer;
  EndDataChar: string;
  Attribute, Value: string;
  AttributeStart, AttributeLen: Integer;
  ValueStart, ValueLen: Integer;
begin
  FAttributes.Clear;
  // Search for begin of attribute
  SearchResult := StrSearch(FDelimiters.SpaceDelimiter, XMLStartTag, 1);
  AttributeStart := SearchResult + Length(FDelimiters.SpaceDelimiter);
  while SearchResult > 0 do
  begin
    // Get the end data delimiter
    SearchResult := StrSearch(FDelimiters.AssignmentDelimiter, XMLStartTag, AttributeStart);
    if SearchResult > 0 then
    begin
      AttributeLen := SearchResult - AttributeStart;
      ValueStart := SearchResult + Length(FDelimiters.AssignmentDelimiter);
      EndDataChar := Copy(XMLStartTag, ValueStart, 1);
      // Search for end of data
      ValueStart := ValueStart + Length(FDelimiters.AssignmentDelimiter);
      SearchResult := StrSearch(EndDataChar, XMLStartTag, ValueStart);
      if SearchResult > 0 then
      begin
        ValueLen := SearchResult - ValueStart;
        Attribute := Copy(XMLStartTag, AttributeStart, AttributeLen);
        Value := Copy(XMLStartTag, ValueStart, ValueLen);
        FAttributes.Values[Attribute] := Value;
      end;
      // Search for begin of attribute
      SearchResult := StrSearch(FDelimiters.SpaceDelimiter, XMLStartTag, SearchResult);
      AttributeStart := SearchResult + Length(FDelimiters.SpaceDelimiter);
    end;
  end;
end;

procedure TEDIXMLAttributes.SetAttribute(Name, Value: string);
begin
  FAttributes.Values[Name] := Value;
end;

//=== { TEDIXMLDataObject } ==================================================

constructor TEDIXMLDataObject.Create(Parent: TEDIXMLDataObject);
begin
  inherited Create;
  FState := ediCreated;
  FEDIDOT := ediUnknown;
  FData := '';
  FLength := 0;
  FParent := Parent;
  FDelimiters := nil;
  FAttributes := TEDIXMLAttributes.Create;
end;

destructor TEDIXMLDataObject.Destroy;
begin
  FAttributes.Free;
  if not Assigned(FParent) then
    FDelimiters.Free;
  FDelimiters := nil;
  inherited Destroy;
end;

function TEDIXMLDataObject.GetData: string;
begin
  Result := FData;
end;

procedure TEDIXMLDataObject.SetData(const Data: string);
begin
  FData := Data;
  FLength := Length(FData);
end;

procedure TEDIXMLDataObject.SetDelimiters(const Delimiters: TEDIXMLDelimiters);
begin
  if not Assigned(FParent) then
    FreeAndNil(FDelimiters);
  FDelimiters := Delimiters;
end;

//=== { TEDIXMLElement } =====================================================

constructor TEDIXMLElement.Create(Parent: TEDIXMLDataObject);
begin
  if Assigned(Parent) and (Parent is TEDIXMLSegment) then
    inherited Create(Parent)
  else
    inherited Create(nil);
  FEDIDOT := ediElement;
  FCData := False;
end;

function TEDIXMLElement.Assemble: string;
var
  AttributeString: string;
  OriginalData: string;
begin
  // Check delimiter assignment
  if not Assigned(FDelimiters) then
  begin
    FDelimiters := InternalAssignDelimiters;
    if not Assigned(FDelimiters) then
      raise EJclEDIError.CreateRes(@EDIXMLError047);
  end;

  OriginalData := FData;
  // Handle Entity Reference Characters
  StrReplace(OriginalData, EDIXML_Ampersand, EDIXML_HTMLAmpersand, [rfReplaceAll]);
  StrReplace(OriginalData, EDIXML_LessThanSign, EDIXML_HTMLLessThanSign, [rfReplaceAll]);
  StrReplace(OriginalData, EDIXML_GreaterThanSign, EDIXML_HTMLGreaterThanSign, [rfReplaceAll]);
  StrReplace(OriginalData, EDIXML_QuotationMark, EDIXML_HTMLQuotationMark, [rfReplaceAll]);
  StrReplace(OriginalData, EDIXML_Apostrophe, EDIXML_HTMLApostrophe, [rfReplaceAll]);
  //
  AttributeString := FAttributes.CombineAttributes;
  if AttributeString <> '' then
    FData := FDelimiters.BTD + XMLTag_Element + FDelimiters.SpaceDelimiter +
      AttributeString + FDelimiters.ETD
  else
    FData := FDelimiters.BTD + XMLTag_Element + FDelimiters.ETD;

  if FCData then
    FData := FData + FDelimiters.BCDataD + OriginalData + FDelimiters.ECDataD
  else
    FData := FData + OriginalData;

  FData := FData + FDelimiters.BOfETD + XMLTag_Element + FDelimiters.ETD;

  Result := FData;
  FState := ediAssembled;
end;

procedure TEDIXMLElement.Disassemble;
var
  StartPos, EndPos, SearchResult: Integer;
  XMLStartTag: string;
begin
  // Check delimiter assignment
  if not Assigned(FDelimiters) then
  begin
    FDelimiters := InternalAssignDelimiters;
    if not Assigned(FDelimiters) then
      raise EJclEDIError.CreateRes(@EDIXMLError046);
  end;
  // Set next start positon
  StartPos := 1;
  // Move past begin element tag
  SearchResult := StrSearch(FDelimiters.BTD + XMLTag_Element, FData, StartPos);
  if SearchResult > 0 then
  begin
    SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult);
    XMLStartTag := Copy(FData, StartPos, (SearchResult + FDelimiters.ETDLength) - StartPos);
    FAttributes.ParseAttributes(XMLStartTag);
  end
  else
    raise EJclEDIError.CreateRes(@EDIXMLError048);