VBA对INI文件的操作

weixin_34259232

于 2008-08-22 10:42:00 发布

阅读量402

点赞数

設定(.ini)ファイルの読み書きを行うプロシージャです。

使用するパソコンごとに異なる情報を保存しておきたい場合とか、データベースに持たせるほどではない程度のデータの定義とか、設定(.ini)ファイルの使い道って意外と多いと思います。

レジストリに情報を保存するほうが VB/VBA からは簡単にできますが、.iniというテキストファイルのほうが扱いやすいので、僕はほとんどレジストリを使用せずに設定(.ini)ファイルを使っています。

'INIファイル用

        Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" _

        (ByVal lpApplicationName As String, ByVal lpKeyName As String, _

        ByVal nDefault As Long, ByVal lpFileName As String) As Long

        Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _

        (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _

        ByVal lpDefault As String, ByVal lpReturnedString As String, _

        ByVal nSize As Long, ByVal lpFileName As String) As Long

        Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" _

        (ByVal lpAppName As String, ByVal lpReturnedString As String, _

        ByVal nSize As Long, ByVal lpFileName As String) As Long

        Private Declare Function GetPrivateProfileSectionNames Lib "kernel32" Alias "GetPrivateProfileSectionNamesA" _

        (ByVal lpReturnedString As String, _

        ByVal nSize As Long, ByVal lpFileName As String) As Long

        Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _

        (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _

        ByVal lpString As Any, ByVal lpFileName As String) As Long

' @(f)

        '

        ' 機能　　　: APIの引数からの文字列取得

        '

        ' 返り値　　: 取得した文字列

        '

        ' 引き数　　: ARG1 - APIの引数の文字列

        '             ARG2 - 終端の文字 ... 既定値 vbNullChar

        '

        ' 機能説明　: APIの引数で使用される文字列(Null文字が終端の固定長)から

        '             VBで使用する文字列(可変長)を取得する

        '

        ' 備考　　　:

        '

        Public Function pGetStringFromAPI(strApiString As String, _

        Optional ByVal strEndChar As String = vbNullChar) As String

        Dim intPos      As Integer


        intPos = InStr(1, strApiString, strEndChar)

        If intPos > 0 Then

        pGetStringFromAPI = Left(strApiString, intPos - 1)

        Else

        pGetStringFromAPI = strApiString

        End If

        End Function

' @(f)

        '

        ' 機能      : INIファイルの数値取得

        '

        ' 返り値    : INIファイルの設定値（未設定時は ARG3 の値を返す）

        '

        ' 引き数    : ARG1 - セクション名

        '             ARG2 - キー名

        '             ARG3 - 初期値

        '             ARG4 - INIファイル名

        '

        ' 機能説明  : INIファイルから該当セクション、キーの数値を取得

        '

        ' 備考      :

        '

        Public Function pGetIniNum(ByVal strSection As String, ByVal strKey As String, ByVal lngInit As Long, _

        ByVal strIniFile As String) As Long

        pGetIniNum = GetPrivateProfileInt(ByVal strSection & String$(128, vbNullChar), _

        ByVal strKey & String$(128, vbNullChar), _

        ByVal lngInit, _

        ByVal strIniFile & String$(128, vbNullChar))

        End Function

' @(f)

        '

        ' 機能      : INIファイルの文字列値取得

        '

        ' 返り値    : INIファイルの設定値（未設定時は ARG3 の値を返す）

        '

        ' 引き数    : ARG1 - セクション名

        '             ARG2 - キー名

        '             ARG3 - 初期値

        '             ARG4 - INIファイル名

        '

        ' 機能説明  : INIファイルから該当セクション、キーの文字列値を取得

        '

        ' 備考      :

        '

        Public Function pGetIniString(ByVal strSection As String, ByVal strKey As String, ByVal strInit As String, _

        ByVal strIniFile As String) As String

        Dim strGetBuffer    As String * 2048


        Call GetPrivateProfileString(ByVal strSection & String$(128, vbNullChar), _

        ByVal strKey & String$(128, vbNullChar), _

        ByVal strInit & String$(128, vbNullChar), _

        strGetBuffer, ByVal LenB(strGetBuffer) / 2, _

        ByVal strIniFile & String$(128, vbNullChar))

        pGetIniString = pGetStringFromAPI(strGetBuffer)

        End Function

' @(f)

        '

        ' 機能      : INIファイルのSection名全取得

        '

        ' 返り値    : INIファイルのSection名の配列

        '

        ' 引き数    : ARG1 - INIファイル名

        '

        ' 機能説明  : INIファイルから該当セクションの全てのキーと値を取得

        '

        ' 備考      : Section内に何もない時は Null を返す

        '

        Public Function pGetIniSectionNames(ByVal strIniFile As String) As Variant

        Dim strGetBuffer    As String * 32767

        Dim strWkString     As String


        Call GetPrivateProfileSectionNames(strGetBuffer, ByVal LenB(strGetBuffer) / 2, _

        ByVal strIniFile & String$(128, vbNullChar))

        strWkString = pGetStringFromAPI(strGetBuffer, String$(2, vbNullChar))

        If strWkString = vbNullChar Or strWkString = "" Then

        pGetIniSectionNames = Null

        Else

        pGetIniSectionNames = Split(strWkString, vbNullChar)

        End If

        End Function

