環境設定ファイルに XML を使いたい (Delphi 2009 以降)

　環境設定を保存するには幾つか方法があります。

　どちらでも構わないのですが、双方に欠点があります。Ini ファイルは階層を持つような構造を表現しにくく、階層を扱うには一手間必要です。レジストリは USB フラッシュに持ち出すようなアプリケーションには使えないのと、とにかくレジストリが嫌いなヒトがいます。

　XML を環境設定ファイルに使えば、どちらの欠点もカバーできるのですが、XML を扱う TXMLDocument はとにかく操作が面倒で、慣れないと様々なエラーを拝む事になります。本格的に XML を使いたい訳ではなく、単に環境設定ファイルとして使いたいだけなのに、面倒で面倒で仕方ありません。

　RTL にはレジストリを Ini ファイルのように扱う TRegIniFile というクラスがあります。そこで同様に、"XML を Ini ファイルのように扱うクラス" を作ってみました。コードは Delphi 2009 以降が対象となっています...動作対象が Windows 2000 以降なら、MSXML の心配をしなくていいからです。

{*******************************************************}
{                                                       }
{               XMLIniFile Unit ver 1.02                }
{                                                       }
{              Copyright(c) 2010-2012 DEKO              }
{                                                       }
{                                                       }
{*******************************************************}

unit XMLInifiles;

{$R-,T-,H+,X+}

interface

uses
  Sysutils, Classes, XMLDoc, XMLIntf, Variants {$IFDEF MSWINDOWS}, Windows{$ENDIF};

