2009年06月15日

INI ファイル操作関数

【 関連記事 : Open Output ステートメント


現在のバージョンは Ver 2.3 です ( 2011/ 7/26 )。


VBA版(WinAPI 利用) でも作っていましたが、OOo.Basic へ移植しました。
※ この OOo.Basic 版を VBA に逆移植しました。 (2009/7/12)
     Ver2.3 を VBA に逆移植しました([x64] 対応済)。 (2011/7/27)



(2009/6/16  Ver 1.1 : Value に改行コードを挿入可)
(2009/6/22  Ver 1.2 : InStr のCompare引数の記述 , 関連記事
(2009/6/29  Ver 1.3 : IniSecExist を追加)
      今後のアドイン公開に備えて、関数名プリフィックスの 'kt' を外します。
(2009/7/12 Ver 2.1 : IniSecExist , IniGetValue のバグ修正)
(2009/7/22  Ver 2.2 : IniBatchGetValue  , IniBatchUpdValue を追加)
(2011/7/26  Ver 2.3 : マクロの変更(機能変更)はありません。
                             [ prvIniOutput ] 内にコメント(赤字部分)を追記しただけです)。
                             尚、VBA への逆移植版では API:SHCreateDirectoryEx 処理
                             等で追加した部分があります。



--- 共通事項 ---
(1) ファイルは ドライブ名から始まる Path 形式、もしくは file:/// から
    始まる URL 形式のどちらかで指定します(VBA版はPath形式のみ)。
(2) 関数の返却値は Variant型変数で受け取ります。
    実行に成功した場合は、配列 / Value値 または True/False が返り、
    失敗した場合には、その理由が Null または エラー値 で返りますので、
    受け取り方は下記例・テストサブルーチンを参考にしてください。
(3) 配列の構造は ( 1 to n , 1 to 2 ) になっており、
    データ件数は UBound(配列, 1) で取得できます。
(4) Section/Keyに指定する文字の大文字/小文字は区別されません。
    ただし、Rewrite で Section/Key が新規作成される時は、指定した
    文字の内容で書き込まれます。
(5) Value には【改行コード(CR or LF or CRLF) 】を含める事ができます。
    (INI ファイル上には "<CR>" , "<LF>" で書き込まれますが、
     IniKeyValueList / IniGetValue で読み込めば、再び
     改行コードに復元されますので特に意識する必要はありません)


--- 効率的な使い方 ---
単発での利用の場合は、IniGetValue/IniRewrite/IniDelete を
使ってください。複数のキーを一度に更新する場合に IniRewrite 等
を使うと、その都度ファイル入出力を行ないますので非効率です。この
場合には
  (a) IniKeyValueList で Key-Value 配列データを一括取得。
  (b) IniBatchGetValue/IniBatchUpdValue により配列データ
       に対して更新処理などを実施。
  (c) IniRewriteBatch で、更新済みの配列データを一括でファイル
       へ反映させます。
という風に処理してください。



--- 利用例 および エラー返却値 ( サンプルマクロも参照 ) ---
Dim i As Long
Dim vntINI As Variant
vntINI = IniKeyValueList(FilePath ,SectionName )
If IsError(vntINI) Or IsNull(vntINI) Then
  MsgBox Err2Str(vntINI)
Else
  For i = 1 to UBound(vntINI, 1)
    MsgBox vntINI(i, 1) & " , " & vntINI(i, 2)
  Next i
End If

--- Error Response ---
Err(52)    : FileName Error(The extension is not ".ini")
Err(53)    : File is not found
Err(other) : Other Error
#VALUE(519): Section is nothing in file , Section is not found
             Section/Key is the null string("")
Null       : Key not found , Key-Value is nothing in Section

--- 関数の機能 ---
(a) IniSecExist ( INI_File , Section ) As Variant
   Section を指定して、ファイル内にその「Section」が有る場合には
   True を返します。ファイル内に無い場合、及び ファイル自体が無い
   場合は False を返します。

(b) IniSecList ( INI_File ) As Variant
   ファイル内の「Section と Key数」のセットを配列で取得します。

(c) IniKeyValueList ( INI_File , Section ) As Variant
   Section を指定して、そのSection 内にある全ての「Key と 値」のセットを
   配列で取得します。
    Key-Value配列データとの入出力には IniBatchGetValue および
    IniBatchUpdValue を利用してください。

(d) IniGetValue ( INI_File , Section , Key ) As Variant
   Section と Key を指定して、その値を文字列で取得します。

(e) IniRewrite ( INI_File , Section , Key , Value ) As Variant
   Section と Key を指定して「値(文字列)」を書き込みます(成功した場合は
   True が返ります)。
   数値/日付の場合には、Format 関数により編集した内容を指定して下さい。
   既に存在しているSection/Key の場合には変更処理、未登録のSection/Key
   の場合には追加処理となります。
   Section/Key には、空文字("")・角カッコ("[" , "]")・イコール("=")は指定
   できません。また、指定した INI ファイルが存在しない場合には自動的に指定
   のパスでファイルを作成した後に書き込みます。

(f) IniDelete ( INI_File , Section [ , Key ] ) As Variant
   Section と Key を指定すると、その「Key 」を削除し、   Key を省略(または
   空文字)すると、「Section 」を削除します(成功した場合は True が返ります)。

(g) IniAllList ( INI_File ) As Variant
    INI ファイル内の全データを一括取得します。データは下記の配列構造
    となっています。
          ( Section , ( Key , Value ) or NULL )
    Section 内に Key/Value が 1件も無い場合には、第2要素は Null です。
    Key/Value が有る場合には、第2要素には ( Key , Value ) の2次元
    配列が設定されていますので、Variant 変数に取り出してから操作して
    ください。
    Key-Value配列データとの入出力には IniBatchGetValue および
    IniBatchUpdValue を利用してください。

(h) IniRewriteBatch ( INI_File , Section , Key_Value ) As Variant
    Section 内の Key/Value を一括で更新(変更・削除・追加)します。
    引数 Key_Value には、IniKeyValueList もしくは、IniAllList から
    得た Key/Value配列を編集したものを指定してください。
    【変更の場合】
        Value 値(第2要素)の内容を書き換えればOKです。
    【削除の場合】
        削除する Key/Value の内容(第1&第2要素)を Null で書き
        換えてください。
    【追加の場合】
        ReDim Preserve で配列サイズ(第1次元)を増やして、末尾に
        書き加えてください。
        VBAでは Preserve で第1次元を増やせませんのでVBA版には
        [ ReDimPre1stDimension ]サブルーチンを用意してあります。
        下記のようにして使ってください。
            i = UBound(vntIniData, 1)
           ' ReDim Preserve vntIniData(1 To (i + 1), 1 To 2)
            Call ReDimPre1stDimension(vntIniData, (i + 1))
    上記のKey-Value配列への操作は IniBatchUpdValue で処理
    できますので、そちらで行なってください。

(i) IniBatchGetValue ( Key_Value , Key ) As Variant
    Key-Value配列データから、Key に対する Value 値を返します。

(j) IniBatchUpdValue ( Key_Value , Key [ , Value ] ) As Variant
    Key-Value配列データに対して、Key に対する更新/追加/削除
    を行います。
    更新/追加 : Key/Value 両方を指定すれば、その内容で更新、
                   もしくは追加を行います(未登録Keyの場合は追加)。
    削  除     : Value を省略して、key のみ指定すると削除します。



海外でも使える内容なので、コメントまで英語で作りました(笑)
-- OOo.Basic 版 --
[ Download : INI_File_Functions.ods Ver 2.3 (2011/ 7/26) ]


-- OOo.Basic --> VBA 移植版 --
[ Download : INI_File_Functions4VBA.xls Ver 2.3 (2011/ 7/27) ]
API 宣言は [ x64 ] 対応になっていますので [ x64 ] で動作可です。


(注) Sub/Function に対して Global/Private ステートメントは無視されて
      機能しませんが、ドキュメントとしての意味付けで指定しています。

      以下に掲載しているコードは OOo.Basic 版です。VBA版のコード
      はダウンロードブックを参照してください。

--- インターフェース用関数 ---
'===================[ IniSecExist ]=======
' [argPath] is the full path of the file (System path or URL).
'
' -- Return Value --
' True : Section is exist
' False : Section is not found, Section is nothing in file, File is not found
' Err(other) : Other Error

Global Function IniSecExist(ByVal argPath As String, _
ByVal argSection As String) As Variant
Dim vntIniData As Variant
Dim blnSection As Boolean
Dim i As Long

If (argSection = "") Then
IniSecExist = CVErr(519) ' #VALUE!
Exit Function
End If

vntIniData = prvIniInput(argPath)
If IsError(vntIniData) Then
Select Case CInt(vntIniData)
Case 53, 519 'File is not Found , Section is nothing in file
IniSecExist = False
Exit Function
Case Else
IniSecExist = vntIniData 'Other error
Exit Function
End Select
End If

blnSection = False
For i = 1 to UBound(vntIniData, 1)
If (UCase(argSection) = UCase(vntIniData(i, 1))) Then
blnSection = True
Exit For
End If
Next i
IniSecExist = blnSection
End Function

'=====================[ IniSecList ]=======
' [argPath] is the full path of the file (System path or URL).
'
' -- Return Value --
' Err(52)    : FileName Error(The extension is not ".ini")
' Err(53)    : File is not found
' Err(other) : Other Error
' #VALUE(519): Section is nothing in file
'
' Section-List return in the case of success.
' Section-List is variant (the inside is 2-dimensional array. index from 1).
' You can get the number of Section-List by UBound(Return Value,1).
' The 1st dimension is Section name, and the 2nd dimension is Key's count.
' --- Array style ---
'   ( Section , Key's count )

