unit AccessIniFile;

interface

uses
  Classes,
  SysUtils,
  IniFiles,
  StringUnit,
//  XPtest,
uses_end;

type
  TIniAccess = (iaRead, iaWrite, iaDeleteKey, iaEraseSection, iaReadSection);

type
  TAccessIniFile = class(TCustomIniFile)
  private
    FFileName: string;
    FOriginalIniFileText: string;
    FSections: TStringList;
    function AccessString(const Section: string; const Ident: string;
     const Value: string; Strings: TStrings; Access: TIniAccess): string;
  public
    constructor Create(const FileName: string);
    destructor Destroy; override;
    function ReadString(const Section, Ident, Default: string): string; override;
    procedure WriteString(const Section, Ident, Value: String); override;
    procedure ReadSection(const Section: string; Strings: TStrings); override;
    procedure ReadSections(Strings: TStrings); override;
    procedure ReadSectionValues(const Section: string; Strings: TStrings); override;
    procedure EraseSection(const Section: string); override;
    procedure DeleteKey(const Section, Ident: String); override;
    procedure UpdateFile; override;
  end;

implementation

{ TAccessIniFile }

constructor TAccessIniFile.Create(const FileName: string);
begin
  FFileName := FileName;
  FSections := TStringList.Create;
  if (Filename <> '') and (FileExists(FFileName)) then
  begin
    FSections.LoadFromFile(FFileName);
  end;
  FOriginalIniFileText := FSections.Text;
end;

destructor TAccessIniFile.Destroy;
begin
  UpdateFile;

  FSections.Free;
  inherited;
end;

procedure TAccessIniFile.UpdateFile;
begin
//  if FOriginalIniFileText <> FSections.Text then
//  begin
//    FSections.SaveToFile(FFileName);
//  end;
  FSections.SaveToFile(FFileName);
end;