type
  TXMLNodeType = (xdtUnknown, xdtBinary, xdtBool, xdtCurrency, xdtDate,
                  xdtDateTime, xdtExpandString, xdtFloat, xdtInt64, xdtInteger,
                  xdtString, xdtTime);

  TXMLIniFile = class(TObject)
  private
    FCurrentNode: IXMLNode;
    FCurrentLocationPath: string;
    FRootNode: IXMLNode;
    FXML: IXMLDocument; // not TXMLDocument
                        // http://edn.embarcadero.com/jp/article/29241
  protected
    function BuildLocationPath(LocationPath: string): string;
    procedure ChangeNode(Value: IXMLNode; const Path: string);
    function GetBaseNode(Relative: Boolean): IXMLNode;
    function GetNode(const LocationPath: string): IXMLNode;
    function GetRawNode(ParentNode: IXMLNode): IXMLNode;
    function GetRootNodeName: string;
    function GetReadNode(const TagName: string; ParentNode: IXMLNode = nil): IXMLNode;
    function GetWriteNode(const TagName: string; ParentNode: IXMLNode = nil): IXMLNode;
  public
    constructor Create(const FileName: string);
    destructor Destroy; override;
    { Methods }
    procedure CloseNode;
    function CreateNode(const TagName: string; ParentNode: IXMLNode = nil): Boolean;
    function DeleteNode(const TagName: string; ParentNode: IXMLNode = nil): Boolean;
    function GetNodeType(const TagName: String; ParentNode: IXMLNode = nil): TXMLNodeType;
    procedure GetNodeNames(Strings: TStrings; ParentNode: IXMLNode = nil);
    function HasChildNodes(ParentNode: IXMLNode = nil): Boolean;
    function NodeExists(const LocationPath: string): Boolean;
    function OpenNode(const LocationPath: string; CanCreate: Boolean): Boolean;
    procedure ReadBinaryData(const TagName: string; var Buffer: TBytes; ParentNode: IXMLNode = nil);
    function ReadBool(const TagName: string; Default: Boolean; ParentNode: IXMLNode = nil): Boolean;
    function ReadCurrency(const TagName: string; Default: Currency; ParentNode: IXMLNode = nil): Currency;
    function ReadDate(const TagName: string; Default: TDateTime; ParentNode: IXMLNode = nil): TDateTime;
    function ReadDateTime(const TagName: string; Default: TDateTime; ParentNode: IXMLNode = nil): TDateTime;
    {$IFDEF MSWINDOWS}
    function ReadExpandString(const TagName: string; Default: string; ParentNode: IXMLNode = nil): string; platform;
    {$ENDIF}
    function ReadFloat(const TagName: string; Default: Double; ParentNode: IXMLNode = nil): Double;
    function ReadInt64(const TagName: string; Default: Int64; ParentNode: IXMLNode = nil): Int64;
    function ReadInteger(const TagName: string; Default: Integer; ParentNode: IXMLNode = nil): Integer;
    function ReadString(const TagName: string; Default: string; ParentNode: IXMLNode = nil): string;
    function ReadTime(const TagName: string; Default: TDateTime; ParentNode: IXMLNode = nil): TDateTime;
    function ChildNodeByName(const TagName: string; ParentNode: IXMLNode = nil): IXMLNode;
    function ChildNodes(const Index: Integer; ParentNode: IXMLNode = nil): IXMLNode;
    function ChildNodesCount(ParentNode: IXMLNode = nil): Integer;
    procedure UpdateFile;
    procedure WriteCurrency(const TagName: string; Value: Currency; ParentNode: IXMLNode = nil);
    procedure WriteBinaryData(const TagName: string; var Buffer: TBytes; ParentNode: IXMLNode = nil);
    procedure WriteBool(const TagName: string; Value: Boolean; ParentNode: IXMLNode = nil);
    procedure WriteDate(const TagName: string; Value: TDateTime; ParentNode: IXMLNode = nil);
    procedure WriteDateTime(const TagName: string; Value: TDateTime; ParentNode: IXMLNode = nil);
    {$IFDEF MSWINDOWS}
    procedure WriteExpandString(const TagName, Value: string; ParentNode: IXMLNode = nil); platform;
    {$ENDIF}
    procedure WriteFloat(const TagName: string; Value: Double; ParentNode: IXMLNode = nil);
    procedure WriteInt64(const TagName: string; Value: Int64; ParentNode: IXMLNode = nil);
    procedure WriteInteger(const TagName: string; Value: Integer; ParentNode: IXMLNode = nil);
    procedure WriteString(const TagName, Value: string; ParentNode: IXMLNode = nil);
    procedure WriteTime(const TagName: string; Value: TDateTime; ParentNode: IXMLNode = nil);
    { Properties }
    property CurrentNode: IXMLNode read FCurrentNode;
    property CurrentLocationPath: string read FCurrentLocationPath;
    property RootNode: IXMLNode read FRootNode;
    property RootNodeName: string read GetRootNodeName;
    property XMLDocument: IXMLDocument read FXML;
  end;

{ functions }
function IsLocationPathDelimiter(const LocationPath: string; Index: Integer): Boolean;
function IncludeTrailingLocationPathDelimiter(const LocationPath: string): string;
function ExcludeTrailingLocationPathDelimiter(const LocationPath: string): string;
function FormatXMLFile(const FileName: string): Boolean;

const
  LocationPathDelim = '/';

implementation

const
  sType = 'Type';
  sCRLF = #$000D#$000A;

constructor TXMLIniFile.Create(const FileName: string);
begin
  FXML := TXMLDocument.Create(nil);
  FXML.Active   := True;
  FXML.FileName := FileName;
  FXML.NodeIndentStr := #$0009;
  FXML.Options  := [doNodeAutoIndent];
  if (FXML.FileName <> '') and  FileExists(FXML.FileName) then
    FXML.LoadFromFile(FXML.FileName)
  else
    begin
      FXML.Encoding := 'utf-8';
      FXML.Version  := '1.0';
      FXML.AddChild('root');
      if FXML.FileName <> '' then
        FXML.SaveToFile(FXML.FileName);
    end;
  FRootNode     := FXML.DocumentElement;
  FCurrentNode  := FCurrentNode;
  FCurrentLocationPath := LocationPathDelim;
end;