Global Function IniSecList(ByVal argPath As String) As Variant
Dim vntIniData As Variant
Dim vntSecArray() As Variant
Dim vntKeyValueData As Variant
Dim i As Long

  vntIniData = prvIniInput(argPath)
  If IsError(vntIniData) Then     'File is not Found , Section is nothing in file
    IniSecList = vntIniData
    Exit Function
  End If
    
  Redim vntSecArray(1 to UBound(vntIniData, 1), 1 to 2)
  For i = 1 to UBound(vntIniData, 1)
    vntSecArray(i, 1) = vntIniData(i, 1)
    vntKeyValueData = vntIniData(i, 2)
    If IsNull(vntKeyValueData) then
      vntSecArray(i, 2) = 0
    Else
      vntSecArray(i, 2) = UBound(vntKeyValueData, 1)
    End If
  Next i
  IniSecList = vntSecArray
End Function

'=====================[ IniKeyValueList ]====
' [argPath] is the full path of the file (System path or URL).
'
' -- Return Value --
' Err(52)    : FileName Error(The extension is not ".ini")
' Err(53)    : File is not found
' Err(other) : Other Error
' #VALUE(519): Section is nothing in file , Section is not found
' Null       : Key-Value is nothing in Section
'
' Key & Value List return in the case of success.
' Key & Value List is variant (the inside is 2-dimensional array. index from 1).
' You can get the number of Key-List by UBound(Return Value,1).
' The 1st dimension is Key, and the 2nd dimension is Value.
' --- Array style ---
'   ( Key , Value )

Global Function IniKeyValueList(ByVal argPath As String, _
                                  ByVal argSection As String) As Variant
