aodama.gif(0.97KB) 設定ファイル(INI)にキーと値をまとめて書き込む(WritePrivateProfileSection)

 この方法は、ゆー太郎さんに教えていただきました。(^^)
 通常、設定ファイルにキーと値を書き込むときはWin32 API関数の WritePrivateProfileString を使うのですが、 これでは書き込むキーと値が多数ある場合、 何度も WritePrivateProfileString を呼び出すこととなってしまい非常に効率が悪そうです。
 そこで WritePrivateProfileSection というWin32 API関数を使ってみましょう。 これを使えば、一回の呼び出しで一気に全てのキーと値を指定したセクション内に書き込むことができます。

Private Sub cmdWPPS_Click()

 Dim strPair As String        'キーと値のペアを格納する変数
 Dim strProfilePath As String '設定ファイルの場所を格納する変数
 Dim strMeWidth As String     'フォームの横幅
 Dim strMeHeight As String    'フォームの高さ
 Dim strMeLeft As String      'フォームの位置(X座標)
 Dim strMeTop As String       'フォームの位置(Y座標)
 Dim lngRet As Long           'WritePrivateProfileSection の返値を格納する
 
    strProfilePath = txtPath.Text
 
    'フォームの状態を文字列型に変換して各変数に代入する
    strMeWidth = CStr(Me.Width)
    strMeHeight = CStr(Me.Height)
    strMeLeft = CStr(Me.Left)
    strMeTop = CStr(Me.Top)

    'キーと値のペアを作成
    strPair = PPS_KEY_WIDTH & "=" & strMeWidth & vbNullChar & _
              PPS_KEY_HEIGHT & "=" & strMeHeight & vbNullChar & _
              PPS_KEY_LEFT & "=" & strMeLeft & vbNullChar & _
              PPS_KEY_TOP & "=" & strMeTop & vbNullChar & vbNullChar
    
    '設定ファイルに書き込み
    lngRet = WritePrivateProfileSection( _
                PPS_SECNAME, _
                strPair, _
                strProfilePath)
             
    If lngRet Then
        Call MsgBox("書き込みに成功しました。(^^)v", vbOKOnly)
    Else
        Call MsgBox("書き込みに失敗しました。(ToT)", vbExclamation)
    End If

End Sub

サンプル : ダウンロード s_pps.lzh(5.26KB) ※GetPrivateProfileSectionと共通です


aodama.gif(0.97KB) 設定ファイル(INI)からキーと値をまとめて読み込む(GetPrivateProfileSection)

 この方法も、ゆー太郎さんに教えていただきました。
 通常、設定ファイルから値を読み込む場合は、GetPrivateProfileString または GetPrivateProfileInt を使用するのですが、一度にたくさんの値を読み込む場合、 何度もこれらのAPI関数を呼び出すこととなってしまい、効率が悪そうです。
 そこで GetPrivateProfileSection を使用してみましょう。 これは、指定したセクション内のキーと値を一度に読み込むことができます。
 ただ、文字列を分解しなければならないので少々やっかいです。 詳しくは、サンプルをご覧下さい。
 文字列の分割には、拙作の StrSplit 関数を使用しています。

Private Sub cmdGPPS_Click()

 Dim strProfilePath As String 'INIファイルのパス
 Dim strBuffer As String      'GetPrivateProfileSection に設定するバッファ
 Dim lngRet As Long           'GetPrivateProfileSection の返値を格納
 Dim strPair() As String      'キーと値のペアが格納される文字列配列変数
 Dim lngPairNumber As Long    'strPair() の配列要素数を格納
 Dim strKeyValue() As String  'キーと値を分割した結果を格納する文字列配列変数
 Dim i As Long                'ループカウンタ
 
    strProfilePath = txtPath.Text
    If Len(Dir$(strProfilePath)) = 0 Then '設定ファイルの存在チェック
        Call MsgBox("設定ファイルが見つかりません。(ToT)", vbExclamation)
        Exit Sub
    End If
    
    'バッファの領域を PPS_MAXBUFFERSIZE 確保。NULL で埋める。
    strBuffer = String$(PPS_MAXBUFFERSIZE, vbNullChar)
    
    '設定ファイルの読み込み
    lngRet = GetPrivateProfileSection( _
                PPS_SECNAME, _
                strBuffer, _
                PPS_MAXBUFFERSIZE, _
                strProfilePath)
    
    If lngRet Then
        'バッファから終端の NULL の連続を含まない分だけを取り出す
        strBuffer = Left$(strBuffer, InStr(1, strBuffer, vbNullChar & vbNullChar) - 1)
        '各セットを NULL で分割し、文字列配列変数 strPair() に各ペアを格納
        'StrSplit 関数については、modStrSplit(Strsplit.bas)をご覧下さい
        lngPairNumber = StrSplit(strBuffer, vbNullChar, strPair())
        If lngPairNumber Then
            'キーと値のペアの配列 strPair() の項目分ループする
            For i = 0 To (lngPairNumber - 1) Step 1
                'キーと値のペアを "=" で分割。strKeyValue(0) がキー、
                'strKeyValue(1) が値にあたる。戻り値が 2 ならたぶん正常(笑)
                If StrSplit(strPair(i), "=", strKeyValue()) = 2 Then
                    Select Case strKeyValue(0)
                        Case PPS_KEY_WIDTH
                            txtWidth.Text = strKeyValue(1)
                        Case PPS_KEY_HEIGHT
                            txtHeight.Text = strKeyValue(1)
                        Case PPS_KEY_LEFT
                            txtLeft.Text = strKeyValue(1)
                        Case PPS_KEY_TOP
                            txtTop.Text = strKeyValue(1)
                    End Select
                End If
            Next i
            Call MsgBox("読み込みに成功しました。(^^)v", vbOKOnly)
            Erase strPair
            Erase strKeyValue
        Else
            Call MsgBox("読み込みに失敗しました。(ToT)", vbExclamation)
        End If
    Else
        Call MsgBox("読み込みに失敗しました。(ToT)", vbExclamation)
    End If

End Sub

 め、めんどい・・・Perlみたいに連想配列が使えたら死ぬほど楽なんですけどねぇ(^^;

サンプル : ダウンロード s_pps.lzh(5.26KB) ※WritePrivateProfileSectionと共通です

 ちなみに、GetPrivateProfileString の第1引数 lpAppName に NULL を指定すると、 設定ファイル中の全てのセクション名を、NULL 区切りで返します。バッファの終端には NULL 2つです。
 第2引数の lpKeyName に NULL を指定すると、セクション中の全てのキー名を、やはり NULL 区切りで返します。 APIの呼び出し回数は増えてしまいますが、こちらの方が使いやすいかもしれませんね。


VBコーナーにもどる   トップページにもどる