destructor TXMLIniFile.Destroy;
begin
  FXML.Active := False;
end;

function TXMLIniFile.BuildLocationPath(LocationPath: string): string;
begin
  if Copy(LocationPath, 1, 1) = LocationPathDelim then
    result := IncludeTrailingLocationPathDelimiter(LocationPath)
  else
    result := IncludeTrailingLocationPathDelimiter(IncludeTrailingLocationPathDelimiter(CurrentLocationPath) + LocationPath);
end;

procedure TXMLIniFile.ChangeNode(Value: IXMLNode; const Path: string);
begin
  CloseNode;
  FCurrentNode := Value;
  FCurrentLocationPath := Path;
end;

function TXMLIniFile.GetBaseNode(Relative: Boolean): IXMLNode;
begin
  if (CurrentNode = nil) or (not Relative) then
    Result := RootNode
  else
    Result := CurrentNode;
end;

function TXMLIniFile.GetNode(const LocationPath: string): IXMLNode;
var
  dNode: IXMLNode;
  SL: TStringList;
  i: Integer;
begin
  SL := TStringList.Create;
  try
    SL.StrictDelimiter := True;
    SL.Delimiter       := LocationPathDelim;
    SL.DelimitedText   := BuildLocationPath(LocationPath);
    dNode := FXML.DocumentElement;
    for i:=1 to SL.Count - 2 do
      begin
        dNode := dNode.ChildNodes.FindNode(SL[i]);
        if dNode = nil then
          Break;
      end;
  finally
    SL.Free;
  end;
  result := dNode;
end;

function TXMLIniFile.GetRawNode(ParentNode: IXMLNode): IXMLNode;
begin
  if ParentNode = nil then
    result := FCurrentNode
  else
    result := ParentNode;
end;

function TXMLIniFile.GetRootNodeName: string;
begin
  FRootNode.NodeName;
end;

function TXMLIniFile.GetReadNode(const TagName: string; ParentNode: IXMLNode = nil): IXMLNode;
begin
  result := GetRawNode(ParentNode).ChildNodes.FindNode(TagName);
end;

function TXMLIniFile.GetWriteNode(const TagName: string; ParentNode: IXMLNode = nil): IXMLNode;
var
  dNode: IXMLNode;
begin
  dNode := GetRawNode(ParentNode);
  result := dNode.ChildNodes.FindNode(TagName);
  if result = nil then
    result := dNode.AddChild(TagName);
end;

procedure TXMLIniFile.CloseNode;
begin
  ;
end;

function TXMLIniFile.CreateNode(const TagName: string; ParentNode: IXMLNode = nil): Boolean;
begin
  try
    GetRawNode(ParentNode).AddChild(TagName);
    result := True;
  except
    result := False;
  end;
end;

function TXMLIniFile.DeleteNode(const TagName: string; ParentNode: IXMLNode = nil): Boolean;
begin
  try
    GetRawNode(ParentNode).ChildNodes.Delete(TagName);
    result := True;
  except
    result := False;
  end;
end;

procedure TXMLIniFile.GetNodeNames(Strings: TStrings; ParentNode: IXMLNode = nil);
var
  i: integer;
  dNode: IXMLNode;
begin
  dNode := GetRawNode(ParentNode);
  for i:=0 to dNode.ChildNodes.Count-1 do
    Strings.Add(dNode.ChildNodes[i].NodeName);
end;

function TXMLIniFile.GetNodeType(const TagName: String; ParentNode: IXMLNode = nil): TXMLNodeType;
begin
  result := GetRawNode(ParentNode).ChildNodes.FindNode(TagName).Attributes[sType];
end;

function TXMLIniFile.HasChildNodes(ParentNode: IXMLNode = nil): Boolean;
begin
  result := GetRawNode(ParentNode).HasChildNodes;
end;

function TXMLIniFile.NodeExists(const LocationPath: string): Boolean;
begin
  result := (GetNode(LocationPath) <> nil);
end;

