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

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

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