{-------------------------------
//  大小文字関係なく検索できるAnsiPos
機能:
備考:
履歴:       2006/07/08(土) 10:52
//--▼----------------------▽--}
function AnsiPosText(const Substr, S: string): Integer;
begin
  Result :=
    AnsiPos(AnsiUpperCase(Substr), AnsiUpperCase(S));
end;
//--△----------------------▲--

{-------------------------------
//  GetName
//    先頭の『=』より左の文字を取得する
//  GetValue
//    先頭の『=』より右の文字を取得する
機能:       戻り値に『=』は含まない。
            内部関数なので呼び出し時に
            LineStrには改行は含まないとみなしておく
備考:
履歴:       2006/07/08(土) 10:52
//--▼----------------------▽--}
function GetName(const LineStr: string): string;
var
  EqualPosition: Integer;
begin
  EqualPosition := AnsiPos('=', LineStr);
  if EqualPosition <= 1 then
  begin
    Result := '';
    Exit;
  end else
  begin
    Result := Copy(LineStr, 1, EqualPosition-1);
  end;
end;

function GetValue(const LineStr: string): string;
var
  EqualPosition: Integer;
begin
  EqualPosition := AnsiPos('=', LineStr);
  if EqualPosition <= 1 then
  begin
    Result := '';
    Exit;
  end else
  begin
    Result := Copy(LineStr, EqualPosition+1, MaxInt);
  end;
end;
//--△----------------------▲--

{-------------------------------
//  『[』と『]』に囲まれた文字を取得する
機能:       複数の『[』や『]』のある事は考慮しない(前方を優先)
            内部関数なので呼び出し時に
            LineStrには改行は含まないとみなしておく
備考:
履歴:       2006/07/08(土) 10:52
//--▼----------------------▽--}
function GetSection(const LineStr: string): string;
var
  BracketStartPosition, BracketEndPosition: Integer;
begin
  BracketStartPosition  := AnsiPos('[', LineStr);
  BracketEndPosition    := AnsiPos(']', LineStr);
  if (1 <= BracketStartPosition)
    and (BracketStartPosition < BracketEndPosition) then
  begin
    Result := Copy(LineStr, BracketStartPosition+1,
      (BracketEndPosition-1) - (BracketStartPosition+1) + 1 )
  end else
  begin
    Result := '';
  end;
end;

procedure testGetSection;
begin
//  Check('123456', GetSection('  [123456]  '));
//  Check('', GetSection('  ]aa[  '));
//  Check('aa', GetSection(' [aa]aa[  '));
//  Check('', GetSection(' []aa[  '));
//  Check('[aa', GetSection(' [[aa]  '));
end;
//--△----------------------▲--

{-------------------------------
//  Iniファイルに関係する行かどうか判断する
機能:
            内部関数なので呼び出し時に
            LineStrには改行は含まないとみなしておく
備考:
履歴:       2006/07/08(土) 10:52
//--▼----------------------▽--}
function IsIniCommentLine(const LineStr: string): Boolean;
begin
  Result := False;
  if AnsiPos(';', TrimLeft(LineStr))=1 then
  begin
    Result := True;
  end;
end;

function IsSectionLine(const LineStr: string): Boolean;
var
  BracketStartPosition, BracketEndPosition: Integer;
begin
  Result := False;
  if IsIniCommentLine(LineStr) then Exit;
  BracketStartPosition  := AnsiPos('[', LineStr);
  BracketEndPosition    := AnsiPos(']', LineStr);
  if (1 <= BracketStartPosition)
    and (BracketStartPosition < BracketEndPosition) then
  begin
    Result := True;
  end;
end;

{-------------------------------
//  AccessIniFile専用トリム
機能:       タブが含まれてたらトリムしない
            タブがなければスペーストリムする       
備考:       
履歴:       2006/07/08(土) 22:55
//--▼----------------------▽--}
//function IniTrim(const S: String): String;
//begin
//  if InStr(TAB, S) then
//  begin
//    Result := S;
//  end else
//  begin
//    Result := TrimChar(S, ' ');
//  end;
//end;
//--△----------------------▲--

function IsIdentLine(const LineStr: string): Boolean;
begin
  Result := False;
  if IsIniCommentLine(LineStr) then Exit;
  if InStr('=', LineStr) then
  begin
    Result := True;
  end;
end;

function IsIniLine(const LineStr: string): Boolean;
begin
  Result := False;
  if IsSectionLine(LineStr) or IsIdentLine(LineStr) then
  begin
    Result := True;
  end;
end;
//--△----------------------▲--

{-------------------------------
//  Iniファイルアクセス関数
機能:       TIniFile互換ではなくて
            実用上問題ないレベルに実装している
            ・Section/Identはインデントされてても問題なく読み取る
            ・Sectionは行Trimして読み取られる
            ・Sectionは[Option]のOption部分はTabトリムが行われている(TIniFile互換)
            ・Identは[=]の前をTrimして読み取られる
            ・Section/Identは大小文字区別しない
            ・[Option]が複数回繰り返されると読み取れない。(TIniFile互換)
              書き込み位置もわからなくなるし。
            ・Section内でIdentが繰り返されて存在しても
              より先頭のIdentの位置を対象とする
            ReadString
            ・Identの判断基準は[=]の有無なので
              『Ident=空文字』という形式なら空文字を返す
              『Ident』のみならDefault文字を返す
            ・ValueはTrimして出力する
            WriteString
            ・Identの判断基準は[=]の有無なので
              『Ident=』という形式なら書き込む
              『Ident』のみなら書き込まない
            ・Section/Identの指定が大小文字変更されていても
              Iniファイルには影響しない
            ・Valueの大小文字は指定されたとおりに書き込む
            ・Valueには前後に空白やタブを含める事ができる
備考:
履歴:       2006/07/08(土) 10:52
            2006/08/02(水)
              引用符(")付きValueに対応した
//--▼----------------------▽--}
function TAccessIniFile.AccessString(const Section: string; const Ident: string;
 const Value: string; Strings: TStrings; Access: TIniAccess): string;
var
  i: Integer;
  j: Integer;
  SectionStartLine: Integer;
  WroteFlag: Boolean;
  SectionExistFlag: Boolean;
  SectionTrimFlag: Boolean;
begin
(*--▽---------------------------▼--
  testGetSection;
//--▲---------------------------△--*)
  Result := Value;
  case Access of
   iaRead, iaWrite, iaDeleteKey:
     if (TrimChar(Section, ' ') = EmptyStr) or (TrimChar(Ident, ' ') = EmptyStr) then Exit;
   iaEraseSection:
     if (TrimChar(Section, ' ') = EmptyStr) then Exit;
   iaReadSection:
     if (TrimChar(Section, ' ') = EmptyStr) or (Strings = nil) then Exit;

  end;

  FSections.Add('[]'); try

  SectionExistFlag := False;
  WroteFlag := False;
  SectionStartLine := -1;

  i := 0; while i <= (FSections.Count - 1) do
  begin
    if (SectionStartLine=-1)
      and (AnsiSameText(TrimChar(Section, ' '), Trim(GetSection(FSections[i])))) then
    begin {↑セクション開始の条件}
      SectionExistFlag := True;
      SectionStartLine := i;
    end else
    if (0<=SectionStartLine)
      and (IsSectionLine(FSections[i])) then
    begin {↑セクション終了の条件}
      {↓セクションが変更になるときに
         書き込みがすんでいない場合は挿入して書き込み}
      case Access of
      iaWrite:
      begin
        if (WroteFlag = False) then
        begin
          {↓書き込み時は前方にIniファイルに関係する行を見つけて
             その次の行に挿入する}
          {※ただし最終行の場合は動作が異なる(TIniFileのバグっぽい)}
          {※更に言うと、その最終行の所がTrimされているなら前方は辿らない}
//(*--▽---------------------------▼--
          if (i = FSections.Count-1) and (Trim(FSections[i-1]) = '') then
          begin
            FSections.Insert(i, TrimChar(Ident, ' ')+'='+Value);
            FSections.Text := FSections.Text;
          end else
//--▲---------------------------△--*)
          begin
            j := i; while IsIniLine(FSections[j-1])=False do
            begin
              Dec(j);
            end;
            FSections.Insert(j, TrimChar(Ident, ' ')+'='+Value);
            FSections.Text := FSections.Text;
          end;
        end;
      end;

      iaEraseSection:
      begin
        SectionTrimFlag := False;
        for j := i-1 downto SectionStartLine do
        begin
          if (Trim(FSections[j])=EmptyStr)
            or IsIniCommentLine(Trim(FSections[j])) then
          begin
          end else
          begin
            SectionTrimFlag := True;
          end;

          if SectionTrimFlag then
          begin
            FSections.Delete(j);
            Dec(i);
          end;
        end;
      end;

      iaReadSection:
      begin
        for j := SectionStartLine to i-1 do
        begin
          if IsIdentLine(FSections[j])
            and (Trim(GetName(FSections[j]))<>EmptyStr) then
          begin
            Strings.Add(Trim(GetName(FSections[j]))+'='+
                        OneTrimChar(Trim(GetValue(FSections[j])), '"'));
          end;
        end;
      end;

      end;

      SectionStartLine := -1;
      Exit; {←一度InSection=TrueになってFalseになったらExitすることで
               重複したSectionも無視する処理になる
               つまり[Option]...[Option]となっていても2回目移行は無視される}
    end;

    if 0<=SectionStartLine then
    begin {↑セクション中の処理}
      if AnsiSameText(TrimChar(Ident, ' '), Trim(GetName(FSections[i]))) then
      begin
        case Access of
        iaRead:
        begin
          Result := OneTrimChar(Trim(GetValue(FSections[i])), '"');
          Exit; {←一度Identを見つけて値を取得した後にExitすることで
                   重複したIdentを無視する処理になる}
        end;

        iaWrite:
        begin
          FSections[i] :=
            GetName(FSections[i]) + '='
            +
            Value;
          FSections.Text := FSections.Text;
          WroteFlag := True;
          Exit;
        end;

        iaDeleteKey:
        begin
          FSections.Delete(i);
          Dec(i);
        end;
        end;

      end;
    end;

    Inc(i);
  end;

  if (SectionExistFlag=False) then
  begin
    case Access of
    iaWrite:
    begin
      if (WroteFlag = False) then
      begin
        FSections.Insert(FSections.Count-1,
          '['+TrimChar(Section, ' ')+']');
        FSections.Insert(FSections.Count-1,
          TrimChar(Ident, ' ')+'='+Value);
        FSections.Text := FSections.Text;
      end;
    end;
    end;
  end;


  finally FSections.Delete(FSections.Count-1); end;
end;

function TAccessIniFile.ReadString(const Section, Ident,
  Default: string): string;
begin
  Result := AccessString(Section, Ident, Default, nil, iaRead);
end;

procedure TAccessIniFile.WriteString(const Section, Ident, Value: String);
begin
  AccessString(Section, Ident, Value, nil, iaWrite);
end;

procedure TAccessIniFile.DeleteKey(const Section, Ident: String);
begin
  AccessString(Section, Ident, '', nil, iaDeleteKey);
end;

procedure TAccessIniFile.EraseSection(const Section: string);
begin
  AccessString(Section, '', '', nil, iaEraseSection);
end;
//--△----------------------▲--


{-------------------------------
//  セクションを列挙する
機能:
備考:
履歴:       2006/07/08(土) 15:35
//--▼----------------------▽--}
procedure TAccessIniFile.ReadSections(Strings: TStrings);
var
  i: Integer;
  SectionText: String;
begin
  if Assigned(Strings) then
  begin
    Strings.Clear;
    for i := 0 to FSections.Count - 1 do
    begin
      SectionText := Trim( GetSection(FSections[i]) );
      if SectionText <> '' then
        Strings.Add(SectionText);
      {↓TIniFileのバグ仕様対応
         空Sectionがあった場合そこで列挙をやめる
         ※純粋にバグっぽいのでこの行いらない気がする}
      if IsSectionLine(FSections[i]) and (SectionText='') then Exit;
    end;
  end;
end;
//--△----------------------▲--

{-------------------------------
//  Section内部の値を取得してStringsに出力する
機能:       ReadSectionValues
              Name=Valueの形式で出力
            ReadSection
              Nameの形式で出力
備考:
履歴:       2006/07/08(土) 16:02
//--▼----------------------▽--}
procedure TAccessIniFile.ReadSectionValues(const Section: string;
  Strings: TStrings);
var
  i: Integer;
  LineName: String;
begin
  if Assigned(Strings) then
  begin
    Strings.Clear;
    AccessString(Section, '', '', Strings, iaReadSection);
    for i := 0 to Strings.Count - 1 do
    begin
     LineName := GetName(Strings[i]);
      Strings[i] := LineName+'='+
        Strings.Values[LineName];
    end;
  end;
end;

procedure TAccessIniFile.ReadSection(const Section: string; Strings: TStrings);
var
  i: Integer;
begin
  ReadSectionValues(Section, Strings);
  for i := 0 to Strings.Count - 1 do
  begin
    Strings[i] := GetName(Strings[i]);
  end;
end;
//--△----------------------▲--


end.