lazarus-ccr/components/fpexif/fpexmpdata.pas

{ Implements access to XMP metadata.
  Reads the XMP segment into an internal string field.
  Use LoadFromStream and SaveToStream methods to read or write this field.
  There is also a simple "tag-like" interface, however, it is implemented only
  for reading the meta data.

  File good for testing:
  https://commons.wikimedia.org/wiki/File:Metadata_test_file_-_includes_data_in_IIM,_XMP,_and_Exif.jpg
}

unit fpeXMPData;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, contnrs,
  {$IFDEF FPC}
  laz2_dom, laz2_xmlread,
  {$ENDIF}
  fpeGlobal, fpeTags;

type
  TXMPData = class
  private
    FData: String;
    FDoc: TXMLDocument;
    FTags: TStringList;
    function GetTagByIndex(AIndex: Integer): String;
    function GetTagByName(ATagName: String): String;
    function GetTagName(AIndex: Integer): String;
    function GetTagCount: Integer;
  protected
    {$IFDEF FPC}
    procedure Create_RDFDescription_Tags(ANode: TDOMNode);
    procedure CreateTags;
    {$ENDIF}
  public
    constructor Create;
    destructor Destroy; override;
    procedure LoadFromStream(AStream: TStream; ASize: Integer = -1);
    procedure SaveToStream(AStream: TStream);
    property TagByIndex[AIndex: Integer]: String read GetTagByIndex;
    property TagByName[ATagName: String]: String read GetTagByName;
    property TagName[AIndex: Integer]: String read GetTagName;
    property TagCount: Integer read GetTagCount;
  end;
      

implementation
  
{ TXMPData }
  
constructor TXMPData.Create;
begin
  inherited;
  FTags := TStringList.Create; 
end;

destructor TXMPData.Destroy; 
begin
  {$IFDEF FPC}
  FDoc.Free;
  {$ENDIF}
  FTags.Free;
  inherited;
end;

{$IFDEF FPC}
procedure TXMPData.Create_RDFDescription_Tags(ANode: TDOMNode);
var
  node: TDOMNode;
  nodeName: String;
  i: Integer;
  attr: TDOMNode;
  lTagName, lTagValue: String;
  lTag: TTag;
begin
  while ANode <> nil do begin
    nodeName := ANode.NodeName;
    for i := 0 to ANode.Attributes.Length-1 do
    begin
      attr := ANode.Attributes.Item[i];
      lTagName := attr.NodeName;
      lTagValue := attr.NodeValue;
      FTags.Add(lTagName + '=' + lTagValue);
    end;
    if ANode.HasChildNodes then
    begin
      node := ANode.FirstChild;
      while node <> nil do 
      begin
        nodeName := node.NodeName;
        lTagValue := node.TextContent;
        if lTagName <> '' then
          FTags.Add(nodeName + '=' + lTagValue);
        node := node.NextSibling;
      end;
    end;
    ANode := ANode.NextSibling;
  end;
end;
    
procedure TXMPData.CreateTags;
var
  stream: TStringStream;
  node: TDOMNode;
  nodeName: String;
begin
  FDoc.Free;
  stream := TStringStream.Create(FData);
  try
    ReadXMLFile(FDoc, stream);
  finally
    stream.Free;
  end;
  
  FTags.Clear;
  try
    node := FDoc.DocumentElement.FindNode('rdf:RDF');
    if node = nil then exit;
    node := node.FirstChild;
    while node <> nil do 
    begin
      nodeName := node.NodeName;
      if nodeName = 'rdf:Description' then
        Create_RDFDescription_Tags(node);
      node := node.NextSibling;
    end;
  except
    FTags.Clear;
    FreeAndNil(FDoc);
    raise;
  end;
end;
{$ENDIF}

function TXMPData.GetTagByIndex(AIndex: Integer):  String;
begin
  Result := FTags.ValueFromIndex[AIndex];
end;

function TXMPData.GetTagByName(ATagName: String): String;
begin
  Result := FTags.Values[ATagName];;
end;

function TXMPData.GetTagCount: Integer;
begin
  Result := FTags.Count;
end;

function TXMPData.GetTagName(AIndex: Integer): String;
begin
  Result := FTags.Names[AIndex];
end;

procedure TXMPData.LoadFromStream(AStream: TStream; ASize: Integer = -1);
var
  p: Int64;
begin
  if ASize = -1 then 
    ASize := AStream.Size;
  SetLength(FData, ASize);
  p := AStream.Position;
  AStream.Read(FData[1], ASize);
  
  AStream.Position := p;
  {$IFDEF FPC}
  CreateTags;
  {$ENDIF}
end;

procedure TXMPData.SaveToStream(AStream: TStream);
begin
  if FData <> '' then
    AStream.Write(FData[1], Length(FData));
end;

end.