function TXMLIniFile.OpenNode(const LocationPath: string; CanCreate: Boolean): Boolean;
var
  oNode: IXMLNode;
  dNode: IXMLNode;
  SL: TStringList;
  i: Integer;
begin
  if CanCreate then
    begin
      SL := TStringList.Create;
      try
        result := False;
        SL.StrictDelimiter := True;
        SL.Delimiter       := LocationPathDelim;
        SL.DelimitedText   := BuildLocationPath(LocationPath);
        dNode := FXML.DocumentElement;
        oNode := dNode;
        for i:=1 to SL.Count - 2 do
          begin
            dNode := dNode.ChildNodes.FindNode(SL[i]);
            if dNode = nil then
              dNode := oNode.AddChild(SL[i]);
            oNode := dNode;
          end;
        result := True;
      finally
        SL.Free;
      end;
    end
  else
    begin
      dNode  := GetNode(LocationPath);
      result := (dNode <> nil);
    end;
  if result then
    begin
      FCurrentNode := dNode;
      FCurrentLocationPath := BuildLocationPath(LocationPath);
    end;
end;

function TXMLIniFile.ReadCurrency(const TagName: string; Default: Currency; ParentNode: IXMLNode = nil): Currency;
var
  dNode: IXMLNode;
begin
  dNode := GetReadNode(TagName, ParentNode);
  if dNode = nil then
    result := Default
  else
    result := StrToCurr(dNode.Text);
end;

procedure TXMLIniFile.ReadBinaryData(const TagName: string; var Buffer: TBytes; ParentNode: IXMLNode = nil);
var
  dNode: IXMLNode;
  Size: Int64;
  Dmy: String;
  i: Integer;
  SL: TStringList;
begin
  dNode := GetReadNode(TagName, ParentNode);
  if dNode = nil then
    SetLength(Buffer, 0)
  else
    begin
      SL := TStringList.Create;
      try
        Dmy := dNode.Text;
        Dmy := StringReplace(Dmy, sCRLF, '', [rfReplaceAll]);
        Dmy := StringReplace(Dmy, ' ', '', [rfReplaceAll]);
        SL.StrictDelimiter := True;
        SL.Delimiter       := ',';
        SL.DelimitedText   := Dmy;
        Dmy := '';
        Size := 0;
        SetLength(Buffer, SL.Count);
        for i:=0 to SL.Count-1 do
          begin
            Dmy := Trim(SL[i]);
            if Dmy = '' then
              Continue;
            Buffer[i] := StrToInt('0x' + Dmy);
            Inc(Size);
          end;
        SetLength(Buffer, Size);
      finally
        SL.Free;
      end;
    end;
end;

function TXMLIniFile.ReadBool(const TagName: string; Default: Boolean; ParentNode: IXMLNode = nil): Boolean;
var
  dNode: IXMLNode;
begin
  dNode := GetReadNode(TagName, ParentNode);
  if dNode = nil then
    result := Default
  else
    result := StrToBool(dNode.Text);
end;

function TXMLIniFile.ReadDate(const TagName: string; Default: TDateTime; ParentNode: IXMLNode = nil): TDateTime;
var
  dNode: IXMLNode;
begin
  dNode := GetReadNode(TagName, ParentNode);
  if dNode = nil then
    result := Default
  else
    result := VarToDateTime(dNode.Text);
end;

function TXMLIniFile.ReadDateTime(const TagName: string; Default: TDateTime; ParentNode: IXMLNode = nil): TDateTime;
var
  dNode: IXMLNode;
begin
  dNode := GetReadNode(TagName, ParentNode);
  if dNode = nil then
    result := Default
  else
    result := VarToDateTime(dNode.Text);
end;

{$IFDEF MSWINDOWS}
function TXMLIniFile.ReadExpandString(const TagName: string; Default: string; ParentNode: IXMLNode = nil): string;
var
  Dmy: String;
  Size: DWORD;