Dim vntIniData As Variant
Dim vntKeyValueArray() As Variant
Dim vntKeyValueData As Variant
Dim blnSection As Boolean
Dim i As Long

  If (argSection = "") Then
    IniKeyValueList = CVErr(519)   ' #VALUE!
    Exit Function
  End If
 
  vntIniData = prvIniInput(argPath)
  If IsError(vntIniData) Then     'File is not Found , Section is nothing in file
    IniKeyValueList = vntIniData
    Exit Function
  End If

  blnSection = False
  For i = 1 to UBound(vntIniData, 1)
    If (UCase(argSection) = UCase(vntIniData(i, 1))) Then
      blnSection = True
      vntKeyValueData = vntIniData(i, 2)
      Exit For
    End If
  Next i
  If Not blnSection Then
    IniKeyValueList = CVErr(519)   ' Section is not Found(#VALUE!)
    Exit Function
  ElseIf IsNull(vntKeyValueData) Then
    IniKeyValueList = Null         ' Key-Value is nothing
    Exit Function
  End If
   
  Redim vntKeyValueArray(1 to UBound(vntKeyValueData, 1), 1 to 2)
  For i = 1 to UBound(vntKeyValueData, 1)
    vntKeyValueArray(i, 1) = vntKeyValueData(i, 1)
    vntKeyValueArray(i, 2) = vntKeyValueData(i, 2)
  Next i
  IniKeyValueList = vntKeyValueArray
End Function

'=====================[ IniGetValue ]======
' [argPath] is the full path of the file (System path or URL).
'
' -- Return Value --
' Err(52)    : FileName Error(The extension is not ".ini")
' Err(53)    : File is not found
' Err(other) : Other Error
' #VALUE(519): Section is nothing in file , Section is not found
' Null       : Key not found , Key-Value is nothing in Section
'
' Value of Key return in the case of success.

Global Function IniGetValue(ByVal argPath As String, _
                              ByVal argSection As String, _
                              ByVal argKey As String) As Variant
Dim vntKeyValueList As Variant
Dim blnKey As Boolean
Dim i As Long

  If (argKey = "") Then
    IniGetValue = CVErr(519)   ' #VALUE!
    Exit Function
  End If
 
  vntKeyValueList = IniKeyValueList(argPath, argSection)
  If IsError(vntKeyValueList) Then
    IniGetValue = vntKeyValueList    'File NotFound , Section is nothing , Section is not Found
    Exit Function
  ElseIf IsNull(vntKeyValueList) Then
    IniGetValue = Null               'Key-Value List is Nothing
    Exit Function
  End If

  blnKey = False
  For i = 1 to UBound(vntKeyValueList, 1)
    If (UCase(argKey) = UCase(vntKeyValueList(i, 1))) Then
      blnkey = True
      IniGetValue = vntKeyValueList(i, 2)
      Exit For
    End If
  Next i
  If Not blnKey Then
    IniGetValue = Null         ' Key NotFound
  End If
End Function

'=====================[ IniRewrite ]=======
' Update and Addition of Section/Key.
' When there is not File/Folder, it is made automatically.
'
' You cannot include a bracket character ( [ , ] ) in Section and Key.
' You cannot include an equal character (=) in Key and Value.
' You can include a line feed code ( CR & LF ) in Value.
' (You cannot include CR/LF in Section and Key)
'
' [argPath] is the full path of the file (System path or URL).
' As for Section and Key, the capital letter and the small letter is not distinguished.
' But it is written in as the letter which you appointed first (The capital letter (or,
' small letter) conversion is not done).
'
' -- Return Value --
' Err(52)    : FileName Error(The extension is not ".ini")
' Err(other) : Other Error
' #VALUE(519): Section/Key is the null string("") etc.
' True       : Rewrite is success

Global Function IniRewrite(ByVal argPath As String, _
                             ByVal argSection As String, _
                             ByVal argKey As String, _
                             Byval argValue As String) As Variant
Dim vntIniData As Variant
Dim vntKeyValueData As Variant
Dim vntIniArray(1 to 1, 1 to 2) As Variant
Dim vntKeyValueArray(1 to 1, 1 to 2) As Variant
Dim vntResp As Variant
Dim blnRewriteExecute As Boolean
Dim i As Long
Dim j As Long
Dim k As Long

  'As for argValue, the null string("") is possible, too.
  If (argSection = "") Or (argKey = "") Then
    IniRewrite = CVErr(519)   '#VALUE
    Exit Function
ElseIf (Instr(1, argSection, "[", 0) <> 0) Or _
(Instr(1, argSection, "]", 0) <> 0) Or _
(Instr(1, argSection, chr(13), 0) <> 0) Or _
(Instr(1, argSection, chr(10), 0) <> 0) Or _
(Instr(1, argKey, "[", 0) <> 0) Or _
(Instr(1, argKey, "]", 0) <> 0) Or _
(Instr(1, argKey, "=", 0) <> 0) Or _
(Instr(1, argKey, chr(13), 0) <> 0) Or _
(Instr(1, argKey, chr(10), 0) <> 0) Or _
(Instr(1, argValue, "=", 0) <> 0) Then
    IniRewrite = CVErr(519)   '#VALUE
    Exit Function
  End If
 
  vntIniData = prvIniInput(argPath)
  If IsError(vntIniData) Then
    If (vntIniData = CVErr(53)) Or (vntIniData = CVErr(519)) Then
      'File NotFound(53) , Section is nothing(519)
      vntKeyValueArray(1, 1) = argKey
      vntKeyValueArray(1, 2) = argValue
      vntIniArray(1, 1) = argSection
      vntIniArray(1, 2) = vntKeyValueArray
     
      vntResp = prvIniOutput(argPath, vntIniArray)
      IniRewrite = vntResp  'True(Success) or Error
      Exit Function
    Else
      IniRewrite = vntIniData   'other error
      Exit Function
    End If
  End If

  blnRewriteExecute = False
  For i = 1 to UBound(vntIniData, 1)
    If (UCase(argSection) = UCase(vntIniData(i, 1))) Then
      vntKeyValueData = vntIniData(i, 2)
      If IsNull(vntKeyValueData) Then    'Key is nothing in Section --> Key add
        vntKeyValueArray(1, 1) = argKey
        vntKeyValueArray(1, 2) = argValue
        vntIniData(i, 2) = vntKeyValueArray
        blnRewriteExecute = True
      Else
        For j = 1 to UBound(vntKeyValueData, 1)
          If (UCase(argKey) = UCase(vntKeyValueData(j, 1))) Then
            vntKeyValueData(j, 2) = argValue
            blnRewriteExecute = True
            Exit For
          End If
        Next j
       
        If Not blnRewriteExecute Then   'Key is not found --> Key add
          k = UBound(vntKeyValueData, 1)
          ReDim Preserve vntKeyValueData(1 to k + 1, 1 to 2)
          vntKeyValueData(k + 1, 1) = argKey
          vntKeyValueData(k + 1, 2) = argValue
          blnRewriteExecute = True
        End If
        vntIniData(i, 2) = vntKeyValueData
      End If
      Exit For
    Else
    End If
  Next i
 
  If Not blnRewriteExecute Then   'Section is not found --> Section/Key add
    vntKeyValueArray(1, 1) = argKey
    vntKeyValueArray(1, 2) = argValue
    k = UBound(vntIniData, 1)
    ReDim Preserve vntIniData(1 to k + 1, 1 to 2)
    vntIniData(k + 1, 1) = argSection
    vntIniData(k + 1, 2) = vntKeyValueArray
    blnRewriteExecute = True
  End If

  vntResp = prvIniOutput(argPath, vntIniData)
  IniRewrite = vntResp  'True(Success) or Error
