{*******************************************************}
{                                                       }
{       ZaphodsMap                                      }
{                                                       }
{       Object Pascal implementation of ideas at        }
{       www.zaphodsmap.com. This source compiles with   }
{       at least Delphi 7/9/10/11/12/14/15 for win32,   }
{       Delphi 16 for win32&win64, and Kylix 3.         }
{                                                       }
{       This file is licensed under a Creative Commons  }
{       Attribution 2.5 License.                        }
{       http://creativecommons.org/licenses/by/2.5/     }
{       If you use this file, please keep this notice   }
{       intact.                                         }
{                                                       }
{       Developed by HREF Tools Corp. 2005-2011         }
{                                                       }
{       v1.041                                          }
{                                                       }
{       Note: This version of ZaphodsMap compiles with  }
{             NativeXml Version 3.10 which is           }
{             open-source.                              }
{                                                       }
{*******************************************************}
unit {*htns*}ZaphodsMap;

interface

{$I hrefdefines.inc}

uses
{$IFDEF CLR}
  System.IO,
  System.Reflection,
{$ENDIF}
  SysUtils,
  Classes,
  Variants,
  {*htns*}NativeXml,
  {*htns*}ZaphodsMapMessages,
  {*htns*}ZaphodProjectOptions;

const
  cZMGlobalFileName = 'ZMGlobal.xml';
  cZMGlobalRootNodeName = 'ZMGlobalSettings';
  cZMBranchKeyboxFileName = 'ZMKeybox.xml';
  cZMLocalKeyboxSuffix = 'ZMKeybox.xml';
  cZMKeyboxRootNodeName = 'ZMKeybox';
  cZMContextFileName = 'ZMContext.xml';
  cZMContextRootNodeName = 'ZMContext';
  cZMDesignURL = 'http://www.ZaphodsMap.com/zmdesign';
  cZMXslURL = cZMDesignURL + '/css/ZaphodsMap.xsl';
  cW3OrgXMLSchemaInstanceURL = 'http://www.w3.org/2001/XMLSchema-instance';

type

  EZaphodException = class(Exception);

  TKeyboxUsed = (kuNone, kuBranchKeybox, kuLocalKeybox, kuTemp);
  TLocalKeyboxLocation = (klExecutablePath, klLibraryPath, klCustom);
  TZaphodKeyType = (ktFile, ktFolder, ktValue);
  TContextUsage = (cxNone, cxOptional, cxRequired);
  TContextType = (cxDefault, cxCustom);
  TUserNameUsage = (usrNone, usrOptional, usrRequired);
  TUserNameType = (usrDefault, usrCustom);

  TErrorDetailAllowed = (edFileNames, edFilePathsAndNames, edComponentNames,
    edMethodNames);
  TErrorDetailAllowedSet = set of TErrorDetailAllowed;

  TXPathAttribute = record
    xaDefinition: string;
    xaDefinitionStartAt: Integer; { position in XPath string}
    xaAttributeID: string;
    xaAttributeValue: string;
  end;
  TXPathAttributes = array of TXPathAttribute;

  TXPathElement = record
    xeTagName: string;
    xeTagPos: Integer; {1.020}
    xeAttributes: TXPathAttributes;
    xeXsdSummaryParentNode: TXmlNode; {1.034}
    xeXsdSummaryChildIndex: Integer; {1.034}
  end;
  TXPathElements = array of TXPathElement ;

  TZaphodsMap = class;
  TZaphodKey = class;

  TKeyedFileChangedEvent = procedure(Sender: TObject) of object;

  {TZaphodNode}
  TZaphodNode = TXmlNode;

  TLastNodeDetails = record
    lndLastError: string;
    lndLastNode: TZaphodNode;
    lndLastNodeAttrFound: Boolean;
    lndLastNodeContextUsage: TContextUsage;
    lndLastNodeContextUsed: Boolean;
    lndLastNodeContextValue: string;
    lndLastNodeSelectAttrID: string;
  end;

  TKeyedDetail = record
    KeyGroupName: string;
    KeyType: TZaphodKeyType;
    KeyName: string;
    ContextType: TContextType;
    ContextUsage: TContextUsage;
    ContextValue: string;
    UserNameType: TUserNameType;
    UserNameUsage: TUserNameUsage;
    UserNameValue: string;
    DefaultValue: string;
    CallingMethod: string;
    KeyDesc: string; {"TempKey[I]" or full description}
    KeyBoxUsed: TKeyboxUsed;
    ContextUsed: Boolean;
    UserNameUsed: Boolean;
    ExceptionOccurred: Boolean;
    ErrorMessage: string;
  end;

  {$WARNINGS OFF}   { set to OFF in final version}
  {$HINTS OFF}      { set to OFF in final version}

  {TZaphodXmlDoc}
  TZaphodXmlDoc = class(TNativeXml)
  private
    FZaphodKey: TZaphodKey;
    FZaphodsMap: TZaphodsMap;
    FFilePathAndName: string;
    FContextAttributeID: string;
    FContextDefault: string;
    FErrorDetailAllowed: TErrorDetailAllowedSet;
    FLastError: string;
    FLastNode: TZaphodNode;
    FLastNodeAttrFound: Boolean;
    FLastNodeContextUsage: TContextUsage;
    FLastNodeContextUsed: Boolean;
    FLastNodeContextValue: string;
    FLastNodeSelectAttrID: string;
    FRequiredRootNodeName: string;
    FWarnings: TStringList;
    FXmlOK: Boolean;
    FContentBeforeChanges: string;
    FFileAgeBeforeChanges: TDateTime;
    FFileLoaded: Boolean;
    FFileStreamForUpdate: TFileStream;
    FUpdateInProgress: Boolean;
    FContextSupported: Boolean;
    FDeleteEmptyNodesOnSave: Boolean;
    FXsdSummary: TXmlNode;
    FXsdSummarySet: Boolean;
    FXsdUrl: string;
    //FValidationAttempted: Boolean;
    //FValidatesOK: Boolean;

    procedure ClearLastNodeDetails;
    function FormatFileLoadSaveError(const Action, Reason: string): string;
    function GetFileNameIfAllowed: string;
    function GetKeyIndex: Integer;
    //function GetXPathElements(const XPath: string): TXPathElements; {1.033}
    procedure RaiseException(const AMessage: string; MethodName: string);
    procedure RaiseExceptionFmt(const AMessage: string;
      const Args: array of const; MethodName: string);
    function ZNodeCommon(StartNode: TZaphodNode; XPath: string;
      const CreateIfNotFound: Boolean): TZaphodNode;
    function ZCNodeCommon(StartNode: TZaphodNode; XPath: string;
      const AContextUsage: TContextUsage; const AContext: string;
      const CreateIfNotFound: Boolean): TZaphodNode;
    function ExpandVars(const ANode: TZaphodNode; const AValue: string): string;
    procedure DoFileReloaded;
    procedure SaveLastNodeDetails(var LastNodeDetails: TLastNodeDetails);
    procedure RestoreLastNodeDetails(const LastNodeDetails: TLastNodeDetails);
    function ZNodeAttrCommon(StartNode: TZaphodNode; XPath: array of const;
      const SelectAttributeID: string; const DefaultResult: Variant): Variant;
    function ZNodeValueCommon(StartNode: TZaphodNode; XPath: array of const;
      const DefaultResult: Variant): Variant;
    function LoadFileCommon(const WithShareDenyWrite: Boolean): Boolean; {1.030}
    procedure SaveDocToStream(Stream: TStream; var SavedLength: Integer);
    function ValidateNodesRecursive(ANode, XsdNode: TXmlNode;
      out ErrorMsg: string): Boolean;
    function ValidateAndSetXsdSummary(XsdSummaryRoot: TXmlNode;
      out ErrorMsg: string): Boolean;
    procedure EnsureContextIsLastAttribute(var ANode: TXmlNode);
  protected
      function GetXPathElements(const XPath: string): TXPathElements; {1.033}
      function GetXPathElementsEx(StartNode: TXmlNode;
        const XPath: string; const XPathIsAbsolute: Boolean): TXPathElements;
  public
    constructor Create(const AFileName, ARequiredRootNodeName,
      AContextDefault: string; const AContextAttributeID: string = 'context');
    destructor Destroy; override;
    procedure ClearWarnings;
    function FullXPath(StartNode: TZaphodNode; const XPath: string = ''):string;
    function LoadFile: Boolean;
    function SaveFile: Boolean;
    function BeginUpdate(out FileReloaded: Boolean): Boolean;
    procedure CancelUpdate;
    function EndUpdate: Boolean;
    function ExpandVarsIn(const AValue: string;const ANode: TZaphodNode): string;
    function HasChangedOnDisk: Boolean;
    function SaveVarDelimiters(const BeginDelimiter: string = '{';
      const EndDelimiter: string = '}'): Boolean;
    function SaveVar(const ParentNode: TZaphodNode; const VarName,
      Value: string): Boolean;
    function DeleteVar(const ParentNode: TZaphodNode; const VarName: string):
      Boolean;
    function VarDelimitersInUse: Boolean;
    function VarGetDelimiters(out BeginDelim: string; out EndDelim: string):
      Boolean;
    function VarIsInUse(ParentNode: TZaphodNode; const AVarName: string):
      Boolean;
    function VarValue({const ANode: TZaphodNode;} const AVarName: string):
      string;
    function ZNode(StartNode: TZaphodNode; XPath: array of const;
      const ContextUsage: TContextUsage = cxNone;
      const AllowCreate: Boolean = False): TZaphodNode;
    function ZNodeAttr(StartNode: TZaphodNode; XPath: array of const;
      const ContextUsage: TContextUsage; const DefaultResult: Variant;
      const SelectAttributeID: string = 'value'): Variant;
    function ZNodeAttrSave(StartNode: TZaphodNode; XPath: array of const;
      const ContextUsage: TContextUsage; const Value: Variant;
      const SelectAttributeID: string = 'value';
      const AllowCreate: Boolean = True): Boolean;
    function ZNodeValue(StartNode: TZaphodNode; XPath: array of const;
      const ContextUsage: TContextUsage; const DefaultResult: Variant): Variant;
    function ZNodeValueSave(StartNode: TZaphodNode; XPath: array of const;
      const ContextUsage: TContextUsage; const Value: Variant;
      const AllowCreate: Boolean = True): Boolean;
    procedure LoadFromFile(const FileName: string); override;
    procedure SaveToFile(const FileName: string); override;
    function SetXsdSummary(const XsdSummaryAsString: string;
      out ErrorMsg: string): Boolean; overload;
    function SetXsdSummary(XsdSummaryRootNodeToCopy: TXmlNode;
      out ErrorMsg: string): Boolean; overload;
    function SetXsdSummary(const AXsdUrl: string; const AContextSupported,
      ADeleteEmptyNodesOnSave: Boolean; out ErrorMsg: string): Boolean;
      overload;
    function ValidatesOK(out ErrorMsg: string): Boolean;
    property ContentBeforeChanges: string read FContentBeforeChanges; {1.032}
    property ContextAttributeID: string read FContextAttributeID;
    property ContextDefault: string read FContextDefault;
    property ErrorDetailAllowed: TErrorDetailAllowedSet read FErrorDetailAllowed
      write FErrorDetailAllowed;
    property FileSpec: string read FFilePathAndName; {1.033}
    property KeyIndex: Integer read GetKeyIndex;
    property LastError: string read FLastError;
    property LastNode: TZaphodNode read FLastNode write FLastNode;
    property LastNodeAttrFound: Boolean read FLastNodeAttrFound;
    property LastNodeContextUsage: TContextUsage read FLastNodeContextUsage;
    property LastNodeContextUsed: Boolean read FLastNodeContextUsed;
    property LastNodeContextValue: string read FLastNodeContextValue;
    property LastNodeSelectAttrID: string read FLastNodeSelectAttrID;
    property RequiredRootNodeName: string read FRequiredRootNodeName;
    property Warnings: TStringList read FWarnings;
    property XmlOK: Boolean read FXmlOK;
    property ContextSupported: Boolean read FContextSupported;
    property DeleteEmptyNodesOnSave: Boolean read FDeleteEmptyNodesOnSave;
    property XsdSummary: TXmlNode read FXsdSummary;
    property XsdUrl: string read FXsdUrl;
  end;

  {TZaphodXmlDocAdmin}
  TZaphodXmlDocAdmin = class(TZaphodXmlDoc)
  public
    function GetXPathElements(const XPath: string): TXPathElements; {1.033}
    function ZCNode(StartNode: TZaphodNode; XPath: array of const;
      const ContextUsage: TContextUsage; const Context: string;
      const AllowCreate: Boolean = False): TZaphodNode;
    function ZCNodeAttr(StartNode: TZaphodNode; XPath: array of const;
      const ContextUsage: TContextUsage; const Context: string;
      const DefaultResult: Variant; const SelectAttributeID: string = 'value'):
      Variant;
    function ZCNodeAttrSave(StartNode: TZaphodNode; XPath: array of const;
      const ContextUsage: TContextUsage; const Context: string;
      const Value: Variant; const SelectAttributeID: string = 'value';
      const AllowCreate: Boolean = True): Boolean;
    function ZCNodeValue(StartNode: TZaphodNode; XPath: array of const;
      const ContextUsage: TContextUsage; const Context: string;
      const DefaultResult: Variant): Variant;
    function ZCNodeValueSave(StartNode: TZaphodNode; XPath: array of const;
      const ContextUsage: TContextUsage; const Context: string;
      const Value: Variant; const AllowCreate: Boolean = True): Boolean;
  end;

  {$WARNINGS ON}
  {$HINTS ON}

  {TZaphodKey}
  TZaphodKey = class(TComponent)
  private
    FKeyIndex: Integer;
    FKeyedDetail: TKeyedDetail;
    FKeyedFileName: string;
    FKeyedFilePath: string;
    FKeyedFilePathParentDir: string;
    FKeyedFileRootNodeName: string;
    FKeyedFile: TZaphodXMLDoc;
    function GetKeyedFileExists: Boolean;
    function GetKeyedFileNameIfAllowed: string;
    function GetKeyedFileLastError: string;
    procedure RaiseException(const AMessage: string; MethodName: string);
    procedure RaiseExceptionFmt(const AMessage: string;
      const Args: array of const; MethodName: string);
  public
    constructor CreateKey(AOwner: TComponent; const AKeyIndex: Integer;
      const AKeyedFileName, ARequiredRootNodeName: string;
      const AKeyedDetail: TKeyedDetail);
    destructor Destroy; override;
    function CreateKeyedFileFromString(const AFileContents: string;
      out ErrorMessage: string): Boolean;
    property KeyedFileExists: Boolean read GetKeyedFileExists;
    property KeyedFileLastError: string read GetKeyedFileLastError;
    property KeyedFileName: string read FKeyedFileName;
    property KeyedFilePath: string read FKeyedFilePath;
    property KeyedFilePathParentDir: string read FKeyedFilePathParentDir;
    property KeyedFileRootNodeName: string read FKeyedFileRootNodeName;
    property KeyedDetail: TKeyedDetail read FKeyedDetail;
    property KeyIndex: Integer read FKeyIndex;
    property KeyedFile: TZaphodXmlDoc read FKeyedFile write FKeyedFile;
  end;

  TZaphodKeyArray = array of TZaphodKey;


  {ZaphodsMap}
  TZaphodsMap = class(TComponent)
  private
    FBranchKeybox: string;
    FBranchKeyboxExists: Boolean;
    FBranchKeyboxFileAge: TDateTime;
    FBranchKeyboxWarnings: string;
    FBranchKeyboxXml: TZaphodXmlDoc;
    FBranchKeyboxXmlOK: Boolean;
    FDefaultMapContext: string;
    FDefaultUserName: string;
    FErrorDetailAllowed: TErrorDetailAllowedSet;
    FExecutableNameNoExt: string;
    FExecutablePath: string;
    FKeyLastError: string;
    FLibraryNameNoExt: string;
    FLibraryPath: string;
    FLastKeyedDetail: TKeyedDetail;
    FLocalKeybox: string;
    FLocalKeyboxExists: Boolean;
    FLocalKeyboxFileAge: TDateTime;
    FLocalKeyboxLocation: TLocalKeyboxLocation;
    FLocalKeyboxPath: string;
    FLocalKeyboxPrefix: string;
    FLocalKeyboxPrefixEnabled: Boolean;  {defaults to false}
    FLocalKeyboxSuffix: string;
    FLocalKeyboxWarnings: string;
    FLocalKeyboxXml: TZaphodXmlDoc;
    FLocalKeyboxXmlOK: Boolean;
    FZaphodBranch: string;
    FZaphodKeys: TZaphodKeyArray;
    FZaphodsMapEnvVarExists: Boolean;
    FZaphodsMapRoot: string;
    FPropertyList: TStrings;
    FPropertyListBusy: Boolean;
    FProjectOptions: IZaphodProjectOptions;
    FOnDestroy: TNotifyEvent;
    FOnKeyedFileReloaded: TKeyedFileChangedEvent;
    function AddZaphodKeysElement: Integer;
    function AddKeyInternal(out IndexOfKey: Integer; const AKeyGroupName,
      AKeyName, ARequiredRootNodeName: string;
      const AContextType: TContextType; const AContextUsage: TContextUsage;
      const AContextValue: string; const AUserNameType: TUserNameType;
      const AUserNameUsage: TUserNameUsage; const AUserNameValue: string;
      ADefaultKeyedFileName: string; const ACallingMethod: string): TZaphodKey;
    function GetBranchKeyboxWarnings: string;
    function GetKeyedFileElseDeactivateKey(var AKey: TZaphodKey): TZaphodXmlDoc;
    function GetKeyedAttribute(const AKeyGroupName: string;
      const AKeyType: TZaphodKeyType; const AKeyName: string;
      const AContextType: TContextType;  const AContextUsage: TContextUsage;
      const AContextValue: string; const AUserNameType: TUserNameType;
      const AUserNameUsage: TUserNameUsage; const AUserNameValue: string;
      const ADefaultValue: string; const ACallingMethod: string): string;
    function GetLocalKeybox: string;
    function GetLocalKeyboxExists: Boolean;
    function GetLocalKeyboxPath: string;
    function GetLocalKeyboxWarnings: string;
    function GetLocalKeyboxXmlOK: Boolean;
    function GetPropertyList: TStrings;
    procedure SetPropertyList(const Value: TStrings);
    function GetZaphodKey(Index: Integer): TZaphodKey;
    function GetZaphodKeyCount: Integer;
    function IsDesigning: Boolean;
    function KeyAlreadyInitialized(const AKeyGroupName, AKeyName: string;
      const AContextRequestUsage: TContextUsage;
      const AContextRequestValue: string;
      const AUserNameRequestUsage: TUserNameUsage;
      const AUserNameRequestValue : string;
      const AKeyedFileName: string): Boolean;
    procedure RaiseException(const AMessage: string; MethodName: string);
    procedure RaiseExceptionFmt(const AMessage: string;
      const Args: array of const; MethodName: string);
    procedure SetLocalKeyboxPrefix(const Prefix: string);
    procedure SetLocalKeyboxPrefixEnabled(const Value: Boolean);
    procedure SetProjectOptions(const Value: IZaphodProjectOptions);
    procedure SetZaphodBranch(const Value: string);
  protected
    procedure InitBranchKeybox;
    procedure InitLocalKeybox;
    property BranchKeyboxXml: TZaphodXmlDoc read FBranchKeyboxXml
      write FBranchKeyboxXml;
    property LocalKeyboxXml: TZaphodXmlDoc read FLocalKeyboxXml
      write FLocalKeyboxXml;
  public
    constructor Create(AOwner: TComponent); override;
    class function CreateForBranch(AOwner: TComponent;
      const AZaphodBranch: string): TZaphodsMap;
    class function CreateForService(AOwner: TComponent;
      const AZaphodBranch: string = ''; const ALocalKeyboxPrefix: string = ''):
      TZaphodsMap;
    destructor Destroy; override;
    function ActivateKey(const KeyGroupName, KeyName: string;
      const ContextUsage: TContextUsage; const UserNameUsage: TUserNameUsage;
      const RequiredRootNodeName: string;
      const DefaultKeyedFileName: string = ''): TZaphodKey;
    function ActivateKeyDoc(const KeyGroupName, KeyName: string;
      const ContextUsage: TContextUsage; const UserNameUsage: TUserNameUsage;
      const RequiredRootNodeName: string;
      const DefaultKeyedFileName: string = ''): TZaphodXmlDoc;
    function ActivateTempKey(const KeyedFileName, RequiredRootNodeName: string):
       TZaphodKey;
    function ActivateTempKeyDoc(const KeyedFileName,
      RequiredRootNodeName: string): TZaphodXmlDoc;
    function KeyedFileName(const KeyGroupName: string; const KeyName: string;
      const ContextUsage: TContextUsage; const UserNameUsage: TUserNameUsage;
      const DefaultFileName: string): string;
    function KeyedFolder(const KeyGroupName: string; const KeyName: string;
      const ContextUsage: TContextUsage; const UserNameUsage: TUserNameUsage;
      const DefaultFolderName: string): string;
    function KeyedValue(const KeyGroupName: string; const KeyName: string;
      const ContextUsage: TContextUsage; const UserNameUsage: TUserNameUsage;
      const DefaultValue: string): string;
    procedure DeactivateAllKeys;
    procedure DeactivateKey(const Index: Integer);
    procedure Reset;
    procedure SetLocalKeyboxLocation(
      const ALocalKeyboxLocation: TLocalKeyboxLocation;
      const ACustomPath: string = '');
    property LastKeyedDetail: TKeyedDetail read FLastKeyedDetail;
    property ZaphodKeys[Index: Integer]: TZaphodKey read GetZaphodKey;
    property ProjectOptions: IZaphodProjectOptions read FProjectOptions
      write SetProjectOptions;
    {events}
    // OnBranchKeyboxChanged
    // OnLocalKeyboxChanged
  published
    property BranchKeybox: string read FBranchKeybox ;
    property BranchKeyboxExists: Boolean read FBranchKeyboxExists;
    property BranchKeyboxXmlOK: Boolean read FBranchKeyboxXmlOK;
    property BranchKeyboxWarnings: string read GetBranchKeyboxWarnings;
    property DefaultMapContext: string read FDefaultMapContext;
    property DefaultUserName: string read FDefaultUserName;
    property ErrorDetailAllowed: TErrorDetailAllowedSet read FErrorDetailAllowed
      write FErrorDetailAllowed;
    property ExecutableNameNoExt: string read FExecutableNameNoExt;
    property ExecutablePath: string read FExecutablePath;
    property KeyLastError: string read FKeyLastError;
    property LibraryNameNoExt: string read FLibraryNameNoExt;
    property LibraryPath: string read FLibraryPath;
    property LocalKeybox: string read GetLocalKeybox;
    property LocalKeyboxExists: Boolean read GetLocalKeyboxExists;
    property LocalKeyboxLocation: TLocalKeyboxLocation
      read FLocalKeyboxLocation;
    property LocalKeyboxPath: string read GetLocalKeyboxPath;
    property LocalKeyboxPrefix: string read FLocalKeyboxPrefix
      write SetLocalKeyboxPrefix;
    property LocalKeyboxPrefixEnabled: Boolean read FLocalKeyboxPrefixEnabled
      write SetLocalKeyboxPrefixEnabled;
    property LocalKeyboxWarnings: string read GetLocalKeyboxWarnings;
    property LocalKeyboxXmlOK: Boolean read GetLocalKeyboxXmlOK;
    property PropertyList: TStrings read GetPropertyList write SetPropertyList
      stored False;
    property ZaphodBranch: string read FZaphodBranch write SetZaphodBranch;
    property ZaphodKeyCount: Integer read GetZaphodKeyCount;
    property ZaphodsMapEnvVarExists: Boolean read FZaphodsMapEnvVarExists;
    property ZaphodsMapRootFolder: string read FZaphodsMapRoot;
    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
    property OnKeyedFileReloaded: TKeyedFileChangedEvent
      read FOnKeyedFileReloaded write FOnKeyedFileReloaded;
  end;

  TZaphodsMapAdmin = class(TZaphodsMap)
  private
    function GetBranchKeyboxXml: TZaphodXmlDoc;
  public
    class function CreateForBranch(AOwner: TComponent;
      const AZaphodBranch: string): TZaphodsMapAdmin;
    function ActivateKeyEx(const KeyGroupName, KeyName: string;
      const ContextUsage: TContextUsage; const Context: string;
      const UserNameUsage: TUserNameUsage; const UserName: string;
      const RequiredRootNodeName: string;
      const DefaultKeyedFileName: string = ''): TZaphodKey;
    function ActivateKeyDocEx(const KeyGroupName, KeyName: string;
      const ContextUsage: TContextUsage; const Context: string;
      const UserNameUsage: TUserNameUsage; const UserName: string;
      const RequiredRootNodeName: string;
      const DefaultKeyedFileName: string = ''): TZaphodXmlDoc;
    function ActivateTempKeyEx(const KeyedFileName,
      RequiredRootNodeName: string; const ContextUsage: TContextUsage;
      const Context: string; const UserNameUsage: TUserNameUsage;
      const UserName: string): TZaphodKey;
    function ActivateTempKeyDocEx(const KeyedFileName,
      RequiredRootNodeName: string; const ContextUsage: TContextUsage;
      const Context: string; const UserNameUsage: TUserNameUsage;
      const UserName: string): TZaphodXmlDoc;
    function KeyedFileNameEx(const KeyGroupName: string; const KeyName: string;
      const ContextUsage: TContextUsage; const ContextValue: string;
      const UserNameUsage: TUserNameUsage; const UserNameValue: string;
      const DefaultFileName: string): string;
    function KeyedFolderEx(const KeyGroupName: string; const KeyName: string;
      const ContextUsage: TContextUsage; const ContextValue: string;
      const UserNameUsage: TUserNameUsage; const UserNameValue: string;
      const DefaultFolder: string): string;
    function KeyedValueEx(const KeyGroupName: string; const KeyName: string;
      const ContextUsage: TContextUsage; const ContextValue: string;
      const UserNameUsage: TUserNameUsage; const UserNameValue: string;
      const DefaultValue: string): string;
    property BranchKeyboxXml: TZaphodXmlDoc read GetBranchKeyboxXml;
  end;


  {static methods }

  function GetAsVariant(S: string; const Default: Variant;
    out ErrorMessage: string): Variant;

  procedure GetZMKeyProperties(const AKeyType: TZaphodKeyType; var KeyID,
    AttributeID: string);

  function XPathAttr(const AttributeID, AttributeValue: string):string;

  function XPathBuilder(const Args: array of const): string;

  function XPathOfNode(Node: TXmlNode): string;

  function ZaphodKeyedFileName(const ZaphodBranch, AKeyGroupName,
    AKeyName: string; const AContextUsage: TContextUsage;
    const AUserNameUsage: TUserNameUsage;
    const DefaultFileName: string; out KeyedDetail: TKeyedDetail): string;

  function ZaphodKeyedFolder(const ZaphodBranch, AKeyGroupName,
    AKeyName: string; const AContextUsage: TContextUsage;
    const AUserNameUsage: TUserNameUsage;
    const DefaultFolderName: string; out KeyedDetail: TKeyedDetail): string;

  function ZaphodKeyedValue(const ZaphodBranch, AKeyGroupName,
    AKeyName: string; const AContextUsage: TContextUsage;
    const AUserNameUsage: TUserNameUsage;
    const DefaultValue: string; out KeyedDetail: TKeyedDetail): string;

  function ZaphodKeyedFileZNodeAttr(const ZaphodBranch, AKeyGroupName, AKeyName,
    KeyedFileRootName: string; XPath: array of const;
    const AContextUsage: TContextUsage; const AUserNameUsage: TUserNameUsage;
    const AttributeID: string; const DefaultResult: Variant;
    out Warning: string): Variant;

  function ZaphodMinimalXMLDoc(const XSLURL, RootNode, XSDURL,
    Middle: string): string;

  function ZaphodAssertDirectoryFor(const FilePathAndNameOrDirPlusDelim: string;
    var ErrorMessage: string): Boolean;

  procedure ZaphodException(const AMessage: string; const MethodName: string;
   Component: TComponent = nil);

  procedure ZaphodExceptionFmt(const AMessage: string;
    const Args: array of const; const MethodName: string;
    Component: TComponent = nil);


implementation

uses
{$IFDEF CodeSite}CodeSiteLogging,{$ENDIF}  // Raize CodeSite
{$IFNDEF LINUX}
  Windows,
{$ENDIF}
  TypInfo;

type
{$IFDEF CLR}
  TPropArray = TPropList;
{$ELSE}
  TPropArray = array of PPropInfo;
{$ENDIF}



{ Helper functions }

function FileAgeMV(const FileName: string; out FileDateTime: TDateTime): Boolean;
begin
  FileDateTime := 0;
{$IFDEF Delphi10UP}
  Result := FileAge(FileName, FileDateTime);
{$ELSE}
  Result := FileExists(FileName);
  if Result then
    FileDateTime := FileDateToDateTime(SysUtils.FileAge(FileName));
{$ENDIF}
end;


function IsFileAgeChanged(const FileName: string;
  const FileDateTime: TDateTime): Boolean;
var
  RealAge: TDateTime;
begin
  Result := not FileAgeMV(FileName, RealAge) or (RealAge <> FileDateTime);
end;


function FilePathIsAbsolute(const FileName: string): Boolean;
begin
  Result := (ExtractFileDrive(FileName) <> '') or
    (IsPathDelimiter(FileName, 1));
end;


function GetParentDirectory(const FilePath: string): string;
begin
  Result := ExtractFilePath(ExtractFileDir(FilePath));
end;


function CharStartsStr(const Ch: Char; const S: string): Boolean;
begin
  Result := IsDelimiter(Ch, S, 1);
end;


function CharEndsStr(const Ch: Char; const S: string): Boolean;
begin
  Result := IsDelimiter(Ch, S, Length(S));
end;


{$IFNDEF Delphi12UP}
function CharInSet(C: AnsiChar; const CharSet: TSysCharSet): Boolean; overload;
begin
  Result := C in CharSet;
end;

function CharInSet(C: WideChar; const CharSet: TSysCharSet): Boolean; overload;
begin
  Result := (C < #$0100) and (AnsiChar(C) in CharSet);
end;
{$ENDIF}


function LastCharIn(const S: string; const Chars: TSysCharSet): Boolean;
var
  L: Integer;
  Ch: AnsiChar;
begin
  L := Length(S);
  if (L > 0) and (ByteType(S, L) = mbSingleByte) then
  begin
    Ch := AnsiChar(S[L]);
    Result := CharInSet(Ch, Chars);
  end
  else
    Result := False;
//  Result := (L > 0) and (ByteType(S, L) = mbSingleByte) and
//    CharInSet(S[L], Chars);
end;


{$IFDEF CLR}
function GetPropArray(ATypeInfo: TTypeInfo): TPropArray;
begin
  Result := GetPropInfos(ATypeInfo);
end;
{$ELSE}
function GetPropArray(ATypeInfo: PTypeInfo): TPropArray;
begin
  SetLength(Result, GetTypeData(ATypeInfo).PropCount);
  GetPropInfos(ATypeInfo, PPropList(Result));
end;
function CanRead(APropInfo: PPropInfo): Boolean;
begin
  Result := APropInfo.GetProc <> nil;
end;
{$ENDIF}



function ZaphodAssertDirectoryFor(const FilePathAndNameOrDirPlusDelim: string;
    var ErrorMessage: string): Boolean;
var
  Dir: string;
begin
  Result := False;
  ErrorMessage := '';
  try
    Dir := ExtractFilePath(FilePathAndNameOrDirPlusDelim);
    if (not DirectoryExists(Dir)) and (Dir <> '') then
    begin
      if SysUtils.ForceDirectories(Dir) then
        Result := DirectoryExists(Dir)
      else
        ErrorMessage := SysErrorMessage(GetLastError);
    end
    else
      Result := True;
  except
    on E:Exception do
    begin
      ErrorMessage := E.Message;
    end;
  end;
end;



{ XPath helper functions }

{internal use only}
function XPathOfNodeAsStr(Node: TXmlNode; S: string): string;

  function DuplicateQualifier(const Node: TXmlNode): string;
  var
    TagName: string;
    I: Integer;
    TagNameCount: Integer;
    PositionCount: Integer;
  begin
    TagName := Node.Name;
    with Node.Parent do
    begin
      TagNameCount := 0;
      PositionCount := 0;
      for I := NodeCount -1 downto 0 do
      begin
        if Nodes[I].Name = TagName then
        begin
          Inc(TagNameCount);
          if PositionCount > 0 then
            Inc(PositionCount);
        end;
        if Nodes[I] = Node then
          PositionCount := 1;
      end;
    end;
    if TagNameCount > 1 then
      Result := '[' + IntToStr(PositionCount) + ']'
    else
      Result := '';
  end;

begin
  if Length(S) > 1024 then
    ZaphodExceptionFmt(szmXPathOfNodeTooLong, [S], 'XPathOfNode', nil);
  if (Node = nil) or (Node.Parent = nil) then
    Result := '/' + S
  else
  begin
    if S <> '' then
      S := '/' + S;
    Result := XPathOfNodeAsStr(Node.Parent, Node.Name
      + DuplicateQualifier(Node) + S);
  end;
end;


function VarWithDelimIsInUse(const ParentNode: TZaphodNode;
  const AVarWithDelim: string): Boolean;
var
  I: Integer;

  function VarIsInNodeAttributes(const ANode: TZaphodNode;
    const VarWithDelim: string): Boolean;
  var
    I: Integer;
  begin
    Result := False;
    for I := 0 to ANode.AttributeCount do
    begin
      if Pos(VarWithDelim, String(ANode.AttributeValue[I])) > 0 then
      begin
        Result := True;
        Break;
      end;
    end;
  end;

begin
  Result := False;
  if ParentNode <> nil then
  begin
    Result := VarIsInNodeAttributes(ParentNode, AVarWithDelim);
    if (Result = False) then
    begin
      if ParentNode.NodeCount = 0 then
        Result := Pos(AVarWithDelim, String(ParentNode.ValueAsString)) > 0
      else
      begin
        for I := 0 to ParentNode.NodeCount - 1 do
        begin
          Result := VarWithDelimIsInUse(ParentNode.Nodes[I],
            AVarWithDelim);
          if Result then
            Break;
         end;
      end;
    end;
  end;
end;


function VarDelimitersInUseForNode(const ParentNode: TZaphodNode;
  const BeginDelim, EndDelim: string): Boolean;
var
  I: Integer;

  function DelimsAreInNodeAttributes(const ANode: TZaphodNode): Boolean;
  var
    I: Integer;
  begin
    Result := False;
    for I := 0 to ANode.AttributeCount do
      if (Pos(BeginDelim, String(ANode.AttributeValue[I])) > 0)
        and (Pos(BeginDelim, String(ANode.AttributeValue[I])) > 0)then
      begin
        Result := True;
        Break;
      end;
  end;

begin
  Result := False;
  if ParentNode <> nil then
  begin
    Result := DelimsAreInNodeAttributes(ParentNode);
    if (Result = False) then
    begin
      if ParentNode.NodeCount = 0 then
        Result := (Pos(BeginDelim, String(ParentNode.ValueAsString)) > 0)
          and (Pos(EndDelim, String(ParentNode.ValueAsString)) > 0)
      else
      begin
        for I := 0 to ParentNode.NodeCount - 1 do
        begin
          Result := VarDelimitersInUseForNode(ParentNode.Nodes[I],
            BeginDelim, EndDelim);
          if Result then
            Break;
         end;
      end;
    end;
  end;
end;


function ContextUsageAsString(const ContextUsage: TContextUsage): string;
begin
  case ContextUsage of
    cxNone: Result := 'cxNone';
    cxOptional: Result := 'cxOptional';
    cxRequired: Result := 'cxRequired';
  end;
end;


procedure MakeNodeFirst(Node: TZaphodNode);
var
  Parent: TZaphodNode;
begin
  if Assigned(Node) then
  begin
    Parent := Node.Parent;
    if Assigned(Parent) and (Parent.NodeIndexOf(Node) > 0) then
    begin
      Parent.NodeExtract(Node);
      Parent.NodeInsert(0, Node);
    end;
  end;
end;



{TZaphodXmlDocument }

constructor TZaphodXmlDoc.Create(const AFileName, ARequiredRootNodeName,
  AContextDefault: string; const AContextAttributeID: string = 'context');
begin
  inherited Create;
  FZaphodKey := nil;
  FZaphodsMap := nil;
  ClearLastNodeDetails;
  FFilePathAndName := AFileName;
  FRequiredRootNodeName := ARequiredRootNodeName;
  FContextDefault := AContextDefault;
  FContextAttributeID := AContextAttributeID;
  FWarnings := TStringList.Create;
  FXsdSummary := nil;
  FContextSupported := False;
  FDeleteEmptyNodesOnSave:= False;
  //FValidatesOK := False;
  //FValidationAttempted := False;
  FXsdSummarySet := False;
end;

destructor TZaphodXmlDoc.Destroy;
begin
  {1.032 start}
  if Assigned(FFileStreamForUpdate) then
  begin
    if FUpdateInProgress then
      CancelUpdate;  // this will FreeAndNil(FFileStreamForUpdate)
  end;
  {1.032 end}
  FreeAndNil(FWarnings);
  FreeAndNil(FXsdSummary);
  inherited Destroy;
end;


{ TZaphodXmlDocument - private methods }

procedure TZaphodXmlDoc.ClearLastNodeDetails;
begin
  FLastNode := nil;
  FLastNodeAttrFound := False;
  FLastNodeContextUsage := cxOptional;
  FLastNodeContextUsed := False;
  FLastNodeContextValue := '';
  FLastNodeSelectAttrID := '';
end;


function TZaphodXmlDoc.FormatFileLoadSaveError(const Action,
  Reason: string): string;
var
  S: string;
begin
  if FZaphodKey <> nil then
  begin
    S := FZaphodKey.GetKeyedFileNameIfAllowed;
    if S <> '' then
      S := sLineBreak + 'Filename: ' + S;
    Result :=  Format(szmKeyedFileLoadSaveError, [Action,
     FZaphodKey.KeyedDetail.KeyDesc, Reason + S]);
  end
  else
  begin
    S := GetFileNameIfAllowed;
    if S <> '' then
      S := sLineBreak + 'Filename: ' + S;
    Result :=  Format(szmFileLoadSaveError, [Action, Reason + S]);
  end;
end;


function TZaphodXmlDoc.GetFileNameIfAllowed: string;
begin
  if (edFilePathsAndNames in FZaphodsMap.FErrorDetailAllowed) then
    Result := FFilePathAndName
  else
  if (edFileNames in FZaphodsMap.FErrorDetailAllowed) then
    Result := ExtractFileName(FFilePathAndName)
  else
    Result := '';
  if Result <> '' then
    Result := '"' + Result + '"';
end;

function TZaphodXmlDoc.GetKeyIndex: Integer;
begin
  if FZaphodKey <> nil then
    Result := FZaphodKey.KeyIndex
  else
    Result := -1;
end;

function TZaphodXmlDoc.GetXPathElements(const XPath: string): TXPathElements;
const
  cValidTagIDChars = ['a'..'z', 'A'..'Z', '_', '0'..'9'];
var
  I: Integer;
  Ch: Char;
  NewElementFound: Boolean;
  NewAttributeDefFound: Boolean;
  InTagID: Boolean;
  InAttributeDef: Boolean;
  InAttributeValue: Boolean;
  InPosDef: Boolean; {1.020}
  PosDefValue: string; {1.020}
  InBetween: Boolean;
  S: string;
  LeftBracketJustFound: Boolean;


  procedure RaiseInvalidXPathSyntax(const I: Integer);
  begin
    SetLength(Result, 0);
    RaiseExceptionFmt(szmXPathInvalidSyntax, [XPath, I], 'GetXPathElements');
  end;

  function ValidAttributeID(const S: string; out ErrorPos: Integer): Boolean;
  var
    I: Integer;
  begin
    ErrorPos := 0;
    Result := False;
    if Length(S) > 0 then
    begin
      Result := True;
      for I := 1 to Length(S) do
      begin
        if (ByteType(S, I) = mbSingleByte) and
          CharInSet(S[I], ['''', '/', '[', ']', ' ', #9]) then
        begin
          Result := False;
          ErrorPos := I;
          Break;
        end;
      end;
    end;
  end;

  procedure ProcessAttribute(var XPathAttribute: TXPathAttribute);
  var
    I: Integer;
    ErrorPos, P: Integer;
    S: string;
  begin
  { Extract  xaDefinition         e.g. @name="WebHub" or @name='WebHub'
    into     xaAttributeID        e.g  name
    and      xaAttributeValue     e.g. WebHub  }
    with XPathAttribute do
    begin
      ErrorPos := 0;
      I := Pos('=', xaDefinition);
      if I > 0 then
      begin
        {extract the attribute ID}
        S := Trim(Copy(xaDefinition, 1, I-1));
        xaAttributeID := Copy(S, 2, MaxInt); { drop the leading @}
        if not CharStartsStr('@', S) then
          ErrorPos := 1
        else
        begin
          if not ValidAttributeID(xaAttributeID, P) then
            ErrorPos := P + 1;
        end;
        {extract the attribute value}
        if ErrorPos = 0 then
        begin
          S := Trim(Copy(xaDefinition, I+1, MaxInt));
          {attribute value must start and end with either " or '}
          if CharStartsStr('"', S) then
          begin
            if not CharEndsStr('"', S) then
              ErrorPos := I + Length(S);
          end
          else
          if CharStartsStr('''', S) then
          begin
            if not CharEndsStr('''', S) then
              ErrorPos := I + Length(S);
          end
          else
            ErrorPos := I+1;
          if ErrorPos = 0 then
            xaAttributeValue := Copy(S, 2, Length(S) - 2);
        end;
      end
      else
       ErrorPos := 1;
      if ErrorPos <> 0 then
        RaiseInvalidXPathSyntax(xaDefinitionStartAt+ErrorPos);
    end;
  end;

  procedure ProcessPreviousElement;
  var
    I: Integer;
  begin
    if High(Result) > -1 then
    begin
      with Result[High(Result)] do
      begin
        for I := 0 to High(xeAttributes) do
          ProcessAttribute(xeAttributes[I]);
      end;
    end;
  end;

begin
  SetLength(Result, 0);
  if Length(XPath) > 0 then
  begin
    if not CharInSet(XPath[1], cValidTagIDChars) then
      RaiseInvalidXPathSyntax(1)
    else
      if not LastCharIn(XPath, cValidTagIDChars + [']']) then
        RaiseInvalidXPathSyntax(Length(XPath));

    InTagID := True;
    InAttributeDef := False;
    InAttributeValue := False;
    InPosDef := False; {1.020}
    PosDefValue := ''; {1.020}
    InBetween := False;
    NewElementFound := True;
    NewAttributeDefFound := False;
    S := '';
    LeftBracketJustFound := False;

    {e.g. KeyGroups/KeyGroup[@name="WebHub" and @level="1"']}
    {  or KeyGroups/KeyGroup[@name="WebHub"][@level="1"]}
    {  or KeyGroups/KeyGroup[2][@level="1"]}
    {  or KeyGroups/KeyGroup[2]}
    for I := 1 to Length(XPath) do
    begin
      Ch := XPath[I];
      if NewElementFound then
      begin
        ProcessPreviousElement;
        SetLength(Result, High(Result)+2);
        with Result[High(Result)] do
        begin
          xeTagPos := -1; {1.020}
          xeXsdSummaryParentNode := nil;
          xeXsdSummaryChildIndex := -1;
        end;
        NewElementFound := False;
      end
      else
      begin
        with Result[High(Result)] do
        begin
          if NewAttributeDefFound then
          begin
            SetLength(xeAttributes, High(xeAttributes)+2);
            NewAttributeDefFound := False;
            xeAttributes[High(xeAttributes)].xaDefinitionStartAt := I;
          end;
        end;
      end;

      with Result[High(Result)] do
      begin
        {if processing tagID}
        if InTagID then
        begin
          if (ByteType(XPath, I) = mbSingleByte) then
          begin
            if CharInSet(Ch, cValidTagIDChars) then
              xeTagName := xeTagName + Ch
            else
            begin
              case Ch of
                ' ', #9:
                  begin
                    InTagID := False;
                    InBetween := True;
                  end;
                '/':
                  begin
                    InTagID := True;
                    NewElementFound := True;
                  end;
                '[':
                  begin
                    InTagID := False;
                    {1.020 start}
                    if (I < Length(XPath)) and (XPath[I+1] <> '@') then
                    begin
                      InPosDef := True;
                    end
                    else
                    begin
                    {1.020 end}
                      InAttributeDef := True;
                      InAttributeValue := False;
                      NewAttributeDefFound := True;
                      LeftBracketJustFound := True;
                    end; {1.020}
                  end;
                else
                  RaiseInvalidXPathSyntax(I);
              end;
            end
          end
          else
            xeTagName := xeTagName + Ch; {part of multi-byte character}
        end
        else
        {if processing Attribute Definition}
        if InAttributeDef then  { eg. [@name="WebHub"]}
        begin
          if (ByteType(XPath, I) = mbSingleByte) then
          begin
            case Ch of
              '"':
                begin
                  InAttributeValue := not InAttributeValue;
                end;
              ']':
                begin
                  if not InAttributeValue then
                  begin
                    InAttributeDef := False;
                    InAttributeValue := False;
                    InBetween := True;
                    LeftBracketJustFound := False;
                  end;
                end;
              '@':
                begin
                  if (not LeftBracketJustFound) and (not InAttributeValue) then
                  begin
                    with Result[High(Result)] do
                    begin
                      if High(xeAttributes) > 0 then
                      begin
                        {must be 2nd or greater attribute definition within
                         [   ]  }
                        SetLength(xeAttributes, High(xeAttributes)+2);
                        xeAttributes[High(xeAttributes)].xaDefinitionStartAt
                          := I;
                      end;
                    end;
                  end;
                  LeftBracketJustFound := False;
                end;
            end;
          end;

          if InAttributeDef then
            with xeAttributes[High(xeAttributes)] do
              xaDefinition := xaDefinition + Ch;
        end
        else
        {1.020 start}
        if InPosDef then
        begin
          if Ch = ']' then
          begin
            InPosDef := False;
            xeTagPos := StrToIntDef(PosDefValue, -1);
            PosDefValue := '';
            InBetween := True; {1.028}
            if xeTagPos = -1 then
              RaiseInvalidXPathSyntax(I);
          end
          else
            PosDefValue := PosDefValue + Ch;
        end
        else
        {1.020 end}
        {if in between TagID and/or Attribute Definition}
        if InBetween then
        begin
          if (ByteType(XPath, I) = mbSingleByte) then
          begin
            case Ch of
              '/':
                begin
                  InTagID := True;
                  NewElementFound := True;
                  InBetween := False;
                end;
              '[':
                begin
                  InAttributeDef := True;
                  InAttributeValue := False;
                  NewAttributeDefFound := True;
                  InBetween := False;
                  LeftBracketJustFound := True;
                end;
            end;
          end;
        end;
      end;
    end;

    if InAttributeDef then
      RaiseInvalidXPathSyntax(Length(XPath))
    else
      ProcessPreviousElement;
  end;
end;

function CorrespondingXsdSummaryNode(ANode: TXmlNode;
  XsdSummary: TXmlNode): TXmlNode;
var
  NodeArray: array of TXmlNode;
  BNode: TXmlNode;
  I: Integer;
  XsdSummaryRootNode: TXmlNode;
begin
  if (ANode = nil) or (XsdSummary = nil) then
    Result := nil
  else
  begin
    XsdSummaryRootNode := XsdSummary.Nodes[0];
    SetLength(NodeArray, 1);
    {form an hierarchical list of nodes names starting with the ANode and
    ending with the root node}
    NodeArray[0] := ANode;
    BNode := ANode;
    repeat
      BNode := BNode.Parent;
      if (BNode <> nil) and (BNode.Name <> '') then
      begin
        SetLength(NodeArray, High(NodeArray) + 2);
        NodeArray[High(NodeArray)] := BNode;
      end;
    until (BNode = nil) or (BNode.Name = '');

    {return the corresponding xsdsummary node}
    Result := XsdSummaryRootNode;
    for I := High(NodeArray) -1 downto 0 do  { Root, Node, Node ...}
    begin
      Result := Result.NodeByName(NodeArray[I].Name);
      if Result = nil then
        Break;
    end;
    SetLength(NodeArray, 0);
  end;
end;

const
 szmInvalidStartNodeVsXsd = 'Start node is invalid: "%s" not found in XsdSummary';
 szmInvalidXPathVsXsd = 'XPath is invalid: "%s" not found in XsdSummary';



function TZaphodXmlDoc.GetXPathElementsEx(StartNode: TXmlNode;
  const XPath: string; const XPathIsAbsolute: Boolean): TXPathElements;
var
  I: Integer;
  XsdSummaryNode: TXmlNode;
  XPathSoFar: string;
  StartIndex: Integer;
begin
  Result := GetXPathElements(XPath);
  if FXsdSummary <> nil then
  begin
    XPathSoFar := XPathOfNode(StartNode);
    XsdSummaryNode := CorrespondingXsdSummaryNode(StartNode,
      FXsdSummary);
    if XsdSummaryNode = nil then
      RaiseExceptionFmt(szmInvalidStartNodeVsXsd, [XPathSoFar],
        'GetXPathElementsEx');
    if XPathIsAbsolute then
      StartIndex := 1
    else
      StartIndex := 0;
    for I := StartIndex to High(Result) do
    begin
      with Result[I] do
      begin
        XPathSoFar := XPathSoFar + '/' + xeTagName;
        xeXsdSummaryParentNode := XsdSummaryNode;
        xeXsdSummaryChildIndex := XsdSummaryNode.NodeIndexByName(xeTagName);
        if xeXsdSummaryChildIndex > -1 then
          XsdSummaryNode := XsdSummaryNode.Nodes[xeXsdSummaryChildIndex]
        else
          RaiseExceptionFmt(szmInvalidXPathVsXsd, [XPathSoFar],
           'GetXPathElementsEx');
      end;     
    end;
  end;
end;

procedure TZaphodXmlDoc.RaiseException(const AMessage:
  string; MethodName: string);
begin
  if (FZaphodsMap <> nil) then
  begin
    if not (edMethodNames in FZaphodsMap.FErrorDetailAllowed) then
      MethodName := '';
  end
  else
    if not (edMethodNames in FErrorDetailAllowed) then
      MethodName := '';
  ZaphodException(AMessage, MethodName, nil);
end;


procedure TZaphodXmlDoc.RaiseExceptionFmt(const AMessage: string;
  const Args: array of const; MethodName: string);
begin
  RaiseException(Format(AMessage, Args), MethodName);
end;


function TZaphodXmlDoc.ZNodeCommon(StartNode: TZaphodNode; XPath: string;
  const CreateIfNotFound: Boolean): TZaphodNode;
var
  ANode: TXmlNode;
  AParentNode: TXmlNode;
  ANodeList: TXmlNodeList;
  XPathElements: TXPathElements;
  I, J, K: Integer;
  XPathIsAbsolute: Boolean;
  StartElementIdx: Integer;
  ContextAttributeIDIsInXPath: Boolean;
  //AParentXsdNode: TXmlNode;
  InsertIndex: Integer;
  ASiblingList: TXmlNodeList;
  xsNameAttribute: string; { name of attribute containing unique name for
    sibling nodes}
  NodeIsLeafNode: Boolean;

  function GetInsertIndexViaXsdSummary(AParentNode: TXmlNode;
    const ATagName: string; AXsdSummaryParentNode: TXmlNode;
    const AXsdSummaryChildIndex: Integer): Integer;
  var
    I: Integer;
  begin
    { a sibling for ATagName has not been found in AParentNode, so find node
      for insertion. note: it is safe to reuse ANodeList}
    Result := 0;
    for I := AXsdSummaryChildIndex downto 0 do
    begin
      AParentNode.NodesByName(AXsdSummaryParentNode.Nodes[I].Name, ANodeList);
      if ANodeList.Count > 0 then
      begin
        Result := ANodeList[ANodeList.Count-1].IndexInParent + 1;
        Break;
      end;
    end;
  end;

begin
  Result := nil;
  ANodeList := TXmlNodeList.Create;
  if FXsdSummary <> nil then
    ASiblingList := TxmlNodeList.Create
  else
    ASiblingList := nil;
  ClearLastNodeDetails;
  FLastError := '';
  XPathIsAbsolute := False;
  try
    if StartNode = nil then
    begin
      ANode := Root;
      {remove leading / in the XPath}
      if Copy(Xpath, 1, 1) = '/' then
      begin
        XPath := Copy(XPath, 2, MaxInt);
        XPathIsAbsolute := True;
      end;
    end
    else
    begin
      if CharStartsStr('/', XPath) then
        RaiseExceptionFmt(szmXPathRelativePathRequired, [XPath], 'ZNodeCommon');
      {1.024}
      if CharStartsStr('[', XPath) then
      begin
        ANode := nil;
        RaiseExceptionFmt(szmXPathInvalidSyntax, [XPath, 1], 'ZNodeCommon');
      end
      else
      {1.024}
      ANode := StartNode;
    end;

    //XPathElements := GetXPathElements(XPath); 1.034

    XPathElements := GetXPathElementsEx(ANode, XPath, XPathIsAbsolute); {1.034}

    if XPathIsAbsolute then
    begin
      StartElementIdx := 1;
      if (Length(XPathElements) > 0) then
      begin

        if (not SameText(XPathElements[0].xeTagName, Root.Name)) then
        begin
          {root node in XPath is invalid}
          StartElementIdx := High(XPathElements) + 1;{prevent further searching}
          ANode := nil;
          RaiseExceptionFmt(szmErrorFindingNodeAsInvalidRoot,
            [XPathElements[0].xeTagName, Root.Name, FullXPath(StartNode,
            XPath)], 'ZNodeCommon');
        end;
      end;
    end
    else
      StartElementIdx := 0;

    ContextAttributeIDIsInXPath := False;
    for I := StartElementIdx to High(XPathElements) do
    begin
      AParentNode := ANode;
      with XPathElements[I] do
      begin
        if I = High(XPathElements) then
          for K := 0 to High(xeAttributes) do
            if xeAttributes[K].xaAttributeID = FContextAttributeID then
              ContextAttributeIDIsInXPath := True;

        {if attributes are in the XPath tag, or this is the last element in
         the XPath and the ContextAttribute is not blank so needs to be NOT
         present when finding, then scan a list of contenders }
        if (Length(xeAttributes) <> 0)
          or ((I = High(XPathElements)) and (FContextAttributeID <> '')
            and (not ContextAttributeIDIsInXPath)) then
        begin
          ANode.NodesByName(xeTagName, ANodeList); {all nodes named xeTagName}
          {1.020 start}
          if xeTagPos <> -1 then
          begin
            if (xeTagPos > 0) and (xeTagPos <= ANodeList.Count) then
            begin
              ANode := ANodeList[xeTagPos-1];
              ANodeList.Clear;
              ANodeList.Add(ANode); { node corresponging to xeTagPos}
            end
            else
              ANodeList.Clear;
          end;
          {1.020 end}
          ANode := nil;
          for J := 0 to ANodeList.Count - 1 do
          begin
            if Length(xeAttributes) > 0 then
            begin
              for K := 0 to High(xeAttributes) do
              begin
                {if any required attributes do not match, then exit the loop}
                if ANodeList[J].AttributeByName[xeAttributes[K].xaAttributeID]
                  <>  xeAttributes[K].xaAttributeValue then
                   Break
                else
                  if K = High(xeAttributes) then
                    ANode := ANodeList[J]; {all attributes found and values
                                            match}
              end;
            end
            else
            begin
              if (I = High(XPathElements)) and (ANodeList.Count > 0) then
                ANode := ANodeList[J]; { first with xeTagName as no attributes}
                // ANodeList[J] was ANodeList[0] 07-Dec-2006
                // comment out "and (ANodeList.Count > 0)" 07-Dec-2006
            end;
            if ANode <> nil then
            begin
              {test for presence of FContextAttributeID on the last element}
              if (I = High(XPathElements)) and (FContextAttributeID <> '')
                and (not ContextAttributeIDIsInXPath)
                and (ANode.HasAttribute(FContextAttributeID)) then
                ANode := nil  {no match as FContextAttributeID present}
              else
                Break;
            end;
          end;
        end
        else
        begin {1.020}
          if xeTagPos = -1 then {1.020}
            ANode := ANode.NodeByName(xeTagName) {was FindNode v1.013}
          {1.020 start}
          else
          begin
            ANode.NodesByName(xeTagName, ANodeList); {all nodes named xeTagName}
            if (xeTagPos > 0) and (xeTagPos <= ANodeList.Count) then
              ANode := ANodeList[xeTagPos-1]
            else
              ANode := nil;
          end;
        end;
        {1.020 end}

        if ANode = nil then
        begin
          if CreateIfNotFound = False then
            Break
          else
          begin
            {create the node represented by XPathElements[I]}
            {1.034 start}
            if FXsdSummary <> nil then
            begin
              { we have
                FContextSupported,
                node is leaf if I = High(XPathElements)
                  node may contain context attribute (if leaf node)
                xeXsdSummaryParentNode
                xeXsdSummaryChildindex
              }
              xsNameAttribute := xeXsdSummaryParentNode.Nodes[
                xeXsdSummaryChildindex].AttributeByName['xsNameAttribute'];
              {get a list of siblings}
              {first get all nodes named xeTagName, then filter by attributes}
              AParentNode.NodesByName(xeTagName, ANodeList);
              {siblings must have matching attributes (except for context)}
              ASiblingList.Clear;
              for J := 0 to ANodeList.Count - 1 do
              begin
                if (xsNameAttribute <> '') then
                begin
                  if Length(xeAttributes) > 0 then
                  begin
                    for K := 0 to High(xeAttributes) do
                    begin
                      if (xeAttributes[K].xaAttributeID = xsNameAttribute)
                       and (ANodeList[J].AttributeByName[xsNameAttribute] =
                         xeAttributes[K].xaAttributeValue)
                       then
                       begin
                         ASiblingList.Add(ANodeList[J]);
                         Break;
                       end;
                    end;
                  end
                  else
                    ASiblingList.Add(ANodeList[J]);
                end
                else
                  ASiblingList.Add(ANodeList[J]);
              end;
              ANodeList.Clear;

              NodeIsLeafNode := (I = High(XPathElements)) and (
                xeXsdSummaryParentNode.Nodes[xeXsdSummaryChildIndex].NodeCount
                = 0);
              if ASiblingList.Count = 0 then
                {no same-name/ same-xsName attribute sibling exists}
                InsertIndex := GetInsertIndexViaXsdSummary(
                   AParentNode, xeTagName, xeXsdSummaryParentNode,
                   xeXsdSummaryChildIndex)
              else
              begin
                if NodeIsLeafNode and (not ContextAttributeIDIsInXPath) then
                  {insert before first sibling}
                  InsertIndex := ASiblingList[0].IndexInParent
                else
                  {insert after last sibling}
                  InsertIndex := ASiblingList[ASiblingList.Count-1].IndexInParent
                    + 1;
              end;
              ANode := AParentNode.NodeNewAtIndex(InsertIndex, xeTagName);

            end
            else
            {1.034 end}
              ANode := AParentNode.NodeNew(xeTagName);
            for J := 0 to High(xeAttributes) do
              ANode.AttributeByName[xeAttributes[J].xaAttributeID] :=
                xeAttributes[J].xaAttributeValue;
          end;
        end;
      end;
    end;
  finally
    FreeAndNil(ANodeList);
    FreeAndNil(ASiblingList);
  end;
  if ANode <> nil then
  begin
    Result := ANode;
    FLastNode := Result;
  end;
end;


function TZaphodXmlDoc.ZCNodeCommon(StartNode: TZaphodNode; XPath: string;
  const AContextUsage: TContextUsage; const AContext: string;
  const CreateIfNotFound: Boolean):
  TZaphodNode;
var
  AZNode: TZaphodNode;

begin
  {1.024}
  if (XPath = '') and (AContextUsage <> cxNone) then
  begin
    RaiseExceptionFmt(szmXPathCannotBeBlankWhenUsingContext,
      [XPathOfNode(StartNode), ContextUsageAsString(AContextUsage)],
      'ZCNodeCommon');
  end;
  {1.024}
  AZNode := ZNode(StartNode, [XPath, '@' + FContextAttributeID, AContext]);
  if (AZNode <> nil) then {Node was found with context}
    FLastNodeContextUsed := True;
  if (AZNode = nil) then
  begin
    if (AContextUsage = cxOptional) then
    begin
      AZNode := ZNodeCommon(StartNode, XPath, CreateIfNotFound);
      FLastNodeContextUsed := False;
    end
    else
    if (AContextUsage = cxRequired) and (CreateIfNotFound = True) then
    begin
      AZNode := ZNodeCommon(StartNode, XPathBuilder([XPath,
        '@' + FContextAttributeID, AContext]), True);
      FLastNodeContextUsed := True;
    end;
  end;
  FLastNodeContextUsage := AContextUsage;
  FLastNodeContextValue := AContext;
  if AZNode <> nil then
  begin
    Result := AZNode;
    FLastNode := Result;
  end
  else
    Result := nil;
end;


procedure TZaphodXmlDoc.LoadFromFile(const FileName: string);
begin
  //inherited LoadFromFile(FileName);
  RaiseExceptionFmt(szmInvalidCallToLoadOrSave, ['LoadFromFile', 'LoadFile'],
    'LoadFromFile');
end;


procedure TZaphodXmlDoc.SaveToFile(const FileName: string);
begin
//  inherited SaveToFile(FileName);
  RaiseExceptionFmt(szmInvalidCallToLoadOrSave, ['SaveToFile', 'SaveFile'],
    'SaveToFile');
end;


function TZaphodXmlDoc.VarGetDelimiters(out BeginDelim: string;
  out EndDelim: string): Boolean;
var
  ANode: TZaphodNode;
begin
  BeginDelim := '';
  EndDelim := '';
  ANode := ZNode(nil, ['Variables']);
  if (ANode <> nil) then
  begin
    BeginDelim :=  ANode.AttributeByName['begin'];
    EndDelim := ANode.AttributeByName['end'];
  end;
  Result := (BeginDelim <> '') and (EndDelim <> '');
end;


function TZaphodXmlDoc.VarValue({const ANode: TZaphodNode;}
  const AVarName: string): string;
//var
//  ParentNode: TXmlNode;
begin
  {Result := '';
  if ANode <> Root then
  begin
    ParentNode := ANode.Parent;
    if ParentNode <> nil then
    begin
      Result := ZNodeAttr(ParentNode, ['Variables/Var', '@name',
        AVarName], cxNone, '', 'value');
      if Result = '' then
        Result := VarValue(ParentNode, AVarName);
    end;
  end;}
  Result := ZNodeAttr(nil, ['Variables/Var', '@name', AVarName], cxNone, '',
   'value');
end;


function TZaphodXmlDoc.ExpandVars(const ANode: TZaphodNode;
  const AValue: string): string;
var
  BeginDelim, EndDelim: string;
  I, J: Integer;
  AVarName: string;
  AVarNameExpanded: string;
  S: string;
  LastNodeDetails: TLastNodeDetails;
begin
  Result := AValue;
  SaveLastNodeDetails(LastNodeDetails);
  if VarGetDelimiters(BeginDelim, EndDelim) then
  begin
    S := AValue;
    while S <> '' do
    begin
      I := Pos(BeginDelim, S);
      if I > 0 then
      begin
        J := Pos(EndDelim, S);
        if J > I then  {BeginDelim Variable EndDelim found}
        begin
          AVarName := Copy(S, I+Length(BeginDelim), J-I-Length(BeginDelim));
          AVarNameExpanded := VarValue({ANode,} AVarName);
          if AVarNameExpanded <> '' then
          begin
            Result := StringReplace(Result, BeginDelim+AVarName+EndDelim,
              AVarNameExpanded, []);
          end;
          S := Copy(S, J+Length(EndDelim), MaxInt);
        end
        else
          S := '';
      end
      else
        S := '';
    end;
  end;
  RestoreLastNodeDetails(LastNodeDetails);
end;


function TZaphodXmlDoc.VarDelimitersInUse: Boolean;
var
  BeginDelim, EndDelim: string;
begin
  Result := False;
  VarGetDelimiters(BeginDelim, EndDelim);
  if (BeginDelim <> '') and (EndDelim <> '') then
    Result := VarDelimitersInUseForNode(Root, BeginDelim, EndDelim);
end;


function TZaphodXmlDoc.VarIsInUse(ParentNode: TZaphodNode;
  const AVarName: string): Boolean;
var
  BeginDelim, EndDelim: string;
begin
  Result := False;
  VarGetDelimiters(BeginDelim, EndDelim);
  if (BeginDelim <> '') and (EndDelim <> '') then
  begin
    if ParentNode = nil then
      ParentNode := Root;
    Result := VarWithDelimIsInUse(ParentNode, BeginDelim + AVarName + EndDelim);
  end;
end;


procedure TZaphodXmlDoc.DoFileReloaded;
begin
  if Assigned(FZaphodsMap.FOnKeyedFileReloaded) then
    FZaphodsMap.FOnKeyedFileReloaded(FZaphodKey);
end;

procedure TZaphodXmlDoc.SaveLastNodeDetails(
  var LastNodeDetails: TLastNodeDetails);
begin
  with LastNodeDetails do
  begin
    lndLastNode := FLastNode;
    lndLastNodeAttrFound := FLastNodeAttrFound;
    lndLastNodeContextUsage := FLastNodeContextUsage;
    lndLastNodeContextUsed := FLastNodeContextUsed;
    lndLastNodeContextValue := FLastNodeContextValue;
    lndLastNodeSelectAttrID := FLastNodeSelectAttrID;
  end;
end;

procedure TZaphodXmlDoc.RestoreLastNodeDetails(
  const LastNodeDetails: TLastNodeDetails);
begin
  with LastNodeDetails do
  begin
    FLastNode:= lndLastNode;
    FLastNodeAttrFound:= lndLastNodeAttrFound;
    FLastNodeContextUsage:= lndLastNodeContextUsage;
    FLastNodeContextUsed:= lndLastNodeContextUsed;
    FLastNodeContextValue:= lndLastNodeContextValue;
    FLastNodeSelectAttrID:= lndLastNodeSelectAttrID;
  end;
end;


function TZaphodXmlDoc.ZNodeAttrCommon(StartNode: TZaphodNode;
  XPath: array of const; const SelectAttributeID: string;
  const DefaultResult: Variant): Variant;
var
  S: string;
  ErrorMessage: string;
begin
  if FLastNode = nil then
  begin
    FLastNodeAttrFound := False;
    FLastNodeContextUsed := False;
    Result := DefaultResult;
  end
  else
  begin
    FLastNodeAttrFound := FLastNode.HasAttribute(SelectAttributeID);
    if FLastNodeAttrFound then {1.029}
    begin                      {1.029}
      S := FLastNode.AttributeByName[SelectAttributeID];
      S := ExpandVars(FLastNode, S);
      Result := GetAsVariant(S, DefaultResult, ErrorMessage);
   {1.029 start}
    end
    else
    begin
      Result := DefaultResult;
      ErrorMessage := '';
    end;
    {1.029 end}
    if ErrorMessage <> '' then
      FWarnings.Add(Format(szmErrorReadingValueForAttribute,
        [SelectAttributeID, FullXPath(StartNode, XPathBuilder(XPath)),
        ErrorMessage]));
  end;
end;

function TZaphodXmlDoc.ZNodeValueCommon(StartNode: TZaphodNode;
  XPath: array of const; const DefaultResult: Variant): Variant;
var
  S: string;
  ErrorMessage: string;
begin
  if FLastNode = nil then
    Result := DefaultResult
  else
  begin
    S := FLastNode.ValueAsString;
    S := ExpandVars(FLastNode, S);
    Result := GetAsVariant(S, DefaultResult, ErrorMessage);
    if ErrorMessage <> '' then
      FWarnings.Add(Format(szmErrorReadingValueForNode,
        [FullXPath(StartNode, XPathBuilder(XPath)), ErrorMessage]));
  end;
end;

{1.030}
function TZaphodXmlDoc.LoadFileCommon(const WithShareDenyWrite: Boolean):
  Boolean;
var
  Stream: TStream;
  Mode: Word;
  ErrorMsg: string;
begin
  Result := False;
  FXmlOK := False;
  FLastError := '';
  FFileLoaded := False;
  if FUpdateInProgress then
    RaiseExceptionFmt(szmKeyedFileInvalidCall, ['LoadFile'], 'LoadFile');
  if FileExists(FFilePathAndName) then
  begin
    try
      {1.030 start}
      //inherited LoadFromFile(FFilePathAndName);
      if WithShareDenyWrite then
        Mode := fmOpenRead or fmShareDenyWrite
      else
        Mode := fmOpenRead or fmShareDenyNone;
      Stream := nil; {1.032}
      try
        Stream := TFileStream.Create(FFilePathAndName, Mode);
        LoadFromStream(Stream);
      finally
        FreeAndNil(Stream);
      end;
      {1.030 end}
      {if SameText(Root.Name, FRequiredRootNodeName) then}
      if ValidatesOK(ErrorMsg) then
      begin
        FXmlOK := True;
        FFileLoaded := True;
        Result := True;
      end
      else
        FLastError := FormatFileLoadSaveError(szmLoad, ErrorMsg);
          {Format(szmInvalidRootNode, [Root.Name, FRequiredRootNodeName]));}
    except
      on E:Exception do
      begin
        FLastError := FormatFileLoadSaveError(szmLoad, E.message);
      end;
    end;
  end
  else
    FLastError := FormatFileLoadSaveError(szmLoad, szmFileNotFound);
  FContentBeforeChanges := WriteToString;
  FileAgeMV(FFilePathAndName, FFileAgeBeforeChanges);
end;

procedure TZaphodXmlDoc.SaveDocToStream(Stream: TStream;
  var SavedLength: Integer);
var
  B: TsdBufferedWriteStream;
  FCodecStream: TsdCodecStream;
begin
  B := TsdBufferedWriteStream.Create(Stream, False);
  try
    // Create conversion stream
    FCodecStream := TsdUtf8Stream.Create(B);
    try
      // Set External encoding
      FCodecStream.Encoding := ExternalEncoding;
      WriteToStream(FCodecStream);
      SavedLength := FCodecStream.Size;
    finally
      FreeAndNil(FCodecStream);
    end;
  finally
    FreeAndNil(B);
  end;
end;



{TZaphodXmlDocument - public methods }

procedure TZaphodXmlDoc.ClearWarnings;
begin
  FWarnings.Clear;
end;


function TZaphodXmlDoc.FullXPath(StartNode: TZaphodNode;
  const XPath: string = ''): string;
begin
  if StartNode = nil then
    Result := '/' + XPath
  else
  begin
    Result := XPathOfNode(StartNode);
    if XPath <> '' then
      Result := Result  + '/' + XPath;
  end;
end;


function TZaphodXmlDoc.LoadFile: Boolean;
begin
  Result := LoadFileCommon(False); {was True 1.031}
end;


function TZaphodXmlDoc.SaveFile: Boolean;
var
  ErrorMsg: string;
begin
  Result := False;
  FLastError := '';
  if FUpdateInProgress then
    RaiseExceptionFmt(szmKeyedFileInvalidCall, ['SaveFile'], 'SaveFile');
  if not FFileLoaded then
    RaiseException(szmNotLoadedSoCannotSave, 'SaveFile');
  try
    {if not SameText(Root.Name, FRequiredRootNodeName) then
      FLastError := FormatFileLoadSaveError(szmSave,
        Format(szmInvalidRootNode, [Root.Name, FRequiredRootNodeName]))}
    if FDeleteEmptyNodesOnSave and (Root <> nil) then
      Root.DeleteEmptyNodes;
    if not ValidatesOK(ErrorMsg) then
      FLastError := FormatFileLoadSaveError(szmSave, ErrorMsg)
    else
    begin
      inherited SaveToFile(FFilePathAndName);
      FContentBeforeChanges := WriteToString;
      FileAgeMV(FFilePathAndName, FFileAgeBeforeChanges);
      Result := True;
    end;
  except
    on E:Exception do
    begin
      FLastError := FormatFileLoadSaveError(szmSave, E.message);
    end;
  end;
end;


function TZaphodXmlDoc.BeginUpdate(out FileReloaded: Boolean): Boolean;
var
  ReloadFileReqd: Boolean;
  BeginUpdateStep: string;
begin
  FileReloaded := False;
  FLastError := '';
  if FUpdateInProgress then
    RaiseException(szmInvalidCallToBeginUpdate, 'BeginUpdate');
  if WriteToString <> FContentBeforeChanges then
  begin
    {$IFDEF CodeSite}CodeSite.SendWarning(szmChangesMadeBeforeBeginUpdate +
      Chr(183) + WriteToString + ' not same as ' + FContentBeforeChanges);
    {$ENDIF}
    RaiseException(szmChangesMadeBeforeBeginUpdate, 'BeginUpdate');
  end;  
  ReloadFileReqd := False;
  FileReloaded := False;
  if IsFileAgeChanged(FFilePathAndName, FFileAgeBeforeChanges) then
    ReloadFileReqd := True;

  BeginUpdateStep := 'BeginUpdate';
  FFileStreamForUpdate := nil;
  try
    FFileStreamForUpdate  := TFileStream.Create(FFilePathAndName,
      fmOpenReadWrite or fmShareDenyWrite); {1.017 fmCreate was fmOpenWrite}
      {1.030 fmOpenReadWrite was fmCreate}
    Result := True;
    if ReloadFileReqd then
    begin
      if LoadFileCommon(False) then  {was LoadFile 1.030}
        FileReloaded := True
      else
        Result := False;
    end;
    if Result then
    begin
      FUpdateInProgress := True;
      if FileReloaded then
      begin
        BeginUpdateStep := BeginUpdateStep +' ('+ szmErrorIn
          + ' OnKeyedFileReloaded)';
        DoFileReloaded;
      end;
    end;
  except
    on E:Exception do
    begin
      FLastError := FormatFileLoadSaveError(BeginUpdateStep, E.Message);
      FreeAndNil(FFileStreamForUpdate);
      FUpdateInProgress := False;
      Result := False;
    end;
  end;
end;


procedure TZaphodXmlDoc.CancelUpdate;
begin
  if not FUpdateInProgress then
    RaiseException(szmInvalidCallToCancelUpdate, 'CancelUpdate');
  ReadFromString(FContentBeforeChanges);
  FUpdateInProgress := False;
  FreeAndNil(FFileStreamForUpdate);
end;

function TZaphodXmlDoc.EndUpdate: Boolean;
var
  SavedLength: Integer; {1.030}
  ErrorMsg: string;
begin
  Result := False;
  if not FUpdateInProgress then
    RaiseException(szmInvalidCallToEndUpdate, 'EndUpdate');
  try
    try
      {if not SameText(Root.Name, FRequiredRootNodeName) then
      begin
        FLastError := FormatFileLoadSaveError('EndUpdate for',
          Format(szmInvalidRootNode, [Root.Name, FRequiredRootNodeName]));}
      if FDeleteEmptyNodesOnSave and (Root <> nil) then
        Root.DeleteEmptyNodes;
      if not ValidatesOK(ErrorMsg) then
      begin
        FLastError := FormatFileLoadSaveError('EndUpdate for', ErrorMsg);
        CancelUpdate;
      end
      else
      begin
        { was SaveToStream 1.030}
        SaveDocToStream(FFileStreamForUpdate, SavedLength);
        FFileStreamForUpdate.Size := SavedLength; {1.030}
        FContentBeforeChanges := WriteToString;
        FileAgeMV(FFilePathAndName, FFileAgeBeforeChanges);
        Result := True;
      end;
    except
      on E:Exception do
      begin
        FLastError := FormatFileLoadSaveError('EndUpdate for',
          E.message);
      end;
    end;
  finally
    FUpdateInProgress := False;
    FreeAndNil(FFileStreamForUpdate);
  end;
end;

function TZaphodXmlDoc.ExpandVarsIn(const AValue: string;
  const ANode: TZaphodNode): string;
begin
  Result := ExpandVars(ANode, AValue);
end;

function TZaphodXmlDoc.HasChangedOnDisk: Boolean;
begin
  if FFilePathAndName <> '' then
    Result := IsFileAgeChanged(FFilePathAndName, FFileAgeBeforeChanges)
  else
    Result := False;
end;

function TZaphodXmlDoc.SaveVarDelimiters(const BeginDelimiter: string ='{';
  const EndDelimiter: string = '}'): Boolean;
var
  ExistingBeginDelim, ExistingEndDelim: string;
  ANode: TZaphodNode;
begin
  Result := False;
  FLastError := '';
  VarGetDelimiters(ExistingBeginDelim, ExistingEndDelim);
  if (BeginDelimiter <> ExistingBeginDelim)
    or (EndDelimiter <> ExistingEndDelim) then
  begin
    {if there are existing delimiters and they are in use then cannot save new
     values}
    if VarDelimitersInUse then
      FLastError := Format(szmCannotSaveDelimetersAsInUse, [BeginDelimiter,
        EndDelimiter, ExistingBeginDelim, ExistingEndDelim])
    else
    begin
      ANode := ZNode(nil, ['Variables'], cxNone, True);
      ANode.AttributeByName['begin'] := BeginDelimiter;
      ANode.AttributeByName['end'] := EndDelimiter;
      MakeNodeFirst(ANode);
      Result := True;
    end;
  end
  else
    Result := True;  {specified delimiters already exist}
end;


function TZaphodXmlDoc.SaveVar(const ParentNode: TZaphodNode;
  const VarName, Value: string): Boolean;
var
  ANode: TZaphodNode;
  BeginDelim, EndDelim: string;
begin
  Result := True;
  FLastError := '';
  if VarGetDelimiters(BeginDelim, EndDelim) then
  begin
    ANode := ZNode(ParentNode, ['Variables/Var', '@name', VarName], cxNone,
      True);
    if ANode <> nil then
    begin
      ANode.AttributeByName['value'] := Value;
      MakeNodeFirst(ANode.Parent);
    end;
  end
  else
  begin
    Result := False;
    FLastError := Format(szmVarErrorSavingVariableNoDelims, [VarName]);
  end;
end;


function TZaphodXmlDoc.DeleteVar(const ParentNode: TZaphodNode;
  const VarName: string):
  Boolean;
var
  ANode: TZaphodNode;
begin
  Result := False;
  FLastError := '';
  ANode := ZNode(ParentNode, ['Variables/Var', '@name', VarName]);
  if ANode = nil then
    Result := True { did not exist so already deleted}
  else
  begin
    if VarIsInUse(ParentNode, VarName) then
      FLastError := Format(szmCannotDeleteVarAsInUse, [VarName,
        XPathOfNode(ParentNode)])
    else
    begin
      ANode.Delete;
      Result := True;
    end;
  end;
end;


function TZaphodXmlDoc.ZNode(StartNode: TZaphodNode;
  XPath: array of const; const ContextUsage: TContextUsage = cxNone;
  const AllowCreate: Boolean = False): TZaphodNode;
begin
  if ContextUsage = cxNone then
    Result := ZNodeCommon(StartNode, XPathBuilder(XPath), AllowCreate)
  else
    Result := ZCNodeCommon(StartNode, XPathBuilder(XPath), ContextUsage,
      FContextDefault, AllowCreate);
end;


function TZaphodXmlDoc.ZNodeAttr(StartNode: TZaphodNode;
  XPath: array of const; const ContextUsage: TContextUsage;
  const DefaultResult: Variant; const SelectAttributeID: string = 'value'):
  Variant;
begin
  FLastNode := ZNode(StartNode, XPath, ContextUsage);
  Result := ZNodeAttrCommon(StartNode, XPath, SelectAttributeID, DefaultResult);
end;

const
  szmErrorSavingNodeAttribute ='Error saving node attribute using method "%s":';
  szmErrorSavingNodeValue ='Error saving node value using method "%s":';


function TZaphodXmlDoc.ZNodeAttrSave(StartNode: TZaphodNode;
 XPath: array of const;  const ContextUsage: TContextUsage;
 const Value: Variant; const SelectAttributeID: string = 'value';
 const AllowCreate: Boolean = True): Boolean;
var
  ANode: TZaphodNode;
begin
  Result := False;
  try
    ANode := ZNode(StartNode, XPath, ContextUsage, AllowCreate);
    if ANode <> nil then
    begin
      ANode.AttributeByName[SelectAttributeID] := VarToStr(Value);
      if AllowCreate and (ContextUsage in [cxOptional, cxRequired]) then
        EnsureContextIsLastAttribute(ANode);
      Result := True;
    end;
  except
    on E:Exception do
    begin
      FLastError := Format(szmErrorSavingNodeAttribute, ['ZNodeAttrSave'])
       + E.Message;
    end;
  end;
end;


function TZaphodXmlDoc.ZNodeValue(StartNode: TZaphodNode;
  XPath: array of const; const ContextUsage: TContextUsage;
  const DefaultResult: Variant): Variant;
begin
  FLastNode := ZNode(StartNode, XPath, ContextUsage);
  Result := ZNodeValueCommon(StartNode, XPath, DefaultResult);
end;


function TZaphodXmlDoc.ZNodeValueSave(StartNode: TZaphodNode;
  XPath: array of const; const ContextUsage: TContextUsage;
  const Value: Variant; const AllowCreate: Boolean = True): Boolean;
var
  ANode: TZaphodNode;
begin
  Result := False;
  try
    ANode := ZNode(StartNode, XPath, ContextUsage, AllowCreate);
    if ANode <> nil then
    begin
      ANode.ValueAsString := VarToStr(Value);
      if AllowCreate and (ContextUsage in [cxOptional, cxRequired]) then
        EnsureContextIsLastAttribute(ANode);
      Result := True;
    end;
  except
    on E:Exception do
    begin
      FLastError := Format(szmErrorSavingNodeValue, ['ZNodeValueSave'])
       + E.Message;
    end;
  end;
end;



{TZaphodXmlDocAdmin}

{1.033}
function TZaphodXmlDocAdmin.GetXPathElements(const XPath: string):
  TXPathElements;
begin
  Result := inherited GetXPathElements(XPath);
end;

function TZaphodXmlDocAdmin.ZCNode(StartNode: TZaphodNode; XPath:array of const;
  const ContextUsage: TContextUsage; const Context: string;
  const AllowCreate: Boolean = False): TZaphodNode;
begin
  Result := ZCNodeCommon(StartNode, XPathBuilder(XPath), ContextUsage, Context,
    AllowCreate);
end;


function TZaphodXmlDocAdmin.ZCNodeAttr(StartNode: TZaphodNode;
  XPath: array of const; const ContextUsage: TContextUsage;
  const Context: string; const DefaultResult: Variant;
  const SelectAttributeID: string = 'value'): Variant;
begin
  FLastNode := ZCNode(StartNode, XPath, ContextUsage, Context);
  Result := ZNodeAttrCommon(StartNode, XPath, SelectAttributeID, DefaultResult);
end;


function TZaphodXmlDocAdmin.ZCNodeAttrSave(StartNode: TZaphodNode;
  XPath: array of const; const ContextUsage: TContextUsage;
  const Context: string;  const Value: Variant;
  const SelectAttributeID: string = 'value';
  const AllowCreate: Boolean = True): Boolean;
var
  ANode: TZaphodNode;
begin
  Result := False;
  try
    ANode := ZCNode(StartNode, XPath, ContextUsage, Context, AllowCreate);
    if ANode <> nil then
    begin
      ANode.AttributeByName[SelectAttributeID] := VarToStr(Value);
      if AllowCreate and (ContextUsage in [cxOptional, cxRequired]) then
        EnsureContextIsLastAttribute(ANode);
      Result := True;
    end;
  except
    on E:Exception do
    begin
      FLastError := Format(szmErrorSavingNodeAttribute, ['ZCNodeAttrSave'])
       + E.Message;
    end;
  end;
end;


function TZaphodXmlDocAdmin.ZCNodeValue(StartNode: TZaphodNode;
  XPath: array of const; const ContextUsage: TContextUsage;
  const Context: string; const DefaultResult: Variant): Variant;
begin
  FLastNode := ZCNode(StartNode, XPath, ContextUsage, Context);
  Result := ZNodeValueCommon(StartNode, XPath, DefaultResult);
end;


function TZaphodXmlDocAdmin.ZCNodeValueSave(StartNode: TZaphodNode;
  XPath: array of const; const ContextUsage: TContextUsage;
  const Context: string; const Value: Variant;
  const AllowCreate: Boolean = True): Boolean;
var
  ANode: TZaphodNode;
begin
  Result := False;
  try
    ANode := ZCNode(StartNode, XPath, ContextUsage, Context, AllowCreate);
    if (ANode <> nil) then
    begin
      ANode.ValueAsString := VarToStr(Value);
      if AllowCreate and (ContextUsage in [cxOptional, cxRequired]) then
        EnsureContextIsLastAttribute(ANode);
      Result := True;
    end;
  except
    on E:Exception do
    begin
      FLastError := Format(szmErrorSavingNodeValue, ['ZCNodeValueSave'])
       + E.Message;
    end;
  end;
end;



{TZaphodKey }

constructor TZaphodKey.CreateKey(AOwner: TComponent; const AKeyIndex: Integer;
  const AKeyedFileName, ARequiredRootNodeName: string;
  const AKeyedDetail: TKeyedDetail);
var
  S: string;
begin
  inherited Create(AOwner);
  FKeyedFile := nil;
  FKeyIndex := AKeyIndex;
  FKeyedFileName := AKeyedFileName;
  FKeyedFileRootNodeName := ARequiredRootNodeName;
  with FKeyedDetail do
  begin
    KeyGroupName := AKeyedDetail.KeyGroupName;
    KeyType := ktFile;
    KeyName := AKeyedDetail.KeyName;
    ContextType := AKeyedDetail.ContextType;
    ContextUsage := AKeyedDetail.ContextUsage;
    ContextValue := AKeyedDetail.ContextValue;
    UserNameType := AKeyedDetail.UserNameType;
    UserNameUsage := AKeyedDetail.UserNameUsage;
    UserNameValue := AKeyedDetail.UserNameValue;
    DefaultValue := AKeyedDetail.DefaultValue;
    CallingMethod := AKeyedDetail.CallingMethod;
    KeyDesc := AKeyedDetail.KeyDesc;
    ContextUsed := AKeyedDetail.ContextUsed;
    UserNameUsed := AKeyedDetail.UserNameUsed;
    KeyboxUsed := AKeyedDetail.KeyboxUsed;
    ExceptionOccurred := AKeyedDetail.ExceptionOccurred;
    ErrorMessage := AKeyedDetail.ErrorMessage;
  end;

  FKeyedFilePath := ExtractFilePath(FKeyedFileName);
  FKeyedFilePathParentDir := GetParentDirectory(FKeyedFileName);

  FKeyedFile := TZaphodXmlDoc.Create(FKeyedFileName, ARequiredRootNodeName,
    FKeyedDetail.ContextValue);
  with FKeyedFile do
  begin
    FZaphodKey := self;
    FZaphodsMap := TZaphodsMap(AOwner);
    FContentBeforeChanges := WriteToString;
    FXmlOK := False;
    FUpdateInProgress := False;
    FFileLoaded := False;
    FFileStreamForUpdate := nil;
    XmlFormat := xfReadable;  {default to human readable format}
    if KeyedFileExists then
      S := ''
    else
      S := FormatFileLoadSaveError(szmLocate, szmFileNotFound);
    FLastError := S;
  end;
end;


destructor TZaphodKey.Destroy;
begin
  FreeAndNil(FKeyedFile);
  inherited Destroy;
end;


{ TZaphodKey - private methods}
function TZaphodKey.GetKeyedFileExists: Boolean;
begin
  Result := FileExists(FKeyedFileName);
end;


function TZaphodKey.GetKeyedFileNameIfAllowed: string;
begin
  if (edFilePathsAndNames in TZaphodsMap(self.Owner).FErrorDetailAllowed) then
    Result := FKeyedFileName
  else
  if (edFileNames in TZaphodsMap(self.Owner).FErrorDetailAllowed) then
    Result := ExtractFileName(FKeyedFileName)
  else
    Result := '';
  if Result <> '' then
    Result := '"' + Result + '"';
end;


function TZaphodKey.GetKeyedFileLastError: string;
begin
  Result := FKeyedFile.FLastError;
end;


procedure TZaphodKey.RaiseException(const AMessage: string; MethodName: string);
var
  C: TComponent;
begin
  if not (edMethodNames in TZaphodsMap(self.Owner).FErrorDetailAllowed) then
      MethodName := '';
  if (edComponentNames in TZaphodsMap(self.Owner).FErrorDetailAllowed) then
    C := self
  else
    C := nil;
  ZaphodException(AMessage, MethodName, C);
end;


procedure TZaphodKey.RaiseExceptionFmt(const AMessage: string;
      const Args: array of const; MethodName: string);
begin
  RaiseException(Format(AMessage, Args), MethodName);
end;


{TZaphodKey = public methods}
function TZaphodKey.CreateKeyedFileFromString(const AFileContents: string;
  out ErrorMessage: string): Boolean;
var
  ADoc: TNativeXml;
  ErrorMsg: string;
begin
  ErrorMessage := '';
  if KeyedFile.FUpdateInProgress then
    RaiseExceptionFmt(szmKeyedFileInvalidCall, ['CreateKeyedFileFromString'],
      'CreateKeyedFileFromString');
  Result := False;
  ADoc := nil;
  try
    try
      ADoc := TNativeXml.Create;
      with ADoc do
      begin
        ReadFromString(AFileContents);
        XmlFormat := xfReadable;
        if ZaphodAssertDirectoryFor(FKeyedFileName,ErrorMsg) then
        begin
          SaveToFile(FKeyedFileName);
          Result := True;
        end
        else
          ErrorMessage := Format(szmKeyedFileLoadSaveError, [szmCreate,
            FKeyedDetail.KeyDesc, GetKeyedFileNameIfAllowed + ': '
             + 'unable to create folders in path - ' + ErrorMsg]);
      end;
    except
      on e: Exception do
      begin
        ErrorMessage := Format(szmKeyedFileLoadSaveError, [szmCreate,
          FKeyedDetail.KeyDesc, GetKeyedFileNameIfAllowed + ': ' + E.message]);
      end;
    end;
  finally
    ADoc.Free;
  end;
end;


{ TZaphodsMap }

constructor TZaphodsMap.Create(AOwner: TComponent);
const
  cMaxPathLen = 255;

  function FilePathAndNameForDLL: string;
  {$IFNDEF CLR}
  var
    FileName: array[0..1023] of Char;
    nSize: Cardinal;
  {$ENDIF}
  begin
  {$IFDEF CLR}
    Result := Assembly.GetExecutingAssembly.GetModules[0].FullyQualifiedName;
  {$ELSE}
    nSize := SizeOf(FileName);  // size in bytes
    SetString(Result, FileName,
      GetModuleFileName(HInstance, @FileName, nSize))
  {$ENDIF}
  end;

  function GetLoggedInUserName: string;
  begin
  {$IFDEF LINUX}
    Result := GetEnvironmentVariable('USER');
  {$ELSE}
    Result := SysUtils.GetEnvironmentVariable('USERNAME');
  {$ENDIF}
  end;

begin
  inherited Create(AOwner);
  FZaphodBranch := '';
  FBranchKeyboxXml := nil;
  FLocalKeyboxXml := nil;
  FLocalKeyboxPrefixEnabled := False;
  FDefaultMapContext := '';
  FDefaultUserName := GetLoggedInUserName;
  FOnDestroy := nil;
  FErrorDetailAllowed := [edFileNames, edFilePathsAndNames, edComponentNames,
    edMethodNames];
  FPropertyList := TStringList.Create;
  { executable and/or library path and filename properties}
  if not IsDesigning then
  begin
    FExecutablePath := ExtractFilePath(ParamStr(0));
    FExecutableNameNoExt := ChangeFileExt(ExtractFileName(ParamStr(0)), '');
    if IsLibrary then
    begin
      FLibraryPath := ExtractFilePath(FilePathAndNameForDLL);
      FLibraryNameNoExt := ChangeFileExt(ExtractFileName(FilePathAndNameForDLL),
        '');
      FLocalKeyboxLocation := klLibraryPath;
      FLocalKeyboxPrefix := FLibraryNameNoExt;
    end
    else
    begin
      FLocalKeyboxLocation := klExecutablePath; {can be changed prior to calling
                                                 InitKey}
      FLocalKeyboxPrefix := FExecutableNameNoExt;
      FLibraryPath := '';
      FLibraryNameNoExt := '';
    end;
  end
  else
  begin
     {we are in the Borland Delphi IDE}
    if ProjectOptions.ProjectIsALibrary(GetRootComponent(Self)) then
    begin
      FExecutablePath := '';
      FExecutableNameNoExt := '';
      FLibraryPath := ProjectOptions.GetProjectOutputDir(
        GetRootComponent(Self));
      FLibraryNameNoExt := ChangeFileExt(ExtractFileName(
        ProjectOptions.GetProjectFileName(GetRootComponent(Self))), '');
      FLocalKeyboxLocation := klLibraryPath;
      FLocalKeyboxPrefix := FLibraryNameNoExt;
    end
    else
    begin
      FExecutablePath := ProjectOptions.GetProjectOutputDir(
        GetRootComponent(Self));
      FExecutableNameNoExt := ChangeFileExt(ExtractFileName(
        ProjectOptions.GetProjectFileName(GetRootComponent(Self))), '');
      FLibraryPath := '';
      FLibraryNameNoExt := '';
      FLocalKeyboxLocation := klExecutablePath; {can be changed prior to calling
                                                 InitKey}
      FLocalKeyboxPrefix := FExecutableNameNoExt;
    end;
  end;
  case FLocalKeyboxLocation of
    klExecutablePath: FLocalKeyboxPath :=  FExecutablePath;
    klLibraryPath:    FLocalKeyboxPath :=  FLibraryPath;
  end;
  Reset;
end;


class function TZaphodsMap.CreateForBranch(AOwner: TComponent;
  const AZaphodBranch: string): TZaphodsMap;
begin
  Result := Create(AOwner);
  Result.ZaphodBranch := AZaphodBranch;
end;


class function TZaphodsMap.CreateForService(AOwner: TComponent;
  const AZaphodBranch: string = '';
  const ALocalKeyboxPrefix: string = ''): TZaphodsMap;
begin
  Result := CreateForBranch(AOwner, AZaphodBranch);
  Result.FLocalKeyboxPrefix := ALocalKeyboxPrefix;
end;


destructor TZaphodsMap.Destroy;
begin
  if Assigned(FOnDestroy) then
    FOnDestroy(Self);
  DeActivateAllKeys;
  FreeAndNil(FBranchKeyboxXml);
  FreeAndNil(FLocalKeyboxXml);
  FreeAndNil(FPropertyList);
  inherited;
end;


{TZaphodsMap - Private Methods}

function TZaphodsMap.AddZaphodKeysElement: Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to High(FZaphodKeys) do
  begin
    if FZaphodKeys[I] = nil then
    begin
      Result := I;
      Break; {first available deactivated key found}
    end;
  end;
  if Result = -1 then {no deactivated keys available so add a new element}
  begin
    SetLength(FZaphodKeys, High(FZaphodKeys)+2);
    Result := High(FZaphodKeys);
  end;
end;



function TZaphodsMap.GetKeyedAttribute(const AKeyGroupName: string;
  const AKeyType: TZaphodKeyType; const AKeyName: string;
  const AContextType: TContextType; const AContextUsage: TContextUsage;
  const AContextValue: string; const AUserNameType: TUserNameType;
  const AUserNameUsage: TUserNameUsage; const AUserNameValue: string;
  const ADefaultValue: string; const ACallingMethod: string): string;
var
  KeyNode: TZaphodNode;
  SearchedDesc: string;
  KeyID, AttributeID: string;
  ExceptionDesc: string;

  function GetPreliminaryKeyDesc: string;
  begin
    if (ACallingMethod = 'ActivateTempKey')
      or (ACallingMethod = 'ActivateTempKeyEx') then
      Result := 'TempKey for file"' + ADefaultValue + '"'
    else
    begin
      Result := '(KeyGroupName="' + AKeyGroupName + '", KeyName="' + AKeyName
        + '"';
      if AContextValue <> '' then
      begin
        Result :=  Result + '(Context="' + AContextValue
          + '" Context Usage=';
        if AContextUsage = cxRequired then
          Result := Result + '"Required")'
        else
        if AContextUsage = cxOptional then
          Result := Result + '"Optional")'
        else
          Result := Result + '"None")';
      end;
      if AUserNameValue <> '' then
      begin
        Result :=  Result + '(UserName="' + AUserNameValue
          + '" UserName Usage=';
        if AUserNameUsage = usrRequired then
          Result := Result + '"Required")'
        else
        if AUserNameUsage = usrOptional then
          Result := Result + '"Optional")'
        else
          Result := Result + '"None")';
      end;
      Result := Result  + ')';
    end;
  end;

  function GetZaphodKeyNode(XmlDoc: TZaphodXmlDoc;
    const KeyType: TZaphodKeyType; out ContextWasUsed: Boolean;
    out UserNameWasUsed: Boolean): TZaphodNode;
  var
    KeyGroupNode: TZaphodNode;
    KeyDescExtra: string;
    KeyID, AttributeID: string;
    S: string;
  begin
    Result := nil;
    GetZMKeyProperties(KeyType,KeyID,AttributeID);
    KeyGroupNode := XmlDoc.ZNode(nil, ['KeyGroups/KeyGroup', '@name',
      AKeyGroupName]);
    if KeyGroupNode <> nil then
    begin
      ContextWasUsed := False;
      UserNameWasUsed := False;
      if AContextUsage = cxNone then
      begin
        if AUserNameUsage = usrNone then
        begin
          Result := XmlDoc.ZNode(KeyGroupNode, ['Keys/' + KeyID, '@name',
            AKeyName]);
          KeyDescExtra := '';
        end
        else
        begin
          Result := XmlDoc.ZNode(KeyGroupNode, ['Keys/' + KeyID, '@name',
            AKeyName, '@username', AUserNameValue]);
          if (Result = nil) and (AUserNameUsage = usrOptional) then
            Result := XmlDoc.ZNode(KeyGroupNode, ['Keys/' + KeyID, '@name',
              AKeyName]);
          if (Result <> nil) then
          begin
            UserNameWasUsed := SameText(Result.AttributeByName['username'],
              AUserNameValue);
            S := 'username=' + AUserNameValue;
            if UserNameWasUsed then
              S := S + '[@'+ S + ']'
            else
              S := ' ('+ S + ' ' + szmRequestedButNotUsed + ')';
            KeyDescExtra := S;
          end;
        end;
      end
      else
      begin
        {either a custom or default context was requested}
        if AUserNameUsage = usrNone then
        begin
          Result := XmlDoc.ZCNodeCommon(KeyGroupNode, XPathBuilder(
            ['Keys/' + KeyID, '@name', AKeyName]), AContextUsage,
            AContextValue, False)
        end
        else
        begin
          Result := XmlDoc.ZCNodeCommon(KeyGroupNode, XPathBuilder(
            ['Keys/' + KeyID, '@name', AKeyName, '@username',
            AUserNameValue]), AContextUsage, AContextValue, False);
          if Result <> nil then
            UserNameWasUsed := True;
          if (Result = nil) and (AUserNameUsage = usrOptional) then
            Result := XmlDoc.ZCNodeCommon(KeyGroupNode, XPathBuilder(
              ['Keys/' + KeyID, '@name', AKeyName]), AContextUsage,
              AContextValue, False);
        end;
        S := XmlDoc.FContextAttributeID + '="' + AContextValue + '"';
        if XmlDoc.FLastNodeContextUsed then
          KeyDescExtra := '[@'+ S + ']'
        else
          KeyDescExtra := ' ('+ S + ' ' + szmRequestedButNotUsed
          + ')';
        ContextWasUsed := XmlDoc.FLastNodeContextUsed;
        if (Result <> nil) and (AUserNameUsage <> usrNone) then
        begin
          UserNameWasUsed := SameText(Result.AttributeByName['username'],
            AUserNameValue);
          S := 'username=' + AUserNameValue;
          if UserNameWasUsed then
            S := S + '[@'+ S + ']'
          else
            S := ' ('+ S + ' ' + szmRequestedButNotUsed + ')';
          KeyDescExtra := KeyDescExtra + S
        end;
      end;
      if Result <> nil then
      begin
        with FLastKeyedDetail do
        begin
          KeyDesc := '/' + XmlDoc.Root.Name + '/KeyGroups/KeyGroup[@name="'
             + AKeyGroupName + '"]/Keys/' + KeyID
             + '[@name="' + AKeyName + '"] ' + KeyDescExtra;
        end;
      end;
    end;
  end;

begin
  Result := '';
  GetZMKeyProperties(AKeyType,KeyID,AttributeID);
  with FLastKeyedDetail do
  begin
    KeyGroupName := AKeyGroupName;
    KeyType := AKeyType;
    KeyName := AKeyName;
    ContextType := AContextType;
    ContextUsage := AContextUsage;
    ContextValue := AContextValue;
    UserNameType := AUserNameType;
    UserNameUsage := AUserNameUsage;
    UserNameValue := AUserNameValue;
    DefaultValue := ADefaultValue;
    CallingMethod := ACallingMethod;
    KeyDesc := GetPreliminaryKeyDesc;
    { set Defaults}
    KeyboxUsed := kuNone;
    ContextUsed := False;
    UserNameUsed := False;
    ExceptionOccurred := False;
    ErrorMessage := '';
  end;
  try
    KeyNode := nil;
    if (AKeyGroupName = '') or (AKeyName = '') then
      RaiseExceptionFmt(szmKeyGroupAndNameRequired, [ACallingMethod],
      'GetKeyedAttribute');
    if ((FBranchKeyboxXmlOK = False ) and (FLocalKeyboxXmlOK = False)
      and (ADefaultValue = '')) then
      RaiseExceptionFmt(szmNoValidKeyboxFilesExist, [BranchKeyboxWarnings,
        LocalKeyboxWarnings], ACallingMethod);
    {first look for key in local keybox}
    if FLocalKeyboxXmlOK then
    begin
      with FLastKeyedDetail do
      begin
        KeyNode := GetZaphodKeyNode(FLocalKeyboxXml, AKeyType, ContextUsed,
          UserNameUsed);
        if (KeyNode <> nil) then
          KeyboxUsed := kuLocalKeybox;
      end;
    end;
    {if key not found yet then look in Branch keybox}
    if KeyNode = nil then
    begin
      if FBranchKeyboxXmlOK then
      begin
        with FLastKeyedDetail do
        begin
          KeyNode := GetZaphodKeyNode(FBranchKeyboxXml, AKeyType, ContextUsed,
            UserNameUsed);
          if KeyNode <> nil then
            KeyboxUsed := kuBranchKeybox;
        end;
      end;
    end;
    if (KeyNode <> nil) then
    begin
      Result := KeyNode.AttributeByName[AttributeID];
      { allow for a variable in the Attribute}
      if FLastKeyedDetail.KeyboxUsed = kuBranchKeybox then
        Result := FBranchKeyboxXml.ExpandVars(KeyNode, Result)
      else
        Result := FLocalKeyboxXml.ExpandVars(KeyNode, Result);
      if Result = '' then
      begin
        if KeyNode.HasAttribute(AttributeID) then
          ExceptionDesc := szmKeyFileNameAttributeBlank
        else
          ExceptionDesc := szmKeyFileNameAttributeMissing;
        RaiseException(ExceptionDesc, ACallingMethod);
       end;
    end;
    {if key not found yet & DefaultValue is specified then key is temp}
    if (KeyNode = nil) then
    begin
      if (ADefaultValue <> '') then
      begin
        Result := ADefaultValue;
        with FLastKeyedDetail do
        begin
          ContextUsed := False;
          UserNameUsed := False;
          KeyboxUsed := kuNone;
        end;
      end
      else
      begin
        if FLocalKeyboxXmlOK and FBranchKeyboxXmlOK then
          SearchedDesc := 'LocalKeybox and BranchKeybox'
        else
        if FLocalKeyboxXmlOK  then
          SearchedDesc := 'LocalKeybox'
        else
          SearchedDesc:= 'BranchKeybox';
        RaiseExceptionFmt(szmKeyNodeNotFound, [FLastKeyedDetail.KeyDesc,
          SearchedDesc + ' (and DefaultKeyedFileName=""'],
          ACallingMethod);
      end;
    end;  
  except
    on E:Exception do
    begin
      Result := '';
      with FLastKeyedDetail do
      begin
        FKeyLastError := 'Error accessing key "' + KeyDesc + '"' +  sLineBreak
          + E.message;
        ExceptionOccurred := True;
        ErrorMessage := FKeyLastError;
      end;
    end;
  end;
end;




function TZaphodsMap.AddKeyInternal(out IndexOfKey: Integer;
  const AKeyGroupName, AKeyName, ARequiredRootNodeName: string;
  const AContextType: TContextType; const AContextUsage: TContextUsage;
  const AContextValue: string; const AUserNameType: TUserNameType;
  const AUserNameUsage: TUserNameUsage; const AUserNameValue: string;
  ADefaultKeyedFileName: string; const ACallingMethod: string): TZaphodKey;

var
  KeyedFileName: string;
begin
  Result := nil;
  if (ADefaultKeyedFileName <> '') and
    not FilePathIsAbsolute(ADefaultKeyedFileName) then
    ADefaultKeyedFileName := FLocalKeyboxPath + ADefaultKeyedFileName;
  try
    if (ACallingMethod <> 'ActivateTempKey') and
      (ACallingMethod <> 'ActivateTempKeyEx') then
    begin
      KeyedFileName := GetKeyedAttribute(AKeyGroupName, ktFile, AKeyName,
        AContextType, AContextUsage, AContextValue, AUserNameType,
        AUserNameUsage, AUserNameValue, ADefaultKeyedFileName, ACallingMethod);
      with FLastKeyedDetail do
      begin
        if ExceptionOccurred then
          RaiseException(ErrorMessage, ACallingMethod);
      end;
    end
    else
    begin
      with FLastKeyedDetail do
      begin
        KeyGroupName := '';
        KeyType := ktFile;
        KeyName := '';
        ContextType := AContextType;
        ContextUsage := AContextUsage;
        ContextValue := AContextValue;
        UserNameType := AUserNameType;
        UserNameUsage := AUserNameUsage;
        UserNameValue := AUserNameValue;
        DefaultValue := ADefaultKeyedFileName;
        CallingMethod := ACallingMethod;
        KeyDesc := 'TempKey[]'; { set below}
        KeyboxUsed := kuTemp;
        ContextUsed := False;
        UserNameUsed := False;
        ExceptionOccurred := False;
        ErrorMessage := '';
      end;
      KeyedFileName := ADefaultKeyedFileName;
    end;
    if (KeyedFileName <> '') then
    begin
      { if key already in the array then raise an exception}
      if KeyAlreadyInitialized(AKeyGroupName, AKeyName, AContextUsage,
        AContextValue, AUserNameUsage, AUserNameValue,
        KeyedFileName) then
          RaiseExceptionFmt(szmKeyAlreadyExists, [FLastKeyedDetail.KeyDesc],
            ACallingMethod);
      IndexOfKey := AddZaphodKeysElement;
      if FLastKeyedDetail.KeyboxUsed = kuTemp then
        FLastKeyedDetail.KeyDesc := 'TempKey['+ IntToStr(IndexOfKey) + ']';
      FZaphodKeys[IndexOfKey] := TZaphodKey.CreateKey(self, IndexOfKey,
        KeyedFileName, ARequiredRootNodeName, FLastKeyedDetail);
      Result := FZaphodKeys[IndexOfKey];
      FKeyLastError := '';
    end
    else
      RaiseExceptionFmt(szmKeyedFileNameRequired, [ACallingMethod],
        'AddKeyInternal');
  except
    on E:Exception do
    begin
      Result := nil;
      FKeyLastError := 'Error adding key: ' + sLineBreak + E.message;
    end;
  end;
end;


function TZaphodsMap.GetBranchKeyboxWarnings: string;
var
  S: string;
begin
  if edFilePathsAndNames in ErrorDetailAllowed then
    S := '"' + FBranchKeybox + '"'
  else
  if edFileNames in ErrorDetailAllowed then
    S := '"' + ExtractFileName(FBranchKeybox) + '"'
  else
    S := '';
  if (FBranchKeyboxWarnings = '') then
    Result := ''
  else
    Result := FBranchKeyboxWarnings + ' ' + S;
end;


function TZaphodsMap.GetLocalKeybox: string;
begin
  Result := FLocalKeybox;
end;


function TZaphodsMap.GetLocalKeyboxExists: Boolean;
begin
  Result := FLocalKeyboxExists;
end;


function TZaphodsMap.GetLocalKeyboxPath: string;
begin
  Result := FLocalKeyboxPath;
end;


function TZaphodsMap.GetLocalKeyboxWarnings: string;
var
  S: string;
begin
  if edFilePathsAndNames in ErrorDetailAllowed then
    S := '"' + FLocalKeybox + '"'
  else
  if edFileNames in ErrorDetailAllowed then
    S := '"' + ExtractFileName(FLocalKeybox) + '"'
  else
    S := '';
  if (FLocalKeyboxWarnings = '') then
    Result := ''
  else
    Result := FLocalKeyboxWarnings + ' ' + S;
end;


function TZaphodsMap.GetLocalKeyboxXmlOK: Boolean;
begin
  Result := FLocalKeyboxXmlOK;
end;

function TZaphodsMap.GetPropertyList: TStrings;
var
  Props: TPropArray;
  idx: Integer;
begin
  Props := nil;
  Result := FPropertyList;
  if not FPropertyListBusy then
  begin
    FPropertyListBusy := True;
    try
      Result.Clear;
      Props := GetPropArray(ClassInfo);
      for idx := 0 to High(Props) do
        if CanRead(Props[idx]) then
          if PropIsType(Self, string(Props[idx].Name), tkSet) then
            Result.Values[string(Props[idx].Name)] :=
              string(GetSetProp(Self, string(Props[idx].Name), True))
          else
            Result.Values[string(Props[idx].Name)] :=
              VarToStr(GetPropValue(Self, string(Props[idx].Name)));
    finally
      FPropertyListBusy := False;
    end;
  end;
end;


procedure TZaphodsMap.SetPropertyList(const Value: TStrings);
begin
  { this method is required for the Object Inspector, otherwise an Access
    Violation occurs if someone tries to save the property list. }
end;

function TZaphodsMap.GetZaphodKeyCount: Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to High(FZaphodKeys) do
    if FZaphodKeys[I] <> nil then
      Inc(Result);
end;


function TZaphodsMap.GetZaphodKey(Index: Integer): TZaphodKey;
begin
  if (Index < 0) or (Index > High(FZaphodKeys)) then
    RaiseExceptionFmt(szmIndexOutOfRange, [Index, 'ZaphodKeys[I]'],
      'GetZaphodKey');
  Result := FZaphodKeys[Index];
  if Result = nil then
    RaiseExceptionFmt(szmKeyHasBeenDeactivated, ['ZaphodKeys['+ IntToStr(Index)
      + ']'], 'GetZaphodKey');
end;


function TZaphodsMap.IsDesigning: Boolean;
begin
  Result := (csDesigning in ComponentState) and (ProjectOptions <> nil);
end;


function TZaphodsMap.KeyAlreadyInitialized(const AKeyGroupName,
  AKeyName: string; const AContextRequestUsage: TContextUsage;
  const AContextRequestValue: string;
  const AUserNameRequestUsage: TUserNameUsage;
  const AUserNameRequestValue : string;
const AKeyedFileName: string): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to High(FZaphodKeys) do
  begin
    if FZaphodKeys[I] <> nil then
    begin
      with FZaphodKeys[I] do
      begin
        if (AKeyGroupName <> '') and (AKeyName <> '') then
        begin
          with FKeyedDetail do
          begin
            if (KeyGroupName = AKeyGroupName) and (KeyName = AKeyName)
              and (ContextUsage = AContextRequestUsage)
              and (ContextValue = AContextRequestValue)
              and (UserNameUsage = AUserNameRequestUsage)
              and (UserNameValue = AUserNameRequestValue) then
                Result := True;
          end;
        end
        else
          {Key must be a temporary key so ensure KeyedFilename is new}
          if (FKeyedFileName = AKeyedFileName) then
            Result := True;
        if Result = True then
          Break;
      end;
    end;
  end;
end;


procedure TZaphodsMap.RaiseException(const AMessage: string;
  MethodName: string);
var
  C: TComponent;
begin
  if not (edMethodNames in FErrorDetailAllowed) then
      MethodName := '';
  if (edComponentNames in FErrorDetailAllowed) then
    C := self
  else
    C := nil;
  ZaphodException(AMessage, MethodName, C);
end;


procedure TZaphodsMap.RaiseExceptionFmt(const AMessage: string;
  const Args: array of const; MethodName: string);
begin
  RaiseException(Format(AMessage, Args), MethodName);
end;


procedure TZaphodsMap.SetLocalKeyboxPrefix(const Prefix: string);
begin
  if Prefix <> FLocalKeyboxPrefix then
  begin
    if ZaphodKeyCount > 0 then
      RaiseExceptionFmt(szmCannotChangeAsKeysExist, ['LocalKeyboxPrefix'],
        'SetLocalKeyboxPrefix');
    FLocalKeyboxPrefix := Prefix;
    Reset;
  end;
end;

procedure TZaphodsMap.SetLocalKeyboxPrefixEnabled(const Value: Boolean);
begin
  if Value <> FLocalKeyboxPrefixEnabled then
  begin
    if ZaphodKeyCount > 0 then
      RaiseExceptionFmt(szmCannotChangeAsKeysExist,
        ['LocalKeyboxPrefixEnabled'], 'SetLocalKeyboxPrefixEnabled');
    FLocalKeyboxPrefixEnabled := Value;
    Reset;
  end;
end;



procedure TZaphodsMap.SetLocalKeyboxLocation(const ALocalKeyboxLocation:
  TLocalKeyboxLocation; const ACustomPath: string = '');
begin
  if ZaphodKeyCount > 0 then
    RaiseExceptionFmt(szmCannotChangeAsKeysExist, ['LocalKeyboxLocation'],
      'SetLocalKeyboxLocation');
  if (ALocalKeyboxLocation = klLibraryPath) then
  begin
    if not IsDesigning then
    begin
      if (not IsLibrary) then
        RaiseException(szmLocalKeyboxLocationInvalid, 'SetLocalKeyboxLocation');
    end
    else
    begin
      {we are in the Borland Delphi IDE}
      if not ProjectOptions.ProjectIsALibrary(GetRootComponent(Self)) then
      begin
        RaiseException(szmLocalKeyboxLocationInvalid, 'SetLocalKeyboxLocation');
      end;
    end;
  end
  else
  if (ALocalKeyboxLocation = klCustom) and (ACustomPath = '') then
    RaiseException(szmLocalKeyboxCustomPathRequired, 'SetLocalKeyboxLocation');
  FLocalKeyboxLocation := ALocalKeyboxLocation;
  case FLocalKeyboxLocation of
    klExecutablePath: FLocalKeyboxPath :=  FExecutablePath;
    klLibraryPath:    FLocalKeyboxPath :=  FLibraryPath;
    klCustom: FLocalKeyboxPath := ACustomPath;
  end;
  Reset;
end;


procedure TZaphodsMap.SetProjectOptions(const Value: IZaphodProjectOptions);
begin
  FProjectOptions := Value;
end;

procedure TZaphodsMap.SetZaphodBranch(const Value: string);
begin
  if (Value <> FZaphodBranch) then
  begin
    if ZaphodKeyCount > 0 then
      RaiseExceptionFmt(szmCannotChangeAsKeysExist, ['ZaphodBranch'],
        'SetZaphodBranch');
    if (Value <> '') then
    begin
      { remove leading and include trailing path delimiter}
      FZaphodBranch :=  IncludeTrailingPathDelimiter(Value);
      if IsPathDelimiter(FZaphodBranch, 1) then
        FZaphodBranch := Copy(FZaphodBranch, 2, MaxInt);
    end
    else
      FZaphodBranch := '';
    Reset;
  end;
end;


{TZaphodsMap = protected methods}

procedure TZaphodsMap.InitBranchKeybox;
var
  ANodeList: TXmlNodeList;
begin
  ANodeList := nil;
  if FBranchKeyboxXml <> nil then
    FreeAndNil(FBranchKeyboxXml);
  FBranchKeyBox := '';
  FBranchKeyboxXmlOK := False;
  FBranchKeyboxFileAge := 0;
  FBranchKeyboxWarnings := '';

  if FZaphodBranch <> '' then
  begin
    if FZaphodsMapEnvVarExists then
    begin
      FBranchKeybox := FZaphodsMapRoot + FZaphodBranch +
        cZMBranchKeyboxFileName;
      FBranchKeyboxExists := FileExists(FBranchKeybox);
      if FBranchKeyboxExists then
        FBranchKeyboxWarnings := ''
      else
        FBranchKeyboxWarnings := Format(szmBranchKeyboxLoadError,
          [szmFileNotFound]);
    end
    else
    begin
      FBranchKeyboxExists := False;
      FBranchKeyboxWarnings := Format(szmBranchKeyboxLoadError,
        [szmZaphodsMapEnvNotFound]);
    end;
  end
  else
  begin
    FBranchKeyboxExists := False;
    FBranchKeyboxWarnings := Format(szmBranchKeyboxLoadError,
      [szmZaphodBranchNotSpecified]);
  end;

  try
    if FBranchKeyboxExists then
    begin
      try
        FBranchKeyboxXml :=  TZaphodXmlDoc.Create(FBranchKeybox,
          cZMKeyboxRootNodeName, FDefaultMapContext);
        FBranchKeyboxXml.FZaphodsMap := self;
        if FBranchKeyboxXml.LoadFile then
        begin
          FileAgeMV(FBranchKeybox, FBranchKeyboxFileAge);
          FBranchKeyboxXmlOK := True;
        end
        else
        begin
          FBranchKeyboxWarnings := Format(szmBranchKeyboxLoadError,
            [FBranchKeyboxXml.FLastError]);
          FreeAndNil(FBranchKeyboxXml);
        end;
      except
        on E: Exception do
        begin
          FBranchKeyboxWarnings := Format(szmBranchKeyboxLoadError,
            [E.message]);
          FreeAndNil(FBranchKeyboxXml);
        end;
      end;
    end;
  finally
    FreeAndNil(ANodeList);
  end;

end;


procedure TZaphodsMap.InitLocalKeybox;

  function GetDefaultContext(const FileName, RootNodeName: string): string;
  var
    XmlDoc: TNativeXml;
    ANode: TXmlNode;
  begin
    Result := '';
    XmlDoc := TNativeXml.Create;
    with XmlDoc do
    begin
      try
        if FileExists(FileName) then
        begin
          LoadFromFile(FileName);
          if SameText(Root.Name, RootNodeName) then
          begin
            ANode := Root.NodeByName('DefaultContext');
            if ANode <> nil then
              Result := ANode.AttributeByName['value'];
          end;
        end;
      except
        //
      end;
    end;
    FreeAndNil(XmlDoc);
  end;

begin
  if FLocalKeyboxXml <> nil then
    FreeAndNil(FLocalKeyboxXml);
  FLocalKeybox := '';
  FLocalKeyboxExists := False;
  FLocalKeyboxPath := '';
  FLocalKeyboxWarnings := '';
  FLocalKeyboxXmlOK := False;
  FLocalKeyboxSuffix := cZMLocalKeyboxSuffix;
  FKeyLastError := '';
  { set the default context}
  { get default context from the following files in priority order and only if
    each file exists:
     ZMConfig.xml in the localkeybox location)
     ZMConfig.xml in the zaphod branch folder
     ZMGlobal.xml in the zaphodsmap root folder }
  FDefaultMapContext := GetDefaultContext(FLocalKeyboxPath +
    cZMContextFileName, cZMContextRootNodeName);
  if (FDefaultMapContext = '') and FZaphodsMapEnvVarExists then
  begin
    FDefaultMapContext := GetDefaultContext(FZaphodsMapRoot + FZaphodBranch +
      cZMContextFileName, cZMContextRootNodeName);
    if (FDefaultMapContext = '') then
      FDefaultMapContext := GetDefaultContext(FZaphodsMapRoot +
        cZMGlobalFileName, cZMGlobalRootNodeName);
  end;

  {local keybox}
  if FLocalKeyboxPrefixEnabled then
    FLocalKeybox := FLocalKeyboxPath + FLocalKeyboxPrefix + FLocalKeyboxSuffix
  else
    FLocalKeybox := FLocalKeyboxPath + FLocalKeyboxSuffix;
  FLocalKeyboxExists := FileExists(FLocalKeybox);
  try
    if FLocalKeyboxExists then
    begin
      try
        FLocalKeyboxXml :=  TZaphodXmlDoc.Create(FLocalKeybox,
          cZMKeyboxRootNodeName, FDefaultMapContext);
        FLocalKeyboxXml.FZaphodsMap := self;
        if FLocalKeyboxXml.LoadFile then
        begin
          FileAgeMV(FLocalKeybox, FLocalKeyboxFileAge);
          FLocalKeyboxXmlOK := True;
        end
        else
        begin
          FLocalKeyboxWarnings := Format(szmLocalKeyboxLoadError,
            [FLocalKeyboxXml.FLastError]);
          FreeAndNil(FLocalKeyboxXml);
        end;
      except
        on E: Exception do
        begin
          FLocalKeyboxWarnings := Format(szmLocalKeyboxLoadError,
            [E.message]);
          FreeAndNil(FLocalKeyboxXml);
        end;
      end;
    end
    else
    begin
      FLocalKeyboxWarnings := Format(szmLocalKeyboxLoadError,
        [szmFileNotFound]);
    end;
  finally
    //
  end;
end;


function TZaphodsMap.GetKeyedFileElseDeactivateKey(var AKey: TZaphodKey):
  TZaphodXmlDoc;
begin
  if Assigned(AKey) then
  begin
    with AKey do
    begin
      if KeyedFile.LoadFile then
        Result := KeyedFile
      else
      begin
        FKeyLastError := KeyedFile.LastError;
        DeactivateKey(AKey.KeyIndex);
        AKey := nil;
        Result := nil;
      end;
    end;
  end
  else
    Result := nil;
end;


{TZaphodsMap - Public Methods}

function TZaphodsMap.ActivateKey(const KeyGroupName, KeyName: string;
  const ContextUsage: TContextUsage; const UserNameUsage: TUserNameUsage;
  const RequiredRootNodeName: string;
  const DefaultKeyedFileName: string = ''): TZaphodKey;
var
   IndexOfKey: Integer;
begin
  Result := AddKeyInternal(IndexOfKey, KeyGroupName, KeyName,
    RequiredRootNodeName, cxDefault, ContextUsage, FDefaultMapContext,
    usrDefault, UserNameUsage, FDefaultUserName, DefaultKeyedFileName,
    'ActivateKey');
end;


function TZaphodsMap.ActivateKeyDoc(const KeyGroupName, KeyName: string;
  const ContextUsage: TContextUsage; const UserNameUsage: TUserNameUsage;
  const RequiredRootNodeName: string; const DefaultKeyedFileName: string =''):
  TZaphodXmlDoc;
var
  AKey: TZaphodKey;
begin
  AKey := ActivateKey(KeyGroupName, KeyName, ContextUsage, UserNameUsage,
    RequiredRootNodeName, DefaultKeyedFileName);
  Result := GetKeyedFileElseDeactivateKey(AKey);
end;


function TZaphodsMap.ActivateTempKey(const KeyedFileName,
  RequiredRootNodeName: string): TZaphodKey;
var
  IndexOfKey: Integer;
begin
  Result := AddKeyInternal(IndexOfKey, '', '', RequiredRootNodeName, cxDefault,
    cxOptional, FDefaultMapContext, usrDefault, usrNone, '', KeyedFileName,
    'ActivateTempKey');
end;


function TZaphodsMap.ActivateTempKeyDoc(const KeyedFileName,
  RequiredRootNodeName: string): TZaphodXmlDoc;
var
  AKey: TZaphodKey;
begin
  AKey := ActivateTempKey(KeyedFileName, RequiredRootNodeName);
  Result := GetKeyedFileElseDeactivateKey(AKey);
end;


function TZaphodsMap.KeyedFileName(const KeyGroupName: string;
  const KeyName: string; const ContextUsage: TContextUsage;
  const UserNameUsage: TUserNameUsage; const DefaultFileName: string): string;
begin
  Result := GetKeyedAttribute(KeyGroupName, ktFile, KeyName, cxDefault,
    ContextUsage, FDefaultMapContext, usrDefault, UserNameUsage, '',
    DefaultFileName, 'KeyedFileName');
end;


function TZaphodsMap.KeyedFolder(const KeyGroupName: string;
  const KeyName: string; const ContextUsage: TContextUsage;
  const UserNameUsage: TUserNameUsage; const DefaultFolderName: string): string;
begin
  Result := GetKeyedAttribute(KeyGroupName, ktFolder, KeyName, cxDefault,
    ContextUsage, FDefaultMapContext, usrDefault, UserNameUsage, '',
    DefaultFolderName, 'KeyedFolder');
end;


function TZaphodsMap.KeyedValue(const KeyGroupName: string;
  const KeyName: string; const ContextUsage: TContextUsage;
  const UserNameUsage: TUserNameUsage;
  const DefaultValue: string): string;
begin
  Result := GetKeyedAttribute(KeyGroupName, ktValue, KeyName, cxDefault,
    ContextUsage, FDefaultMapContext , usrDefault, UserNameUsage, '',
    DefaultValue, 'KeyedValue');
end;


procedure TZaphodsMap.DeactivateAllKeys;
var
  I: Integer;
begin
  for I := 0 to High(FZaphodKeys) do
    if FZaphodKeys[I] <> nil then
      FreeAndNil(FZaphodKeys[I]);
  SetLength(FZaphodKeys, 0);
end;


procedure TZaphodsMap.DeactivateKey(const Index: Integer);
begin
  if (Index < 0) or (Index > High(FZaphodKeys)) then
    RaiseExceptionFmt(szmIndexOutOfRange, [Index, 'ZaphodKeys[I]'],
      'DeactivateKey');
  if FZaphodKeys[Index] <> nil then
    FreeAndNil(FZaphodKeys[Index]);
end;


procedure TZaphodsMap.Reset;
begin
  DeactivateAllKeys;
  FZaphodsMapRoot := SysUtils.GetEnvironmentVariable('ZaphodsMap');
  FZaphodsMapEnvVarExists := FZaphodsMapRoot <> '';
  if FZaphodsMapEnvVarExists then
    FZaphodsMapRoot := IncludeTrailingPathDelimiter(FZaphodsMapRoot);
  InitLocalKeybox;  {also sets FDefaultContext}
  InitBranchKeybox;
end;



{ TZaphodsMapAdmin }
function TZaphodsMapAdmin.GetBranchKeyboxXml: TZaphodXmlDoc;
begin
  Result := FBranchKeyboxXml;
end;


class function TZaphodsMapAdmin.CreateForBranch(AOwner: TComponent;
  const AZaphodBranch: string): TZaphodsMapAdmin;
begin
  Result := Create(AOwner);
  Result.ZaphodBranch := AZaphodBranch;
end;

function TZaphodsMapAdmin.ActivateKeyEx(const KeyGroupName, KeyName: string;
  const ContextUsage: TContextUsage; const Context: string;
  const UserNameUsage: TUserNameUsage; const UserName: string;
  const RequiredRootNodeName: string; const DefaultKeyedFileName: string = ''):
  TZaphodKey;
var
   IndexOfKey: Integer;
begin
  Result := AddKeyInternal(IndexOfKey, KeyGroupName, KeyName,
    RequiredRootNodeName, cxCustom, ContextUsage, Context, usrCustom,
    UserNameUsage, UserName, DefaultKeyedFileName, 'ActivateKeyEx');
end;

function TZaphodsMapAdmin.ActivateKeyDocEx(const KeyGroupName,
  KeyName: string; const ContextUsage: TContextUsage; const Context: string;
    const UserNameUsage: TUserNameUsage; const UserName: string;
  const RequiredRootNodeName: string; const DefaultKeyedFileName: string = ''):
  TZaphodXmlDoc;
var
  AKey: TZaphodKey;
begin
  AKey := ActivateKeyEx(KeyGroupName, KeyName, ContextUsage, Context,
    UserNameUsage, UserName, RequiredRootNodeName, DefaultKeyedFileName);
  Result := GetKeyedFileElseDeactivateKey(AKey);
end;

function TZaphodsMapAdmin.ActivateTempKeyEx(const KeyedFileName,
  RequiredRootNodeName: string; const ContextUsage: TContextUsage;
  const Context: string; const UserNameUsage: TUserNameUsage;
  const UserName: string): TZaphodKey;
var
  IndexOfKey: Integer;
begin
  Result := AddKeyInternal(IndexOfKey, '', '', RequiredRootNodeName, cxCustom,
   ContextUsage, Context, usrCustom, UserNameUsage, UserName, KeyedFileName,
    'ActivateTempKey');
end;

function TZaphodsMapAdmin.ActivateTempKeyDocEx(const KeyedFileName,
      RequiredRootNodeName: string; const ContextUsage: TContextUsage;
      const Context: string; const UserNameUsage: TUserNameUsage;
      const UserName: string): TZaphodXmlDoc;
var
  AKey: TZaphodKey;
begin
  AKey := ActivateTempKeyEx(KeyedFileName, RequiredRootNodeName, ContextUsage,
    Context, UserNameUsage, UserName);
  Result := GetKeyedFileElseDeactivateKey(AKey);
end;

function TZaphodsMapAdmin.KeyedFileNameEx(const KeyGroupName: string;
  const KeyName: string; const ContextUsage: TContextUsage;
  const ContextValue: string; const UserNameUsage: TUserNameUsage;
  const UserNameValue: string; const DefaultFileName: string): string;
begin
  Result := GetKeyedAttribute(KeyGroupName, ktFile, KeyName, cxCustom,
    ContextUsage, ContextValue, usrCustom, UserNameUsage, UserNameValue,
    DefaultFileName, 'KeyedFileNameEx');
end;

function TZaphodsMapAdmin.KeyedFolderEx(const KeyGroupName: string;
  const KeyName: string; const ContextUsage: TContextUsage;
  const ContextValue: string; const UserNameUsage: TUserNameUsage;
  const UserNameValue: string; const DefaultFolder: string): string;
begin
  Result := GetKeyedAttribute(KeyGroupName, ktFolder, KeyName, cxCustom,
    ContextUsage, ContextValue, usrCustom, UserNameUsage, UserNameValue,
    DefaultFolder, 'KeyedFolderEx');
end;

function TZaphodsMapAdmin.KeyedValueEx(const KeyGroupName: string;
  const KeyName: string; const ContextUsage: TContextUsage;
  const ContextValue: string; const UserNameUsage: TUserNameUsage;
  const UserNameValue: string; const DefaultValue: string): string;
begin
  Result := GetKeyedAttribute(KeyGroupName, ktValue, KeyName, cxCustom,
    ContextUsage, ContextValue, usrCustom, UserNameUsage, UserNameValue,
    DefaultValue, 'KeyedValueEx');
end;



{ static methods }

function GetAsVariant(S: string; const Default: Variant;
  out ErrorMessage: string): Variant;
var
  V: Variant;
begin
  ErrorMessage := '';
  try
    V := VarAsType(S, VarType(Default));
  except
    on E:Exception do
    begin
      if Length(S) > 40 then
        S := Copy(S, 1, 40) + '...';
      ErrorMessage := Format(szmErrorConvertingVariant,
        [S, Copy(VarTypeAsText(VarType(Default)), 4, MaxInt)]);
      V := Default;
    end;
  end;
  Result := V;
end;


procedure GetZMKeyProperties(const AKeyType: TZaphodKeyType; var KeyID,
  AttributeID: string);
begin
  case AKeyType of
    ktFile:
      begin
        KeyID := 'Key2File';
        AttributeID := 'filename';
       end;
    ktFolder:
      begin
        KeyID := 'Key2Folder';
        AttributeID := 'folder';
      end;
    ktValue:
      begin
        KeyID := 'Key2Value';
        AttributeID := 'value';
      end;
  end;
end;


function XPathAttr(const AttributeID, AttributeValue: string): string;
begin
  Result := Format('[@%s="%s"]', [AttributeID, AttributeValue]);
end;


function ZaphodKeyedFileZNodeAttr(const ZaphodBranch, AKeyGroupName, AKeyName,
  KeyedFileRootName: string; XPath: array of const;
  const AContextUsage: TContextUsage; const AUserNameUsage: TUserNameUsage;
  const AttributeID: string; const DefaultResult: Variant; out Warning: string):
  Variant;
var
  ZM: TZaphodsMap;
  Key: TZaphodKey;
begin
  Result := DefaultResult;
  Warning := '';
  try
    ZM := TZaphodsMap.CreateForBranch(nil, ZaphodBranch);
    Key := ZM.ActivateKey(AKeyGroupName, AKeyName, AContextUsage,
      AUserNameUsage, KeyedFileRootName, '');
    if Assigned(Key) then
    begin
      with Key.KeyedFile do
      begin
        if LoadFile then
        begin
          Result := ZNodeAttr(nil, XPath, AContextUsage, DefaultResult,
            AttributeID);
          if not Assigned(LastNode) then
            Warning := Warning + XPathBuilder(XPath) + ' not found.';
          if not LastNodeAttrFound then
            Warning := Warning + AttributeID + ' not found.';
        end
        else
          Warning := LastError;
      end;
    end
    else
    begin
      Warning := ZM.KeyLastError;
    end;
  finally
    FreeAndNil(ZM);
  end;
end;


function ZaphodKeyedFileName(const ZaphodBranch, AKeyGroupName,
  AKeyName: string; const AContextUsage: TContextUsage;
  const AUserNameUsage: TUserNameUsage;
  const DefaultFileName: string; out KeyedDetail: TKeyedDetail): string;
var
  ZM: TZaphodsMap;
begin
  try
    ZM := TZaphodsMap.CreateForBranch(nil,ZaphodBranch);
    Result := ZM.KeyedFileName(AKeyGroupName, AKeyName, AContextUsage,
      AUsernameUsage, DefaultFileName);
    KeyedDetail := ZM.LastKeyedDetail;
  finally
    FreeAndNil(ZM);
  end;
end;


function ZaphodKeyedFolder(const ZaphodBranch, AKeyGroupName,
  AKeyName: string; const AContextUsage: TContextUsage;
  const AUserNameUsage: TUserNameUsage;
  const DefaultFolderName: string; out KeyedDetail: TKeyedDetail): string;
var
  ZM: TZaphodsMap;
begin
  try
    ZM := TZaphodsMap.CreateForBranch(nil,ZaphodBranch);
    Result := ZM.KeyedFolder(AKeyGroupName, AKeyName, AContextUsage,
      AUsernameUsage, DefaultFolderName);
    KeyedDetail := ZM.LastKeyedDetail;
  finally
    FreeAndNil(ZM);
  end;
end;


function ZaphodKeyedValue(const ZaphodBranch, AKeyGroupName,
  AKeyName: string; const AContextUsage: TContextUsage;
  const AUserNameUsage: TUserNameUsage;
  const DefaultValue: string; out KeyedDetail: TKeyedDetail): string;
var
  ZM: TZaphodsMap;
begin
  try
    ZM := TZaphodsMap.CreateForBranch(nil,ZaphodBranch);
    Result := ZM.KeyedValue(AKeyGroupName, AKeyName, AContextUsage,
      AUsernameUsage, DefaultValue);
    KeyedDetail := ZM.LastKeyedDetail;
  finally
    FreeAndNil(ZM);
  end;
end;

(*
Notes regarding XPathBuilder:

Each array element must be a Path element, @attributeName or attributeValue
An attributeValue must always follow an @attributeName element
e.g.
['PathElement1','PathElement2','@attributeName','attributeValue']

eg. usage of XPathBuilder
  XPathBuilder(['Groups/Group','@name','TForm1','/Control','@name','WindowPos'])
    returns
  'Groups/Group[@name="TForm1"]/Control[@name="WindowPos"]'

Path elements (except the first one), do not require a leading slash, although
for code readability, inclusion is recommended (see /Control in above example).
Unnecessary trailing slashes are removed.

All of the following examples lead to an identical outcome:

['NodeA', 'NodeB', 'NodeC']
['NodeA', '/NodeB', 'NodeC']
['NodeA/', '/NodeB/', '/NodeC']

All of the above result in 'Node1/Node2/Node3'.
*)

function XPathBuilder(const Args: array of const): string;
var
  I: Integer;
  AttrValueNext: Boolean;
  AttrID: string;

  function IncludeLeadingSlash(const S: string): string;
  begin
    Result := S;
    if (Result <> '') and (not CharStartsStr('/', Result)) then
      Result := '/' + S;
  end;

  function ExcludeTrailingSlash(const S: string): string;
  begin
    Result := S;
    if CharEndsStr('/', Result) then
      SetLength(Result, Length(Result) - 1);
  end;

  procedure AppendResult(const S: string; const Index: Integer);
  begin
    if S <> '' then
    begin
      if S[1] = '@' then
      begin
        AttrID := Copy(S, 2, MaxInt);
        AttrValueNext := True;
      end
      else
      begin
        if AttrValueNext then
        begin
          Result := Result + XPathAttr(AttrID, S);
          AttrValueNext := False;
        end
        else
        begin
          if Index = 0 then
            Result := Result + ExcludeTrailingSlash(S)
          else
            Result := Result + IncludeLeadingSlash(ExcludeTrailingSlash(S));
        end;
      end;
    end;
  end;

{$IFDEF CLR}

  function ConvertToStr(const Value: TObject): string;
  begin
    Result := Value.ToString;
  end;

{$ELSE}

  function ConvertToStr(const Value: TVarRec): string;
  begin
    with Value do
      case VType of
        vtInteger:    Result := IntToStr(VInteger);
        vtBoolean:    Result := BoolToStr(VBoolean, True);
        vtChar:       Result := Char(VChar);
        vtExtended:   Result := FloatToStr(VExtended^);
        vtString:     Result := string(VString);
        vtPChar:      Result := PChar(VPChar);
        vtObject:     Result := VObject.ClassName;
        vtClass:      Result := VClass.ClassName;
        vtAnsiString: Result := string(VAnsiString);
        vtCurrency:   Result := CurrToStr(VCurrency^);
        vtVariant:    Result := string(VVariant^);
        vtInt64:      Result := IntToStr(VInt64^);
        {$IFDEF UNICODE}
        vtUnicodeString: Result := string(vUnicodeString); // Delphi 2009 +
        vtWideChar: Result := VWideChar; {required for single character Value}
        {$ENDIF}
        { intentionally not included
        vtPWideChar: (VPWideChar: PWideChar);
        vtInterface:  (VInterface: Pointer);
        vtWideString: (VWideString: Pointer);}
      end;
  end;

{$ENDIF}

begin
  Result := '';
  AttrValueNext := False;
  AttrID := '';
  for I := Low(Args) to High(Args) do
    AppendResult(ConvertToStr(Args[I]), I);
end;


function XPathOfNode(Node: TXmlNode): string;
var
  S: string;
begin
  S := '';
  Result := XPathOfNodeAsStr(Node, S);
end;


function ZaphodMinimalXMLDoc(const XSLURL, RootNode, XSDURL,
  Middle: string): string;
begin
  Result := Format(
    '<?xml version="1.0" encoding="UTF-8"?>' + sLineBreak +
    '<?xml-stylesheet type="text/xsl" href="%s"?>' + sLineBreak +
    '<%s xmlns:xsi="' + cW3OrgXMLSchemaInstanceURL + '" ' +
    'xsi:noNamespaceSchemaLocation=' +
    '"%s">' + sLineBreak + '%s' + sLineBreak +
    '</' + RootNode + '>', [XSLURL, RootNode, XSDURL, Middle]);
end;


procedure ZaphodException(const AMessage: string; const MethodName: string;
 Component: TComponent = nil);
begin
  if Assigned(Component) and (Component.Name <> '') and (MethodName <> '') then
    raise EZaphodException.Create(Format('%s.%s: %s', [Component.Name,
      MethodName, AMessage]))
  else
  if (MethodName <> '') then
    raise EZaphodException.Create(Format('Method "%s" reports: %s',
      [MethodName, AMessage]))
  else
    raise EZaphodException.Create(Format('ZM Error: %s', [AMessage]));
end;


procedure ZaphodExceptionFmt(const AMessage: string; const Args: array of const;
  const MethodName: string; Component: TComponent = nil);
begin
  ZaphodException(Format(AMessage, Args), MethodName, Component);
end;

function TZaphodXmlDoc.ValidateAndSetXsdSummary(XsdSummaryRoot: TXmlNode;
  out ErrorMsg: string): Boolean;
var
  AXsdUrl: string;
  AContextSupported: string;
  ADeleteEmptyNodes: string;
begin
{<XsdSummary id="WebHubAppConfiguration"
   xsd="http://webhub.com/xsd/cv004/WebHubAppConfiguration200811b.xsd"
   contextSupported="true"
   deleteEmptyNodes="true">
    <WebHubAppConfiguration>  <== root node
      etc
    <WebHubAppConfiguration>
 </xsdSummary>
 }
  ErrorMsg := '';
  if XsdSummaryRoot.NodeCount = 0 then
    ErrorMsg := 'XsdSummary validation root node is missing'
  else
  if (XsdSummaryRoot.Nodes[0].Name <> FRequiredRootNodeName) then
    ErrorMsg := Format('XsdSummary validation root node "%s" is invalid - '
     + 'should be "%s"', [XsdSummaryRoot.Nodes[0].Name, FRequiredRootNodeName])
  else
  begin
    with XsdSummaryRoot do
    begin
      AXsdUrl := AttributeByName['xsd'];
      AContextSupported := LowerCase(AttributeByName['contextSupported']);
      ADeleteEmptyNodes := LowerCase(AttributeByName['deleteEmptyNodes']);
    end;
    if (AContextSupported <> 'true') and (AContextSupported <> 'false') then
      ErrorMsg := 'contextSupported="true|false" must be specified in root node'
       + ' of XsdSummary';
    if (ADeleteEmptyNodes <> 'true') and (ADeleteEmptyNodes <> 'false') then
    begin
      if ErrorMsg <> '' then
        ErrorMsg := ErrorMsg + sLineBreak;
      ErrorMsg := ErrorMsg + 'attribute deleteEmptyNodes="true|false" must be '
       + ' specified in the opening <XsdSummary...> tag';
    end;
    if ErrorMsg = '' then
    begin
      FXsdUrl := AXsdUrl;
      FContextSupported := (AContextSupported = 'true');
      FDeleteEmptyNodesOnSave := (ADeleteEmptyNodes = 'true');
      FXsdSummary := TXmlNode.Create(nil);
      FXsdSummary.Assign(XsdSummaryRoot);
    end;
  end;
  Result := (ErrorMsg = '');
end;

procedure TZaphodXmlDoc.EnsureContextIsLastAttribute(var ANode: TXmlNode);
var
  Index: Integer;
  AValue: string;
begin
  with ANode do
  begin
    Index := AttributeIndexByName(FContextAttributeID);
    if (Index > -1) and (Index < AttributeCount - 1) then
    begin
      {remove context attribute and add to end of attributes}
      AValue := AttributeValue[Index];
      AttributeDelete(Index);
      AttributeAdd(FContextAttributeID, AValue);
    end;
  end;
end;

const
  szmSetXsdSummaryFailed = 'SetXsdSummary failed: ';


function TZaphodXmlDoc.SetXsdSummary(XsdSummaryRootNodeToCopy: TXmlNode;
  out ErrorMsg: string): Boolean;
begin
  ErrorMsg := '';
  if FXsdSummarySet then
    ErrorMsg := 'XsdSummary already set'
  else
  begin
    if XsdSummaryRootNodeToCopy = nil then
      ErrorMsg := 'XsdSummaryRootNodeToCopy is nil'
    else
      FXsdSummarySet := ValidateAndSetXsdSummary(XsdSummaryRootNodeToCopy,
        ErrorMsg);
  end;
  if (ErrorMsg <> '') then
    ErrorMsg := szmSetXsdSummaryFailed  + sLineBreak + ErrorMsg;
  Result := (ErrorMsg = '');
end;

function TZaphodXmlDoc.SetXsdSummary(const XsdSummaryAsString: string;
  out ErrorMsg: string): Boolean;
var
  AXmlDoc: TNativeXml;
begin
  ErrorMsg := '';
  if FXsdSummarySet then
    ErrorMsg := 'XsdSummary already set'
  else
  begin
    if XsdSummaryAsString = '' then
      ErrorMsg := 'XsdSummaryAsString is empty'
    else
    begin
      AXmlDoc := TNativeXml.Create;
      try
        AXmlDoc.ReadFromString(XsdSummaryAsString);
        FXsdSummarySet := ValidateAndSetXsdSummary(AXmlDoc.Root, ErrorMsg);
      except
        on E:Exception do
        begin
          ErrorMsg := 'XsdSummaryAsString is not valid xml';
        end;
      end;
      FreeAndNil(AXmlDoc);
    end;
  end;
  if (ErrorMsg <> '') then
    ErrorMsg := szmSetXsdSummaryFailed + ErrorMsg;
  Result := (ErrorMsg = '');
end;

function TZaphodXmlDoc.SetXsdSummary(const AXsdUrl: string;
  const AContextSupported, ADeleteEmptyNodesOnSave: Boolean;
  out ErrorMsg: string): Boolean;
begin
  ErrorMsg := '';
  if FXsdSummarySet then
    ErrorMsg := 'XsdSummary already set'
  else
  begin
    FXsdUrl := AXsdUrl;
    FContextSupported := AContextSupported;
    FDeleteEmptyNodesOnSave := ADeleteEmptyNodesOnSave;
  end;
  if (ErrorMsg <> '') then
    ErrorMsg := szmSetXsdSummaryFailed +  ErrorMsg;
  Result := (ErrorMsg = '');
end;


procedure AppendLineFmt(var Target: string; const S: string;
  const Args: array of const);
begin
  if Target <> '' then
    Target := Target + sLineBreak;
  Target := Target + Format(S, Args);
end;


function TZaphodXmlDoc.ValidateNodesRecursive(ANode, XsdNode: TXmlNode;
  out ErrorMsg: string): Boolean;
type
  TTagFindResult = (frNotFound, frFoundInSequence, frFoundOutOfSequence, frDone);
var
  I, J, StartIndex: Integer;
  Count: Integer;
  TagName: string;
  FindResult: TTagFindResult;
  NodeIndex: Integer;
  ErrorSt: string;
  ElementName: string;
  S: string;
  XsdNodeIsLeaf: Boolean;
  CNode: TXmlNode;
  ElementsSkipped: Integer;

  function IndexOfNextNodeWithName(const AName: string;
    const StartIndex: Integer; out ElementsSkipped: Integer): Integer;
  var
    I: Integer;
  begin
    Result := -1;
    ElementsSkipped := 0;
    for I := StartIndex to ANode.NodeCount - 1 do
    begin
      with ANode.Nodes[I] do
      begin
        case ElementType of
          xeNormal:
            begin
             if Name = AName then
             begin
               Result := I;
               Break;
             end;
            end;
          else
           ElementsSkipped := ElementsSkipped + 1;
        end;
      end;
    end;
  end;

  function FindNext(const AName: string; const Count: Integer;
    const StartIndex: Integer; out NodeIndex: Integer;
    out ElementsSkipped: Integer; out ErrorMsg: string):TTagFindResult;
  begin
    ErrorMsg := '';
    NodeIndex := IndexOfNextNodeWithName(AName, StartIndex, ElementsSkipped);
    if NodeIndex = -1 then
      Result := frNotFound
    else
    begin
      if NodeIndex = (StartIndex + ElementsSkipped) then
        Result := frFoundInSequence
      else
        Result := frFoundOutOfSequence
    end;
  end;

  function ExpectedPosition(const TagName: string): string;
  var
    I: Integer;
  begin
    Result := 'after Unknown';
    with XsdNode do
    begin
      for I := 0 to NodeCount - 1 do
      if SameText(TagName, Nodes[I].Name) then
      begin
        if I = 0 then
          Result := 'first'
        else
          Result := 'after "' + Nodes[I-1].Name + '"';
        Break;
      end;
    end;
  end;

  procedure AppendErrorFmt(const S: string; const Args: array of const);
  begin
   AppendLineFmt(ErrorMsg, S, Args);
  end;

  procedure AppendError(const S: string);
  begin
   AppendLineFmt(ErrorMsg, S, []);
  end;

  procedure CheckNodeNamesValidStartingAtIndex(const StartAt: Integer;
    var ErrorMsg: string);
  var
    J, K: Integer;
    TestName: string;
    TestNameFound: Boolean;
  begin
    for J := 0 to ANode.NodeCount - 1 do
    begin
      if ANode.Nodes[J].ElementType = xeNormal then
      begin
        TestName := ANode.Nodes[J].Name;
        TestNameFound := False;
        for K := 0 to XsdNode.NodeCount - 1 do
        begin
          if TestName = XsdNode.Nodes[K].Name then
          begin
            TestNameFound := True;
            Break;
          end;
        end;
        if not TestNameFound then
          AppendErrorFmt('  The element name "%s" is invalid.',
            [TestName]);
      end;
    end;
  end;

begin
  ErrorMsg := '';
  if (XsdNode.NodeCount > 0) and (ANode.NodeCount > 0) then
  begin
    StartIndex := 0;
    for I := 0 to XsdNode.NodeCount - 1 do
    begin
      TagName := XsdNode.Nodes[I].Name;
      XsdNodeIsLeaf := (XsdNode.Nodes[I].NodeCount = 0);
      Count := 1;
      repeat  {allow for multiple children in ANode with the same name}
        FindResult := FindNext(TagName, Count, StartIndex, NodeIndex,
          ElementsSkipped, ErrorMsg);
        case FindResult of
          frFoundInSequence:
            begin
              CNode := ANode.Nodes[NodeIndex];
              if not ValidateNodesRecursive(CNode, XsdNode.Nodes[I], ErrorSt)
              then
              begin
                AppendError(ErrorSt);
                FindResult := frDone;
              end
              else
              begin
                if XsdNodeIsLeaf then
                begin
                  {ensure context="" is not found and node has no children}
                  with CNode do
                  begin
                    if (AttributeIndexByName(FContextAttributeID) > -1)
                      and (AttributeByName[FContextAttributeID] = '')
                    then
                      AppendErrorFmt('Empty attribute context="" is not allowed'
                       + ' for node "%s"', [XPathOfNode(CNode)]);
                    if NodeCount > 0 then
                      AppendErrorFmt('Child nodes are not allowed for node "%s"',
                        [XPathOfNode(CNode)]);
                    if ErrorMsg <> '' then
                      FindResult := frDone;
                  end;
                end;
                if FindResult <> frDone then
                begin
                  Count := Count + 1;
                  StartIndex :=  ElementsSkipped + NodeIndex + 1;
                  if StartIndex > ANode.NodeCount - 1 then
                    FindResult := frDone;
                end;
              end;
            end;
          frFoundOutOfSequence:
            begin
              ElementName := TagName + '[' + IntToStr(Count-1) + ']';
              AppendErrorFmt(' Error encountered under: "%s"',
                [XPathOfNode(ANode)]);
              {OutOfSequence may be caused by invalid node name so check first}
              {for each node in ANode.Nodes[] check for name in XsdNode.Nodes[]}
              ErrorSt := '';
              CheckNodeNamesValidStartingAtIndex(0, ErrorSt);
              if ErrorSt = '' then
              begin
                AppendErrorFmt('  The element "%s" is out of sequence',
                  [ElementName]);
                if NodeIndex = 0 then
                  AppendErrorFmt('  The element "%s" should occur %s'
                   + ' but was encountered first', [ElementName,
                   ExpectedPosition(TagName)])
                else
                  AppendErrorFmt('  The element "%s" should occur %s but was'
                   + ' encountered after "%s"', [ElementName,
                   ExpectedPosition(TagName), ANode[NodeIndex-1].Name]);
                AppendError('    The encountered sequence of elements was:');
                AppendError('    ' + XPathOfNode(ANode));
                for J := 0 to ANode.NodeCount - 1 do
                begin
                  S := ANode.Nodes[J].Name;
                  if J = NodeIndex then
                    S := S + '   <== found here';
                  AppendError('      ' + S );
                end;
                AppendError('    Expected sequence of elements is:');
                for J := 0 to XsdNode.NodeCount - 1 do
                begin
                  S := XsdNode.Nodes[J].Name;
                  if S = TagName then
                    S := S + '   <== should be here';
                  AppendError('     ' + S);
                end;
              end
              else
               AppendError(ErrorSt); {invalid node names}
            end;
        end;
      until FindResult <> frFoundInSequence;
      if (ErrorMsg <> '') or (FindResult = frDone) then
        Break;
    end;
    {if ok so far then check that last node name in ANode.Nodes[] is valid}
    {because an incorrect last name would slip through the preceeding validation}
    if (StartIndex < ANode.NodeCount ) and (ErrorMsg = '') then
    begin
      CheckNodeNamesValidStartingAtIndex(StartIndex, ErrorMsg);
      if ErrorMsg <> '' then
        ErrorMsg := Format(' Error encountered under: "%s"', [XPathOfNode(ANode)
          ]) + sLineBreak + ErrorMsg;

    end;
  end
  else
  begin
    if (XsdNode.NodeCount = 0) and (ANode.NodeCount > 0) then
    begin
      ErrorMsg := 'Child nodes not allowed for node: "'
        +  XPathOfNode(ANode) + '"';
    end;
  end;
  Result := (ErrorMsg = '');
end;


function TZaphodXmlDoc.ValidatesOK(out ErrorMsg: string): Boolean;
var
  DocRootName: string;
  DocXsdUrl: string;
const
  szmInvalidXsdUrl = 'Invalid value in root node attribute'
   + ' "xsi:noNamespaceSchemaLocation". '
   + 'Attribute value is "%s" but should be "%s".';
  szmValidationFailed = 'Validation failed';
begin
  ErrorMsg := '';
  { check RequiredRootNodeName, XsdUrl if specified, then node sequence if
   XsdSummary <> nil}
  DocRootName := Root.Name;
  DocXsdUrl := Root.AttributeByName['xsi:noNamespaceSchemaLocation'];
  if (DocRootName <> FRequiredRootNodeName) then
    ErrorMsg := Format (szmInvalidRootNode, [DocRootName, FRequiredRootNodeName])
  else
  if (FXsdUrl <> '') and {(DocXsdUrl <> FXsdUrl)}
    not SameText(DocXsdUrl, FXsdUrl) then
    ErrorMsg := Format (szmInvalidXsdUrl, [DocXsdUrl, FXsdUrl])
  else
  if (FXsdSummary <> nil) then
    ValidateNodesRecursive(Root, FXsdSummary.Nodes[0], ErrorMsg);
  if (ErrorMsg <> '') then
    ErrorMsg := szmValidationFailed + sLineBreak + ErrorMsg;
  Result := (ErrorMsg = '');
  //FValidationAttempted := True;
  //FValidatesOK := Result;
end;

end.