begin
  Dmy := ReadString(TagName, Default, ParentNode);
  Size := ExpandEnvironmentStrings(PChar(Dmy), nil, 0);
  SetLength(result, Size * 2);
  Size := ExpandEnvironmentStrings(PChar(Dmy),PChar(result), Size * 2);
  SetLength(result, Size);
end;
{$ENDIF}

function TXMLIniFile.ReadFloat(const TagName: string; Default: Double; ParentNode: IXMLNode = nil): Double;
var
  dNode: IXMLNode;
begin
  dNode := GetReadNode(TagName, ParentNode);
  if dNode = nil then
    result := Default
  else
    result := StrToFloat(dNode.Text);
end;

function TXMLIniFile.ReadInt64(const TagName: string; Default: Int64; ParentNode: IXMLNode = nil): Int64;
var
  dNode: IXMLNode;
begin
  dNode := GetReadNode(TagName, ParentNode);
  if dNode = nil then
    result := Default
  else
    result := StrToInt64(dNode.Text);
end;

function TXMLIniFile.ReadInteger(const TagName: string; Default: Integer; ParentNode: IXMLNode = nil): Integer;
var
  dNode: IXMLNode;
begin
  dNode := GetReadNode(TagName, ParentNode);
  if dNode = nil then
    result := Default
  else
    result := StrToInt(dNode.Text);
end;

function TXMLIniFile.ReadString(const TagName: string; Default: string; ParentNode: IXMLNode = nil): string;
var
  Dmy: String;
  dNode: IXMLNode;
begin
  dNode := GetReadNode(TagName, ParentNode);
  if dNode = nil then
    result := Default
  else
    begin
      Dmy := dNode.Text;
      Dmy := StringReplace(Dmy ,'&gt;'  ,'>',[rfReplaceAll,rfIgnoreCase]); // >
      Dmy := StringReplace(Dmy ,'&lt;'  ,'<',[rfReplaceAll,rfIgnoreCase]); // <
      Dmy := StringReplace(Dmy ,'&quot;','"',[rfReplaceAll,rfIgnoreCase]); // "
      Dmy := StringReplace(Dmy ,'&amp;' ,'&',[rfReplaceAll,rfIgnoreCase]); // &
      result := Dmy;
    end;
end;

function TXMLIniFile.ReadTime(const TagName: string; Default: TDateTime; ParentNode: IXMLNode = nil): TDateTime;
var
  dNode: IXMLNode;
begin
  dNode := GetReadNode(TagName, ParentNode);
  if dNode = nil then
    result := Default
  else
    result := VarToDateTime(dNode.Text);
end;

function TXMLIniFile.ChildNodeByName(const TagName: string; ParentNode: IXMLNode = nil): IXMLNode;
begin
  result := GetRawNode(ParentNode).ChildNodes.Nodes[TagName];
end;

function TXMLIniFile.ChildNodes(const Index: Integer; ParentNode: IXMLNode = nil): IXMLNode;
begin
  result := GetRawNode(ParentNode).ChildNodes.Nodes[Index];
end;

function TXMLIniFile.ChildNodesCount(ParentNode: IXMLNode = nil): Integer;
begin
  result := GetRawNode(ParentNode).ChildNodes.Count;
end;

procedure TXMLIniFile.UpdateFile;
begin
  if FXML.Modified then
    if FXML.FileName <> '' then
      FXML.SaveToFile(FXML.FileName);
end;

procedure TXMLIniFile.WriteCurrency(const TagName: string; Value: Currency; ParentNode: IXMLNode = nil);
begin
  GetWriteNode(TagName, ParentNode).Text := CurrToStr(Value);
  GetWriteNode(TagName, ParentNode).Attributes[sType] := xdtCurrency;
end;

procedure TXMLIniFile.WriteBinaryData(const TagName: string; var Buffer: TBytes; ParentNode: IXMLNode = nil);
var
  Size: Int64;
  Dmy: String;
  i: Integer;