End Function

'=====================[ IniDelete ]========
' [argPath] is the full path of the file (System path or URL).
' When you delete Key & Value, you set argSection and argKey.
' When you delete Section block, you set only argSection (argKey is omitted).
' As for Section and Key, UpperCase and LowerCase is not distinguished.
'
' -- Return Value --
' Err(52)    : FileName Error(The extension is not ".ini")
' Err(53)    : File is not found
' Err(other) : Other Error
' #VALUE(519): Section is nothing in file , Section is not found , Key is not found
' True       : Delete is success

Global Function IniDelete(ByVal argPath As String, _
                            ByVal argSection As String, _
                            Optional ByVal argKey As String) As Variant
Dim vntIniData As Variant
Dim vntKeyValueData As Variant
Dim blnKeyDelete As Boolean
Dim blnDeleteExecute As Boolean
Dim vntResp As Variant
Dim i As Long
Dim j As Long

  If (argSection = "") Then
    IniDelete = CVErr(519)   '#VALUE
    Exit Function
  End If
 
  If IsMissing(argKey) Then
    blnKeyDelete = False
  ElseIf (argKey = "") Then
    blnKeyDelete = False
  Else
    blnKeyDelete = True
  End If
 
  vntIniData = prvIniInput(argPath)
  If IsError(vntIniData) Then     'File NotFound , Section is nothing
    IniDelete = vntIniData
    Exit Function
  End If

  blnDeleteExecute = False
  For i = 1 to UBound(vntIniData, 1)
    If (UCase(argSection) = UCase(vntIniData(i, 1))) Then
      If blnKeyDelete Then
        vntKeyValueData = vntIniData(i, 2)
        For j = 1 to UBound(vntKeyValueData, 1)
          If (UCase(argKey) = UCase(vntKeyValueData(j, 1))) Then
            'Key-Value delete
            vntKeyValueData(j, 1) = Null
            vntKeyValueData(j, 2) = Null
            blnDeleteExecute = True
            Exit For
          End If
        Next j
        vntIniData(i, 2) = vntKeyValueData
      Else
        'Section delete
        vntIniData(i, 1) = Null
        vntIniData(i, 2) = Null
        blnDeleteExecute = True
      End If
      Exit For
    Else
    End If
  Next i

  If blnDeleteExecute Then
    vntResp = prvIniOutput(argPath, vntIniData)
    IniDelete = vntResp  'True(Success) or Error
  Else
    IniDelete = CVErr(519)   '#VALUE
  End If
End Function

'======================[ IniAllList ]=======
' [argPath] is the full path of the file (System path or URL).
'
' -- Return Value --
' Err(52)    : FileName Error(The extension is not ".ini")
' Err(53)    : File is not found
' Err(other) : Other Error
' #VALUE(519): Section is nothing in file
'
' Ini-data return in the case of success.
' Ini-data is variant (the inside is 2-dimensional array. index from 1).
' The 1st dimension is Section, and the 2nd dimension is Key & Value.
' Key & Value is variant (the inside is 2-dimensional array. index from 1).
' The 1st dimension is Key, and the 2nd dimension is Value.
' When key & value is nothing in section, section's 2nd dimension is NULL.
' The comment line (the first character is semicolon) is ignored, and it is not read.
' --- Array style ---
'   ( Section , ( Key , Value ) or NULL )
Global Function IniAllList(ByVal argPath As String) As Variant
  IniAllList = prvIniInput(argPath)
End Function

'======================[ IniRewriteBatch ]====
' Update and Addition of Section/Key (Batch).
' When there is not File/Folder, it is made automatically.
'
' You cannot include a bracket character ( [ , ] ) in Section and Key.
' You cannot include an equal character (=) in Key and Value.
' You can include a line feed code ( CR & LF ) in Value.
' (You cannot include CR/LF in Section and Key)
'
' [argPath] is the full path of the file (System path or URL).
' As for Section and Key, the capital letter and the small letter is not distinguished.
' But it is written in as the letter which you appointed first (The capital letter (or,
' small letter) conversion is not done).
'
' [argKeyValue] is variant (the inside is 2-dimensional array. index from 1).
' The 1st dimension is Key, and the 2nd dimension is Value.
' --- Array style ---
'   ( Key , Value )
' When you delete [Key/Value], you set Null in [Key/Value].

' -- Return Value --
' Err(52)    : FileName Error(The extension is not ".ini")
' Err(other) : Other Error
' #VALUE(519): Section/Key is the null string("") etc.
' True       : Rewrite is success

Global Function IniRewriteBatch(ByVal argPath As String, _
                                ByVal argSection As String, _
                                ByVal argKeyValue As Variant) As Variant