' @(f)

        '

        ' 機能      : INIファイルのSection全取得

        '

        ' 返り値    : INIファイルのSection内容 ... キー、値、キー、値、・・・の配列

        '

        ' 引き数    : ARG1 - セクション名

        '             ARG2 - INIファイル名

        '

        ' 機能説明  : INIファイルから該当セクションの全てのキーと値を取得

        '

        ' 備考      : Section内に何もない時は Null を返す

        '

        Public Function pGetIniSection(ByVal strSection As String, _

        ByVal strIniFile As String) As Variant

        Dim strGetBuffer    As String * 32767

        Dim strWkString     As String

        Dim varSectionItem  As Variant

        Dim varKeyAndValue  As Variant

        Dim lngIdx          As Long

        Dim lngPosEq        As Long

        Dim lngPosComment   As Long


        Call GetPrivateProfileSection(ByVal strSection & String$(128, vbNullChar), _

        strGetBuffer, ByVal LenB(strGetBuffer) / 2, _

        ByVal strIniFile & String$(128, vbNullChar))

        strWkString = pGetStringFromAPI(strGetBuffer, String$(2, vbNullChar))

        If strWkString = vbNullChar Or strWkString = "" Then

        pGetIniSection = Null

        Else

        varSectionItem = Split(strWkString, vbNullChar)

        ReDim varKeyAndValue(0 To (UBound(varSectionItem) - LBound(varSectionItem)) * 2 + 1)

        For lngIdx = LBound(varSectionItem) To UBound(varSectionItem)

        lngPosEq = InStr(varSectionItem(lngIdx), "=")

        If lngPosEq = 0 Then

        varKeyAndValue((lngIdx - LBound(varSectionItem)) * 2) = varSectionItem(lngIdx)

        varKeyAndValue((lngIdx - LBound(varSectionItem)) * 2 + 1) = ""

        Else

        varKeyAndValue((lngIdx - LBound(varSectionItem)) * 2) = Left(varSectionItem(lngIdx), lngPosEq - 1)

        varKeyAndValue((lngIdx - LBound(varSectionItem)) * 2 + 1) = Mid(varSectionItem(lngIdx), lngPosEq + 1)

        End If

        lngPosComment = InStr(varKeyAndValue((lngIdx - LBound(varSectionItem)) * 2), ";")

        If lngPosComment > 0 Then

        varKeyAndValue((lngIdx - LBound(varSectionItem)) * 2) = _

        RTrim(Left(varKeyAndValue((lngIdx - LBound(varSectionItem)) * 2), lngPosComment - 1))

        varKeyAndValue((lngIdx - LBound(varSectionItem)) * 2 + 1) = ""

        End If

        lngPosComment = InStr(varKeyAndValue((lngIdx - LBound(varSectionItem)) * 2 + 1), ";")

        If lngPosComment > 0 Then

        varKeyAndValue((lngIdx - LBound(varSectionItem)) * 2 + 1) = _

        RTrim(Left(varKeyAndValue((lngIdx - LBound(varSectionItem)) * 2 + 1), lngPosComment - 1))

        End If

        Next lngIdx

        pGetIniSection = varKeyAndValue

        End If

        End Function

' @(f)

        '

        ' 機能      : INIファイルへの文字列値格納

        '

        ' 返り値    : True - 成功, False - 失敗

        '

        ' 引き数    : ARG1 - セクション名

        '             ARG2 - キー名

        '             ARG3 - 文字列値

        '             ARG4 - INIファイル名

        '

        ' 機能説明  : INIファイルの該当セクション、キーに文字列値を格納

        '

        ' 備考      :

        '

        Public Function pSetIniString(ByVal strSection As String, ByVal strKey As String, ByVal strValue As String, _

        ByVal strIniFile As String) As Boolean

        pSetIniString = CBool(WritePrivateProfileString(ByVal strSection & String$(128, vbNullChar), _

        ByVal strKey & String$(128, vbNullChar), _

        ByVal strValue & String$(128, vbNullChar), _

        ByVal strIniFile & String$(128, vbNullChar)))

        End Function

' @(f)

        '

        ' 機能      : INIファイルのキー削除

        '

        ' 返り値    : True - 成功, False - 失敗

        '

        ' 引き数    : ARG1 - セクション名

        '             ARG2 - キー名

        '             ARG3 - INIファイル名

        '

        ' 機能説明  : INIファイルの該当セクションの該当キーを削除

        '

        ' 備考      :

        '

        Public Function pDeleteIniKey(ByVal strSection As String, ByVal strKey As String, _

        ByVal strIniFile As String) As Boolean

        pDeleteIniKey = CBool(WritePrivateProfileString(ByVal strSection & String$(128, vbNullChar), _

        ByVal strKey & String$(128, vbNullChar), _

        ByVal vbNullString, _

        ByVal strIniFile & String$(128, vbNullChar)))

        End Function