ぜんこうさん.com

2009年06月27日

設定(.ini)ファイルの読み書き

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

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

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

inifile.txt


'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
    Dim lngKeyIdx       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)
            lngKeyIdx = (lngIdx - LBound(varSectionItem)) * 2
            lngPosEq = InStr(varSectionItem(lngIdx), "=")
            If lngPosEq = 0 Then
                varKeyAndValue(lngKeyIdx) = varSectionItem(lngIdx)
                varKeyAndValue(lngKeyIdx + 1) = ""
            Else
                varKeyAndValue(lngKeyIdx) = _
                    Left(varSectionItem(lngIdx), lngPosEq - 1)
                varKeyAndValue(lngKeyIdx + 1) = _
                    Mid(varSectionItem(lngIdx), lngPosEq + 1)
            End If
            lngPosComment = InStr(varKeyAndValue(lngKeyIdx), ";")
            If lngPosComment > 0 Then
                varKeyAndValue(lngKeyIdx) = _
                    RTrim(Left(varKeyAndValue(lngKeyIdx), _
                                lngPosComment - 1))
                varKeyAndValue(lngKeyIdx + 1) = ""
            End If
            lngPosComment = InStr(varKeyAndValue(lngKeyIdx + 1), ";")
            If lngPosComment > 0 Then
                varKeyAndValue(lngKeyIdx + 1) = _
                    RTrim(Left(varKeyAndValue(lngKeyIdx + 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

posted by ぜんこう at 14:20| Comment(0) | Visual Basic 6.0(VB6)/Visual Basic for Application(VBA)

四捨五入、切り捨て、切り上げ

VB の Round関数、この関数はなぜか(?)四捨五入ではなく丸めを行うための関数です。ここでは丸めについての説明は省略しますが、例えば Round関数に 1.5 と 2.5 を渡した場合の戻り値を見れば、四捨五入とは違うことはわかると思います。

そこで作成したのが以下の、四捨五入、切り捨て、切り上げを行うプロシージャです。

round.txt


'' 切り上げ・切り捨ての処理区分
Public Enum Enum_ROUND_SHORIKBN
    ROUND_SHORIKBN_SISYAGONYU               ''' 四捨五入
    ROUND_SHORIKBN_KIRIAGE                  ''' 切り上げ
    ROUND_SHORIKBN_KIRISUTE                 ''' 切り捨て
End Enum


' @(f)
'
' 機能      : 四捨五入、切り捨て、切り上げ
'
' 返り値    : 処理後の数値
'
' 引き数    : ARG1 - 数値
'             ARG2 - 小数点以下桁数 ... 既定値 - 0
'             ARG3 - 処理区分(列挙型 Enum_ROUND_SHORIKBN より選択)
'                    ... 既定値 - 四捨五入
'
' 機能説明  : 数値の四捨五入、切り捨て、切り上げを行う。
'
' 備考      :
'
Function pRound(ByVal varNum As Variant, _
                Optional ByVal intDecimalPoint As Integer = 0, _
                Optional ByVal enmUpDown As Enum_ROUND_SHORIKBN = _
                                ROUND_SHORIKBN_SISYAGONYU) As Variant
    Dim varWkNum            As Variant
    Dim intPlusMinus        As Integer
    
    If varNum < 0 Then
        intPlusMinus = -1
    Else
        intPlusMinus = 1
    End If
    
    varWkNum = CDec(varNum)
    Select Case UCase(enmUpDown)
    Case ROUND_SHORIKBN_KIRIAGE     '' 切り上げ
        varWkNum = Fix(varWkNum * (10 ^ intDecimalPoint)) _
                    / (10 ^ intDecimalPoint)
        If varWkNum <> varNum Then
            varWkNum = varWkNum + (10 ^ (intDecimalPoint * -1)) _
                                    * intPlusMinus
        End If
    Case ROUND_SHORIKBN_KIRISUTE    '' 切り捨て
        varWkNum = Fix(varWkNum * (10 ^ intDecimalPoint)) _
                    / (10 ^ intDecimalPoint)
    Case Else                       '' 四捨五入
        varWkNum = varWkNum + (0.5 * 10 ^ (intDecimalPoint * -1)) _
                                * intPlusMinus
        varWkNum = Fix(varWkNum * (10 ^ intDecimalPoint)) _
                    / (10 ^ intDecimalPoint)
    End Select
    
    pRound = varWkNum
End Function

posted by ぜんこう at 14:04| Comment(0) | Visual Basic 6.0(VB6)/Visual Basic for Application(VBA)

<<前の10件 1 2 3 4 5 -

ぜんこうさん.com - tips -

2009年06月27日

設定(.ini)ファイルの読み書き

四捨五入、切り捨て、切り上げ