Dim vntIniData As Variant
Dim vntIniArray(1 to 1, 1 to 2) As Variant
Dim vntResp As Variant
Dim blnRewriteExecute As Boolean
Dim i As Long
Dim j As Long
Dim k As Long

  'As for argValue, the null string("") and CR/LF is possible, too.
  If (argSection = "") Then
    IniRewriteBatch = CVErr(519)   '#VALUE
    Exit Function
  ElseIf (Instr(1, argSection, "[", 0) <> 0) Or _
         (Instr(1, argSection, "]", 0) <> 0) Or _
         (Instr(1, argSection, chr(13), 0) <> 0) Or _
         (Instr(1, argSection, chr(10), 0) <> 0) Then
    IniRewriteBatch = CVErr(519)   '#VALUE
    Exit Function
  End If

  If Not IsArray(argKeyValue) Then
    IniRewriteBatch = CVErr(519)   '#VALUE
    Exit Function
  End If

  For i = 1 to UBound(argKeyValue, 1)
    If IsNull(argKeyValue(i, 1)) or IsNull(argKeyValue(i, 2)) Then
      'OK (KeyValue is removed)
      argKeyValue(i, 1) = Null
      argKeyValue(i, 2) = Null
    ElseIf (Instr(1, argKeyValue(i, 1), "[", 0) <> 0) Or _
           (Instr(1, argKeyValue(i, 1), "]", 0) <> 0) Or _
           (Instr(1, argKeyValue(i, 1), "=", 0) <> 0) Or _
           (Instr(1, argKeyValue(i, 1), chr(13), 0) <> 0) Or _
           (Instr(1, argKeyValue(i, 1), chr(10), 0) <> 0) Or _
           (Instr(1, argKeyValue(i, 2), "=", 0) <> 0) Then
      IniRewriteBatch = CVErr(519)   '#VALUE
      Exit Function
    End If
  Next i

  'After the entire section is deleted, the section is output by the batch.
  vntResp = IniDelete(argPath, argSection)

  vntIniData = prvIniInput(argPath)
  If IsError(vntIniData) Then
    If (vntIniData = CVErr(53)) Or _
       (vntIniData = CVErr(519)) Then
      'File NotFound(53) , Section is nothing(519)
      vntIniArray(1, 1) = argSection
      vntIniArray(1, 2) = argKeyValue
      vntResp = prvIniOutput(argPath, vntIniArray)
      IniRewriteBatch = vntResp  'True(Success) or Error
    Else
      IniRewriteBatch = vntIniData   'other error
    End If
  Else
    i = UBound(vntIniData, 1)
    ReDim Preserve vntIniData(1 to (i + 1), 1 to 2)
    vntIniData(i + 1, 1) = argSection
    vntIniData(i + 1, 2) = argKeyValue
    vntResp = prvIniOutput(argPath, vntIniData)
    IniRewriteBatch = vntResp  'True(Success) or Error
  End If
End Function

'=============[ IniBatchGetValue ]===========
' [argKeyValue] is the Variant array that you acquired by IniKeyValueList,
' or the second dimension of the array that you acquired by IniAllList.
'
' -- Return Value --
' Null       : Key not found
' #VALUE(519): Key is invalid.
'
' Value of Key return in the case of success.

Global Function IniBatchGetValue(ByVal argKeyValue As Variant, _
                                 ByVal argKey As String) As Variant
Dim blnKey As Boolean
Dim i As Long

  If (argKey = "") Then
    IniBatchGetValue = CVErr(519)   ' #VALUE!
    Exit Function
  End If
 
  blnKey = False
  For i = 1 to UBound(argKeyValue, 1)
    If IsNull(argKeyValue(i, 1)) then
      'Key/Value is removed.
    Else
      If (UCase(argKey) = UCase(argKeyValue(i, 1))) Then
        blnKey = True
        IniBatchGetValue = argKeyValue(i, 2)
        Exit For
      End If
    End If
  Next i
  If Not blnKey Then
    IniBatchGetValue = Null         ' Key NotFound
  End If
End Function

'=============[ IniBatchUpdValue ]=========
' It is not reflected to INI file unless you carry out [IniRewriteBatch].
'
' [argKeyValue] is the Variant array that you acquired by IniKeyValueList,
' or the second dimension of the array that you acquired by IniAllList.
'
' You cannot include a bracket character ( [ , ] ) in Section and Key.
' You cannot include an equal character (=) in Key and Value.
' You can include a line feed code ( CR & LF ) in Value.
' (You cannot include CR/LF in Section and Key)
'
' As for Key, the capital letter and the small letter is not distinguished.
' But it is written in as the letter which you appointed first (The capital letter (or,
' small letter) conversion is not done).
'
' When you delete Key/Value, you omit [argValue].

' -- Return Value --
' #VALUE(519): Key is the null string("") etc.
' True       : Rewrite is success

Global Function IniBatchUpdValue(ByRef argKeyValue As Variant, _
                                 ByVal argKey As String, _
                                 Optional ByVal argValue As String) As Variant
Dim blnRewriteExecute As Boolean
Dim blnDelete As Boolean
Dim i As Long

  If (argKey = "") Then
    IniBatchUpdValue = CVErr(519)   '#VALUE
    Exit Function
  ElseIf (Instr(1, argKey, "[", 0) <> 0) Or _
         (Instr(1, argKey, "]", 0) <> 0) Or _
         (Instr(1, argKey, "=", 0) <> 0) Or _
         (Instr(1, argKey, chr(13), 0) <> 0) Or _
         (Instr(1, argKey, chr(10), 0) <> 0) Then
    IniBatchUpdValue = CVErr(519)   '#VALUE
    Exit Function
  End If
 
  'As for argValue, the null string("") and CR/LF is possible, too.
  If IsMissing(argValue) Then
    blnDelete = True
  ElseIf (Instr(1, argValue, "=", 0) <> 0) Then
    IniBatchUpdValue = CVErr(519)   '#VALUE
    Exit Function
  Else
    blnDelete = False
  End If

  blnRewriteExecute = False
  For i = 1 to UBound(argKeyValue, 1)
    If IsNull(argKeyValue(i, 1)) Then
      'Key/Value is removed.
    Else
      If (UCase(argKey) = UCase(argKeyValue(i, 1))) Then
        If blnDelete Then
          argKeyValue(i, 1) = Null        'Key delete
          argKeyValue(i, 2) = Null
        Else
          argKeyValue(i, 2) = argValue    'Value update
        End If
        blnRewriteExecute = True
        Exit For
      End If
    End If
  Next i
       
  If Not blnRewriteExecute Then   'Key is not found --> Key add
    If Not blnDelete Then
      i = UBound(argKeyValue, 1)
      ReDim Preserve argKeyValue(1 to i + 1, 1 to 2)
      argKeyValue(i + 1, 1) = argKey
      argKeyValue(i + 1, 2) = argValue
      blnRewriteExecute = True
    End If
  End If

  IniBatchUpdValue = True