begin
  Dmy := '';
  Size := Length(Buffer);
  for i:=0 to Size - 1 do
    begin
      Dmy := Dmy + Format('%.2x', [Buffer[i]]);
      if i < Size - 1 then
        begin
          Dmy := Dmy + ',';
          if (i mod 16) = 15 then
            Dmy := Dmy + sCRLF;
        end;
    end;
  GetWriteNode(TagName, ParentNode).Text := Dmy;
  GetWriteNode(TagName, ParentNode).Attributes[sType] := xdtBinary;
end;

procedure TXMLIniFile.WriteBool(const TagName: string; Value: Boolean; ParentNode: IXMLNode = nil);
begin
  GetWriteNode(TagName, ParentNode).Text := BoolToStr(Value);
  GetWriteNode(TagName, ParentNode).Attributes[sType] := xdtBool;
end;

procedure TXMLIniFile.WriteDate(const TagName: string; Value: TDateTime; ParentNode: IXMLNode = nil);
begin
  GetWriteNode(TagName, ParentNode).Text := DateToStr(Value);
  GetWriteNode(TagName, ParentNode).Attributes[sType] := xdtDate;
end;

procedure TXMLIniFile.WriteDateTime(const TagName: string; Value: TDateTime; ParentNode: IXMLNode = nil);
begin
  GetWriteNode(TagName, ParentNode).Text := DateTimeToStr(Value);
  GetWriteNode(TagName, ParentNode).Attributes[sType] := xdtDateTime;
end;

{$IFDEF MSWINDOWS}
procedure TXMLIniFile.WriteExpandString(const TagName, Value: string; ParentNode: IXMLNode = nil);
begin
  WriteString(TagName, Value, ParentNode);
  GetWriteNode(TagName, ParentNode).Attributes[sType] := xdtExpandString;
end;
{$ENDIF}

procedure TXMLIniFile.WriteFloat(const TagName: string; Value: Double; ParentNode: IXMLNode = nil);
begin
  GetWriteNode(TagName, ParentNode).Text := FloatToStr(Value);
  GetWriteNode(TagName, ParentNode).Attributes[sType] := xdtFloat;
end;

procedure TXMLIniFile.WriteInt64(const TagName: string; Value: Int64; ParentNode: IXMLNode = nil);
begin
  GetWriteNode(TagName, ParentNode).Text := IntToStr(Value);
  GetWriteNode(TagName, ParentNode).Attributes[sType] := xdtInt64;
end;

procedure TXMLIniFile.WriteInteger(const TagName: string; Value: Integer; ParentNode: IXMLNode = nil);
begin
  GetWriteNode(TagName, ParentNode).Text := IntToStr(Value);
  GetWriteNode(TagName, ParentNode).Attributes[sType] := xdtInteger;
end;

procedure TXMLIniFile.WriteString(const TagName, Value: string; ParentNode: IXMLNode = nil);
var
  Dmy: String;
begin
  Dmy := Value;
  Dmy := StringReplace(Dmy ,'&','&amp;' ,[rfReplaceAll,rfIgnoreCase]); // &
  Dmy := StringReplace(Dmy ,'>','&gt;'  ,[rfReplaceAll,rfIgnoreCase]); // >
  Dmy := StringReplace(Dmy ,'<','&lt;'  ,[rfReplaceAll,rfIgnoreCase]); // <
  Dmy := StringReplace(Dmy ,'"','&quot;',[rfReplaceAll,rfIgnoreCase]); // "
  GetWriteNode(TagName, ParentNode).Text := Dmy;
  GetWriteNode(TagName, ParentNode).Attributes[sType] := xdtString;
end;

procedure TXMLIniFile.WriteTime(const TagName: string; Value: TDateTime; ParentNode: IXMLNode = nil);
begin
  GetWriteNode(TagName, ParentNode).Text := TimeToStr(Value);
  GetWriteNode(TagName, ParentNode).Attributes[sType] := xdtTime;
end;

