{ 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.