End Function





--- 内部処理用関数 ---
( Err2Str については こちら を参照 )
( 置換処理に Split & Join を使っている事については こちら を参照 )
'=====================[ Private : prvIniInput ]===
' [argPath] is the full path of the file (System path or URL).
'
' -- Return Value --
' Err(52)    : FileName Error(The extension is not ".ini")
' Err(53)    : File is not found
' Err(other) : Other Error
' #VALUE(519): Section is nothing in file
'
' Ini-data return in the case of success.
' Ini-data is variant (the inside is 2-dimensional array. index from 1).
' The 1st dimension is Section, and the 2nd dimension is Key & Value.
' Key & Value is variant (the inside is 2-dimensional array. index from 1).
' The 1st dimension is Key, and the 2nd dimension is Value.
' When key & value is nothing in section, section's 2nd dimension is NULL.
' The comment line (the first character is semicolon) is ignored, and it is not read.
' --- Array style ---
'   ( Section , ( Key , Value ) or NULL )

Private Function prvIniInput(ByVal argPath As String) As Variant
Dim strURL As String
Dim intFileNo As Integer
Dim strLine As String

Dim vntSecArray() As Variant
Dim vntDataArray() As Variant
Dim lngSecCount As Long
Dim lngKeyCount As Long
Dim strSecName As String
Dim strKeyName As String
Dim strValue As String
Dim i As Long

  On Error Goto ErrorHandler

  If (LCase(Right(argPath, 4)) <> ".ini") Then
    prvIniInput = CVErr(52)   ' FileName Error
    Exit Function
  ElseIf (LCase(Left(argPath, 8)) = "file:///") Then
    strURL = argPath
  Else
    strURL = ConvertToURL(argPath)
  End If
 
  If (Dir(strURL) = "") Then
    prvIniInput = CVErr(53)   ' File Not Found
    Exit Function
  End If
 
  intFileNo = FreeFile
  Open strURL for Input as #intFileNo
     
  lngSecCount = 0
  Do While not Eof(intFileNo)
    Line Input #intFileNo, strLine
   
    If (Left(strLine, 1) = ";") Then
      'The comment line is ignored.
    ElseIf (Left(strLine, 1) = "[") And (Right(strLine, 1) = "]") Then
      '--- Section Name ---
      If (lngSecCount > 0) Then
        'New Section appears. Set saved Section/Key/Value.
        If (lngSecCount = 1) Then
          ReDim vntSecArray(1 to lngSecCount, 1 to 2)
        Else
          ReDim Preserve vntSecArray(1 to lngSecCount, 1 to 2)
        End If
        vntSecArray(lngSecCount, 1) = strSecName
        If (lngKeyCount > 0) Then
          vntSecArray(lngSecCount, 2) = vntDataArray
        Else
          vntSecArray(lngSecCount, 2) = Null   'Nothing Key-Value
        End If
      End If
      strSecName = Mid(strLine, 2, Len(strLine) - 2)
      lngSecCount = lngSecCount + 1
      lngKeyCount = 0
    Else
'--- Key & Value ---
If (lngSecCount > 0) Then
i = Instr(1, strLine, "=", 0)
If (i > 1) Then
strKeyName = Left(strLine, i - 1)
strValue = Mid(strLine, i + 1)
If (InStr(1, strValue, "<CR>", 0) <> 0) Then
strValue = Join(Split(strValue, "<CR>"), chr(13))
End If
If (InStr(1, strValue, "<LF>", 0) <> 0) Then
strValue = Join(Split(strValue, "<LF>"), chr(10))
End If

lngKeyCount = lngKeyCount + 1
          If (lngKeyCount = 1) Then
            ReDim vntDataArray(1 to lngKeyCount, 1 to 2)
          Else
            ReDim Preserve vntDataArray(1 to lngKeyCount, 1 to 2)
          End If
          vntDataArray(lngKeyCount, 1) = strKeyName
          vntDataArray(lngKeyCount, 2) = strValue
        Else
          'Style error (not "Key=Value")
        End If
      Else
        'The data in the front than the 1st Section is ignored.
      End If
    End If
  Loop
 
  Close #intFileNo
 
  If (lngSecCount = 0) Then
    prvIniInput = CVErr(519)    ' #VALUE! (Section is nothing in file)
  Else
    ' Set saved last Section/Key/Value.
    If (lngSecCount = 1) Then
      ReDim vntSecArray(1 to lngSecCount, 1 to 2)
    Else
      ReDim Preserve vntSecArray(1 to lngSecCount, 1 to 2)
    End If
    vntSecArray(lngSecCount, 1) = strSecName
    If (lngKeyCount > 0) Then
      vntSecArray(lngSecCount, 2) = vntDataArray
    Else
      vntSecArray(lngSecCount, 2) = Null   'Nothing Key-Value
    End If

    prvIniInput = vntSecArray
  End If
  Exit Function
 
ErrorHandler:
  prvIniInput = CVErr(Err)
  If (intFileNo <> 0) Then
    Close #intFileNo
  End If
End Function

'=====================[ Private : prvIniOutput ]===
' [argPath] is the full path of the file (System path or URL).
'
' [argIniData] is variant (the inside is 2-dimensional array. index from 1).
' The 1st dimension is Section, and the 2nd dimension is Key & Value.
' Key & Value is variant (the inside is 2-dimensional array. index from 1).
' The 1st dimension is Key, and the 2nd dimension is Value.
' --- Array style ---
'   ( Section or NULL , ( Key , Value ) or NULL )
'
' When there are not ini-data, please set NULL in argIniData
' When you delete Section, please set NULL in the Section
' When you delete Key & Value, please set NULL in the Key & Value
'
' -- Return Value --
' Err(52)    : FileName Error (The extension is not ".ini")
' Err(other) : Other Error
' #VALUE(519): INI data is not array
' True       : The output of INI is success