{ functions }
function IsLocationPathDelimiter(const LocationPath: string; Index: Integer): Boolean;
begin
  Result := (Index > 0) and (Index <= Length(LocationPath)) and (LocationPath[Index] = LocationPathDelim);
end;

function IncludeTrailingLocationPathDelimiter(const LocationPath: string): string;
begin
  Result := LocationPath;
  if not IsLocationPathDelimiter(Result, Length(Result)) then
    Result := Result + LocationPathDelim;
end;

function ExcludeTrailingLocationPathDelimiter(const LocationPath: string): string;
begin
  Result := LocationPath;
  if IsLocationPathDelimiter(Result, Length(Result)) then
    SetLength(Result, Length(Result)-1);
end;

function FormatXMLFile(const FileName: string): Boolean;
var
  FXML: IXMLDocument;
begin
  result := False;
  if not FileExists(FileName) then
    Exit;
  FXML := TXMLDocument.Create(nil);
  try
    FXML.LoadFromFile(FileName);
    FXML.XML.Text := XMLDoc.FormatXMLData(FXML.XML.Text);
    FXML.Active := True;
    FXML.SaveToFile(FileName);
    result := True;
  finally
  end;
end;

end.

　同様の実装は以前から存在しますが、あまりにも簡易すぎたり、あまりにも重装備だったりで、環境設定ファイル用に使うには向かないように思えましたので、車輪の再発明と相成った訳です。

XML の書き出し

　環境設定を書き出すコードは以下のようになります。

var
  XML: TXMLIniFile;
begin  
  XML := TXMLIniFile.Create('TEST.XML');
  try
    XML.OpenNode('/Option' , True);
    XML.WriteInteger('Width'  , Width );
    XML.WriteInteger('Height' , Height);
    XML.CloseNode;
    XML.UpdateFile; // 実際に書き込み
  finally
    XML.Free;
  end;
end;  

　実際に書き出された XML はこうなります。XML は "Name=Value" 形式ではないので、Ini ファイルや レジストリに慣れた方からすると違和感があるかもしれません。

<?xml version="1.0" encoding="utf-8"?>
<root>
        <Option>
                <Width Type="9">640</Width>
                <Height Type="9">480</Height>
        </Option>
</root>

　XML は UTF-8 で書き出されます。

XML の読み込み

　環境設定を読み込むコードは以下のようになります。

var
  XML: TXMLIniFile;
begin  
  XML := TXMLIniFile.Create('TEST.XML');
  try
    XML.OpenNode('/Option' , True);
    Width  := XML.ReadInteger('Width'  , 640);
    Height := XML.ReadInteger('Height' , 480);
    XML.CloseNode;
  finally
    XML.Free;
  end;
end;  

　とても簡単ですね。

階層を持つ環境設定ファイル (簡易)

var
  XML: TXMLIniFile;
begin  
  XML := TXMLIniFile.Create('TEST.XML');
  try
    // /Option
    XML.OpenNode('/Option' , True);
    XML.WriteInteger('Width'  , Width );
    XML.WriteInteger('Height' , Height);
    XML.DeleteNode('KeyBind'); // /Option/KeyBind 以下を削除

    // /Option/KeyBind
    XML.OpenNode('/Option/KeyBind' , True);
    XML.WriteString('Save'      , 'Ctrl+S');
    XML.WriteString('SelectAll' , 'Ctrl+A');
    XML.CloseNode;

    XML.UpdateFile; // 実際に書き込み
  finally
    XML.Free;
  end;
end;  

　実際に書き出された XML はこうなります。

<?xml version="1.0" encoding="utf-8"?>
<root>
        <Option>
                <Width Type="9">640</Width>
                <Height Type="9">480</Height>   
                <KeyBind>
                        <Save Type="10">Ctrl+S</Save>
                        <SelectAll Type="10">Ctrl+A</SelectAll>
                </KeyBind>
        </Option>
</root>

　ここまでは Ini ファイルでもなんとか実現できます。

階層を持つ環境設定ファイル (高度)