Private Function prvIniOutput(ByVal argPath As String, _
                              ByVal argIniData As Variant) As Variant
Dim strURL As String
Dim intFileNo As Integer
Dim vntKeyValueArray As Variant
Dim lngKeyCount As Long
Dim strValue As String
Dim i As Long
Dim j As Long
Dim wk as variant

  On Error Goto ErrorHandler
 
  If (LCase(Right(argPath, 4)) <> ".ini") Then
    prvIniOutput = CVErr(52)   ' FileName Error
    Exit Function
  ElseIf (LCase(Left(argPath, 8)) = "file:///") Then
    strURL = argPath
  Else
    strURL = ConvertToURL(argPath)
  End If
 
  If IsNull(argIniData) Then   ' All data delete
    intFileNo = FreeFile
    Open strURL for Output as #intFileNo
    Close #intFileNo
    prvIniOutput = True
    Exit Function
  ElseIf Not IsArray(argIniData) Then
    prvIniOutput = CVErr(519)   ' #VALUE!
    Exit Function
  End If
 
  intFileNo = FreeFile
  Open strURL for Output as #intFileNo
  'When there is not Folder or File, it is created automatically.
'Note:
' In Excel.VBA, the folder which does not exist is not created.
' Therefore, in Excel.VBA, [Open Output] statement becomes the error
' with the path including the folder which does not exist.
' However, in OOo.Basic, the folder which does not exist is created.


  For i = LBound(argIniData, 1) to UBound(argIniData, 1)
    If IsNull(argIniData(i, 1)) Then
      'Section block delete, do not output
    Else
      Print #intFileNo, "[" & argIniData(i, 1) & "]"
      vntKeyValueArray = argIniData(i, 2)
      If IsNull(vntKeyValueArray) Then
        'Key & Value is nothing in Section
      Else
        For j = LBound(vntKeyValueArray, 1) to UBound(vntKeyValueArray, 1)
          If IsNull(vntKeyValueArray(j, 1)) Then
            'Key & Value delete, do not output
Else
strValue = vntKeyValueArray(j, 2)
If (InStr(1, strValue, chr(13), 0) <> 0) Then
strValue = Join(Split(strValue, chr(13)), "<CR>")
End If
If (InStr(1, strValue, chr(10), 0) <> 0) Then
strValue = Join(Split(strValue, chr(10)), "<LF>")
End If

Print #intFileNo, vntKeyValueArray(j, 1) & "=" & strValue
          End If
        Next j
      End If
    End If
  Next i
   
  Close #intFileNo
 
  prvIniOutput = True  'Output is success
  Exit Function

ErrorHandler:
  prvIniOutput = CVErr(Err)
  If (intFileNo <> 0) Then
    Close #intFileNo
  End If
End Function

'=====================[ Err2Str ]=========
Global Function Err2Str(Optional ByVal argValue As Variant) As Variant
Dim strErrMsg As String
Dim lngErrNo As Long

  'If IsMissing(argValue) Then     'All errors value becomes [IsMissing = True].
  If IsError(argValue) Then
    If (argValue = CVErr(448)) Then    '448: Argument is Missing
      Err2Str = "Argument is Missing"
      Exit Function
    End If
  End If
 
  If IsNull(argValue) Then
    Err2Str = "Null"
  Elseif IsError(argValue) Then
    lngErrNo = CLng(argValue)
    Select Case lngErrNo
      Case 503: Err2Str = "#NUM!"
      Case 504: Err2Str = "#ARGUMENT!"
      Case 519: Err2Str = "#VALUE!"
      Case 524: Err2Str = "#REF!"
      Case 525: Err2Str = "#NAME?"
      Case 532: Err2Str = "#DIV/0!"
      Case Else
        strErrMsg = Error(argValue)
        If (strErrMsg <> "") Then
          Err2Str = "#Err(" & lngErrNo & ") " & strErrMsg   'ErrNo = 2 - 460
        Else
          Err2Str = "#Err(" & lngErrNo & ")"
        End If
    End Select
  Else
    Err2Str = argValue
  End If
End Function

--- 利用例 ---
'====================== IniRewrite/IniDelete TEST
Sub Main1
Dim oSheet As Object
Dim vntINI As Variant
Dim strPass As String
Dim i As Integer
Dim j As Integer
Dim lngRow As Integer
Dim intFileNo As Integer
Dim strLine As string
Dim strResp as string

  strPass = "D:\MyDocuments_D\TEMP\TEST_INI.ini"

  oSheet = ThisComponent.Sheets.getByName("Sheet1")
 
 
vntINI = IniRewrite(strPass, "AddinBox","Comment","改行の" & chr(13) & chr(10) & "テストです" & chr(13) & "どうでしょうか")
  'vntINI = IniDelete(strPass, "kttelpost")

  oSheet.getCellRangeByName("A1:A35").ClearContents(4)
  oSheet.getCellByPosition(0, 0).String = Err2Str(vntINI)

  intFileNo = FreeFile
  on error goto errorhandler
  Open strPass for Input as #intFileNo
  lngRow = 2
  Do While not Eof(intFileNo)
    Line Input #intFileNo, strLine
    lngRow = lngRow + 1
    oSheet.getCellByPosition(0, lngRow - 1).String = strLine
  Loop
errorhandler:
End Sub

'====================== IniSecList TEST
Sub Main2
Dim vntINI As Variant
Dim strPass As String
Dim i As Integer
Dim j As Integer
Dim strResp as string

  strPass = "D:\MyDocuments_D\TEMP\TEST_INI.ini"

  vntINI = IniSecList(strPass)
 
  If IsError(vntINI) or IsNull(vntINI) Then
    strResp = Err2Str(vntINI) & chr(13)
  Else
    strResp = "Success" & chr(13)
    For i = 1 to UBound(vntINI, 1)
      strResp = strResp & chr(13) & """" & vntINI(i,1) & """ , Count=" & vntINI(i,2)
    Next i
  End If
  msgbox strResp
End Sub

'====================== IniKeyValueList TEST
Sub Main3
Dim vntINI As Variant
Dim strPass As String
Dim i As Integer
Dim j As Integer
Dim strResp as string

  strPass = "D:\MyDocuments_D\TEMP\TEST_INI.ini"

  vntINI = IniKeyValueList(strPass, "kttelpost")
 
  If IsError(vntINI) Or IsNull(vntINI) Then
    strResp = Err2Str(vntINI) & chr(13)
  Else
    strResp = "Success" & chr(13)
    For i = 1 to UBound(vntINI, 1)
      strResp = strResp & chr(13) & """" & vntINI(i,1) & _
                  """ , """ & vntINI(i,2) & """"
    Next i
  End If
  msgbox strResp
End Sub


'====================== IniGetValue TEST
Sub Main4
Dim vntINI As Variant
Dim strPass As String
Dim i As Integer
Dim j As Integer
Dim strResp as string

  strPass = "D:\MyDocuments_D\TEMP\TEST_INI.ini"

  vntINI = IniGetValue(strPass, "AddinBox","Name")
 
  If IsError(vntINI) Or IsNull(vntINI) Then
    strResp = Err2Str(vntINI)
  Else
    strResp = "Success" & chr(13) & vntINI
  End If
  msgbox strResp
End Sub

'======================== IniSecExist TEST
Sub Main5
Dim vntINI As Variant
Dim strPass As String
Dim i As Integer
Dim j As Integer
Dim strResp as string

strPass = "D:\MyDocuments_D\TEMP\TEST_INI.ini"

vntINI = IniSecExist(strPass, "AddinBox")

If IsError(vntINI) Then
strResp = Err2Str(vntINI)
ElseIf (vntINI = False) Then
strResp = "Section is not found or File is not found"
Else
strResp = "Section is exist"
End If

msgbox strResp
End Sub


'========================== IniAllList TEST
Sub Main6
Dim vntINI As Variant
Dim vntKeyValue As Variant
Dim strPass As String
Dim i As Integer
Dim j As Integer
Dim strResp as string

strPass = "D:\MyDocuments_D\TEMP\TEST_INI.ini"

vntINI = IniAllList(strPass)

If IsError(vntINI) Then
strResp = Err2Str(vntINI)
Else
strResp = ""
For i = 1 to UBound(vntINI,1)
strResp = strResp & chr(13) & "Sec = " & vntINI(i, 1)
If IsNull(vntINI(i, 2)) Then
strResp = strResp & chr(13) & " Key/Value is nothing."
Else
vntKeyValue = vntINI(i, 2)
For j = 1 to UBound(vntKeyValue, 1)
strResp = strResp & chr(13) & _
" Key=" & vntKeyValue(j, 1) & _
" , Value=" & vntKeyValue(j, 2)
Next j
End If
Next i
End If

msgbox strResp
End Sub


'====================== IniReWriteBatch TEST
Sub Main7
Dim vntINI As Variant
Dim vntKeyValue As Variant
Dim strPass As String
Dim i As Integer
Dim j As Integer
Dim strResp as string

strPass = "D:\MyDocuments_D\TEMP\TEST_INI.ini"

vntINI = IniKeyValueList(strPass, "ktTELPost")

If IsError(vntINI) Or IsNull(vntINI) Then
strResp = Err2Str(vntINI)
MsgBox strResp
Exit Sub
End If

vntKeyValue = vntINI
For i = 1 to UBound(vntKeyValue, 1)
If (UCase(vntKeyValue(i, 1)) = "VER") Then
vntKeyValue(i, 2) = "4.0"
ElseIf (UCase(vntKeyValue(i, 1)) = "VERSION") Then
'-- Remove Key/Value (Set Null) --
vntKeyValue(i, 1) = Null
vntKeyValue(i, 2) = Null
End If
Next i

'-- Add Key/Value --
j = UBound(vntKeyValue, 1)
ReDim Preserve vntKeyValue(1 to (j + 1), 1 to 2)
vntKeyValue(j + 1, 1) = "AddTest"
vntKeyValue(j + 1, 2) = "AddTestValue"

vntINI = IniRewriteBatch(strPass, "ktTELPost", vntKeyValue)

If IsError(vntINI) Then
strResp = Err2Str(vntINI)
Else
strResp = "Success"
End If

msgbox strResp
End Sub

'====== IniReWriteBatch & IniBatchGetValue & IniBatchUpdValue
'
' [ Main7 ] is as follows when you use IniBatchUpdValue.
Sub Main8
Dim vntINI As Variant
Dim vntKeyValue As Variant
Dim strPass As String
Dim i As Integer
Dim j As Integer
Dim strResp as string

strPass = "D:\MyDocuments_D\TEMP\TEST_INI.ini"

vntKeyValue = IniKeyValueList(strPass, "ktTELPost")

If IsError(vntKeyValue) Or IsNull(vntKeyValue) Then
strResp = Err2Str(vntKeyValue)
MsgBox strResp
Exit Sub
End If

MsgBox IniBatchGetValue(vntKeyValue, "VER")

vntINI = IniBatchUpdValue(vntKeyValue, "VER", "4.0") 'Update
vntINI = IniBatchUpdValue(vntKeyValue, "VERSION") 'Delete
vntINI = IniBatchUpdValue(vntKeyValue, "AddTest", "AddTestValue") 'Add

MsgBox IniBatchGetValue(vntKeyValue, "Name")

vntINI = IniRewriteBatch(strPass, "ktTELPost", vntKeyValue)

If IsError(vntINI) Then
strResp = Err2Str(vntINI)
Else
strResp = "Success"
End If

MsgBox strResp
End Sub





お役に立ちましたら拍手して貰えると嬉しいです

addinbox at 14:10コメント(0)マクロ・関数  

コメントする

名前
URL
 
  絵文字
 
 
記事検索
livedoor プロフィール



  • ライブドアブログ