uses
  ..., XMLIniFiles, XMLDoc, XMLIntf;

var
  i: Integer;
  dNode: IXMLNode;
begin
  ComboBox1.Items.Clear;
  ComboBox1.Items.AddObject('Delphi 2007', TObject(185));
  ComboBox1.Items.AddObject('Delphi 2009', TObject(200));
  ComboBox1.Items.AddObject('Delphi 2010', TObject(210));

  XML := TXMLIniFile.Create('TEST.XML');
  try
    // /Option
    XML.OpenNode('/Option' , True);
    XML.WriteInteger('Width'  , Width );
    XML.WriteInteger('Height' , Height);
    XML.DeleteNode('Version'); // /Option/Version 以下を削除

    // /Option/Version
    XML.OpenNode('/Option/Version', True);
    for i:=0 to ComboBox1.Items.Count-1 do
      begin
        dNode := XML.CurrentNode.AddChild('Item');
        XML.WriteString('Name'  , ComboBox1.Items[i] , dNode);
        XML.WriteInteger('Value', Integer(ComboBox1.Items.Objects[i]), dNode);
      end;
    XML.CloseNode;

    XML.UpdateFile; // 実際に書き込み
  finally
    XML.Free;
  end;
end;

　実際に書き出された XML はこうなります。

<?xml version="1.0" encoding="utf-8"?>
<root>
        <Option>
                <Width Type="9">640</Width>
                <Height Type="9">480</Height>
                <Version>
                        <Item>
                                <Name Type="10">Delphi 2007</Name>
                                <Value Type="9">185</Value>
                        </Item>
                        <Item>
                                <Name Type="10">Delphi 2009</Name>
                                <Value Type="9">200</Value>
                        </Item>
                        <Item>
                                <Name Type="10">Delphi 2010</Name>
                                <Value Type="9">210</Value>
                        </Item>
                </Version>
        </Option>
</root>

　IXMLNode を透過的に扱えるので、ある程度複雑な事もこなせます。"ParentNode: IXMLNode" を引数に持つメソッドは ParentNode を指定しなかった場合、OpenNode() のカレントノードが親になりますが、指定した場合には指定したノードを親とします(カレントは移動しません)。これは同一のノードに同じ名前 (TagName) の子ノードがあっても処理できる事を意味します。レジストリでも実現できない処理です。

　わざわざ、子ノードを作って値を保存するのは冗長に思えるかもしれません。Attribute に値を保存すればいいからです。ただ、TXMLIniFile は利便性のため、Attribute に "Type" という属性を付加しています。この属性は、GetNodeType() で取得でき、格納された値の種類を表しています。

階層を持つ環境設定ファイル (高度) の読み込み

var
  i: Integer;
  XML: TXMLIniFile;
begin
  XML := TXMLIniFile.Create('TEST.XML');
  try
    // /Option
    Memo1.Lines.Clear;
    XML.OpenNode('/Option/Version' , True);
    for i:=0 to XML.CurrentNode.ChildNodes.Count - 1 do
      begin
        Memo1.Lines.Add(XML.CurrentNode.ChildNodes[i].ChildValues['Name']);
        Memo1.Lines.Add(XML.CurrentNode.ChildNodes[i].ChildValues['Value']);
      end;
  finally
    XML.Free;
  end;
end;

　また、ノード名 (TagName) には空白を含める事ができません。"<Delphi 2010></Delphi 2010>" のように空白が含まれると、Attribute との境界がわからなくなるからです。Ini ファイルやレジストリでは空白を含む名前が使えますので、この点には注意が必要です。

　引数 "TagName: string" にはノード名が指定でき、"LocationPath: string" には、相対/絶対 の"ロケーションパス (XPath)" が指定できます (但し、"." や ".." は未実装)。

備考

　XE 以降には Embarcadero 謹製の TXMLIniFile / TXmlMemIniFile があります (XMLIniFile 名前空間)。

See Also:

 BACK