读写INI的例子有么？

Question

ret = GetPrivateProfileString("FunctionSettings", TempFk, "", aString, iSize, "YourIniFile.ini")ret = WritePrivateProfileString(csPKSetName, csTemp, aString, "YourIniFile.ini")

Answer 1

Public 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 LongPublic 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

Answer 2

Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyName As Any, ByVal lsString As Any, ByVal lplFilename As String) As LongDeclare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long'在INI文件中写入一值
Public Function WriteIniSection(Session as String,lpKey as String,lpValue as String,IniFileName as String) As Boolean'------------------------------------------------------------------
'功能：写入一值
'参数：Session:块就是[]内空
'      lpKey:等号左边
'      lpvalue:等号右边
'      IniFileName:INI文件的绝对路径
'返回：成功返回真，否则返回假
'---------------------------------------------------------------------
Dim D As LongD = WritePrivateProfileString(DelID, lpKey, lpValue, IniFileName)If D = 0 Then
   WriteIniSection = False
Else
   WriteIniSection = True
End IfEnd Function'取得INI文件中指定数
Public Function GetFromINI(Section As String, lpKey As String, IniFileName As String) As String
'------------------------------------------------
'功能：从INI文件中取得指定的值，没有则返回默认值
'参数：Sectoin:块的名称，即[]的内空，不含[]
'      lpKey:等号左边那个值
'      IniFileName:INI文件的绝对路径
'返回：等号右边的值(后过的字符CHE(0)已清除)
'-------------------------------------------------
Dim L As Long
Dim Temp As String * 50
Dim lpDefault As String'初努化
lpDefault = vbNullStringTemp = Space(50)
L = GetPrivateProfileString(Section, lpKey, lpDefault, Temp, Len(Temp), IniFileName)If L = 0 Then
   GetFromINI = vbNullString
Else
   Temp = Trim(Temp)
   Temp = Left(Temp, Len(Temp) - 1) '清除最后的Chr(0)
   GetFromINI = Temp
End IfEnd Function

Answer 3

VB读写INI文件的四个函数  
'文件名SourceDB.ini文件
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 WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long 
'以下两个函数,读/写ini文件,固定节点setting,in_key为写入/读取的主键
'仅仅针对是非值
'Y：yes,N：no,E：error
Public Function GetIniTF(ByVal In_Key As String) As Boolean
On Error GoTo GetIniTFErr
GetIniTF = True
Dim GetStr As String
GetStr = VBA.String(128, 0)
GetPrivateProfileString "Setting", In_Key, "", GetStr, 256, App.Path & "\SourceDB.ini"
GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")
If GetStr = "1" Then
GetIniTF = True
GetStr = ""
Else
GoTo GetIniTFErr
End If
Exit Function
GetIniTFErr:
Err.Clear
GetIniTF = False
GetStr = ""
End FunctionPublic Function WriteIniTF(ByVal In_Key As String, ByVal In_Data As Boolean) As Boolean
On Error GoTo WriteIniTFErr
WriteIniTF = True
If In_Data = True Then
WritePrivateProfileString "Setting", In_Key, "1", App.Path & "\SourceDB.ini"
Else
WritePrivateProfileString "Setting", In_Key, "0", App.Path & "\SourceDB.ini"
End If
Exit Function
WriteIniTFErr:
Err.Clear
WriteIniTF = False
End Function
'以下两个函数,读/写ini文件,不固定节点,in_key为写入/读取的主键
'针对字符串值
'空值表示出错
Public Function GetIniStr(ByVal AppName As String, ByVal In_Key As String) As String
On Error GoTo GetIniStrErr
If VBA.Trim(In_Key) = "" Then
GoTo GetIniStrErr
End If
Dim GetStr As String
GetStr = VBA.String(128, 0)
GetPrivateProfileString AppName, In_Key, "", GetStr, 256, App.Path & "\SourceDB.ini"
GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")
If GetStr = "" Then
GoTo GetIniStrErr
Else
GetIniStr = GetStr
GetStr = ""
End If
Exit Function
GetIniStrErr:
Err.Clear
GetIniStr = ""
GetStr = ""
End FunctionPublic Function WriteIniStr(ByVal AppName As String, ByVal In_Key As String, ByVal In_Data As String) As Boolean
On Error GoTo WriteIniStrErr
WriteIniStr = True
If VBA.Trim(In_Data) = "" Or VBA.Trim(In_Key) = "" Or VBA.Trim(AppName) = "" Then
GoTo WriteIniStrErr
Else
WritePrivateProfileString AppName, In_Key, In_Data, App.Path & "\SourceDB.ini"
End If
Exit Function
WriteIniStrErr:
Err.Clear
WriteIniStr = False
End Function
 

Answer 4

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CIniFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'=========================================================================================
'  CIni.Cls
'  功能：  操作 INI 文件
'=========================================================================================
'  Created By: Uguess
'  Published Date: 2002-03-22
'  Email: [email protected]
'=========================================================================================
Option Explicit
' API 声明
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, 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
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 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 LongPrivate Declare Function GetPrivateProfileSectionNames Lib "kernel32" Alias "GetPrivateProfileSectionNamesA" (ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As LongPrivate Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long' 错误处理时常数
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_PARAM = FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTSPrivate m_FileName As String                ' INI 文件名
Private m_SectionKey As String              ' 节名
Private m_ValueKey As String                ' 键名
Private m_Value As String                   ' 键值
Private m_Default As String                 ' 默认值Private m_LastErrorNumber As Long           ' 错误号
Private m_LastErrorDescription As String    ' 错误内容Private Const INI_ERROR = vbObjectError + 5000'=========================================================================================
'初始化类及卸载类
'=========================================================================================
Private Sub Class_Initialize()
    On Error Resume Next
    m_FileName = ""
    m_SectionKey = ""
    m_ValueKey = ""
    m_Default = ""
    m_Value = Empty    ClearError
End Sub 'Class_Initialize()
'=========================================================================================
Private Sub Class_Terminate()
    On Error Resume Next
    m_FileName = ""
    m_SectionKey = ""
    m_ValueKey = ""
    m_Default = ""
    m_Value = Empty    ClearError
End Sub 'Class_Terminate()'=========================================================================================
'设定\得到文件 INI 名
'=========================================================================================
Public Property Get FileName() As String
    On Error Resume Next
    FileName = m_FileName
End Property 'FileName() As String
'=========================================================================================
Public Property Let FileName(ByVal New_FileName As String)
    On Error Resume Next
    m_FileName = New_FileName
End Property 'FileName(ByVal New_FileName As String)
'=========================================================================================
'得到错误内容
'=========================================================================================
Public Property Get ErrorDescription() As String
    On Error Resume Next
    ErrorDescription = m_LastErrorDescription
End Property 'ErrorDescription() As String
'=========================================================================================
'设定\得到默认值
'=========================================================================================
Public Property Get Default() As String
    On Error Resume Next
    Default = m_Default
End Property 'Default() As String
'=========================================================================================
Public Property Let Default(ByVal New_Default As String)
    On Error Resume Next
    m_Default = New_Default
End Property 'Default(ByVal New_Default As String)
'=========================================================================================
'设定\得到节名
'=========================================================================================
Public Property Get SectionKey() As String
    On Error Resume Next
    SectionKey = m_SectionKey
End Property 'SectionKey() As String
'=========================================================================================
Public Property Let SectionKey(ByVal New_SectionKey As String)
    On Error Resume Next
    m_SectionKey = New_SectionKey
End Property 'SectionKey(ByVal New_SectionKey As String)
'=========================================================================================
'设定\得到键名
'=========================================================================================
Public Property Get ValueKey() As String
    On Error Resume Next
    ValueKey = m_ValueKey
End Property 'ValueKey() As String
'=========================================================================================
Public Property Let ValueKey(ByVal New_ValueKey As String)
    On Error Resume Next
    m_ValueKey = New_ValueKey
End Property 'ValueKey(ByVal New_ValueKey As String)'=========================================================================================
'设定\得到键值
'=========================================================================================
Public Property Get Value() As String    ClearError
    If Not HaveFileName Then
        m_Value = m_Default
    Else
        Dim lRet As Long, sRetValue As String * 255
        lRet = GetPrivateProfileString(m_SectionKey, m_ValueKey, m_Default, sRetValue, Len(sRetValue), m_FileName)
        If lRet = 0 Then
            GetTheLastError
            m_Value = m_Default
        Else
            m_Value = StripTerminator(sRetValue)
        End If
    End If    Value = m_ValueEnd Property 'Value() As String
'=========================================================================================
Public Property Let Value(ByVal New_Value As String)    ClearError
    m_Value = New_Value    If HaveFileName Then        Dim lRet As Long
        lRet = WritePrivateProfileString(m_SectionKey, m_ValueKey, m_Value, m_FileName)        If lRet = 0 Then GetTheLastError    End IfEnd Property 'Value(ByVal New_Value As String)

Answer 5

'=========================================================================================
' CreateSection: (仅仅是)写入一个节名
'=========================================================================================
Public Function CreateSection() As Long    ClearError
    If Not HaveFileName Then
        CreateSection = m_LastErrorNumber
        Exit Function
    End If    Dim lRet As Long    lRet = WritePrivateProfileSection(m_SectionKey, "", m_FileName)    If lRet = 0 Then
        GetTheLastError
        CreateSection = m_LastErrorNumber
    Else
        CreateSection = 0
    End IfEnd Function 'CreateSection() As Long'=========================================================================================
' DeleteSection: 删除一个节(包括这个节下的所有键)
'=========================================================================================
Public Function DeleteSection() As Long    ClearError
    If Not HaveFileName Then
        DeleteSection = m_LastErrorNumber
        Exit Function
    End If    Dim lRet As Long    lRet = WritePrivateProfileSection(m_SectionKey, vbNullString, m_FileName)    If lRet = 0 Then
        GetTheLastError
        DeleteSection = m_LastErrorNumber
    Else
        DeleteSection = 0
    End IfEnd Function 'DeleteSection() As Long'=========================================================================================
' DeleteValueKey: 删除一个键
'=========================================================================================
Public Function DeleteValueKey() As Long    ClearError
    If Not HaveFileName Then
        DeleteValueKey = m_LastErrorNumber
        Exit Function
    End If    Dim lRet As Long    lRet = WritePrivateProfileString(m_SectionKey, m_ValueKey, vbNullString, m_FileName)    If lRet = 0 Then
        GetTheLastError
        DeleteValueKey = m_LastErrorNumber
    Else
        DeleteValueKey = 0
    End IfEnd Function 'DeleteValueKey() As Long'=========================================================================================
' GetAllSection: 读取这个 INI 文件中所有的节名
'=========================================================================================
Public Function GetAllSectionNames(ByRef psSectionNames() As String, ByRef plSectionCount As Long) As Long    ClearError
    If Not HaveFileName Then
        GetAllSectionNames = m_LastErrorNumber
        Exit Function
    End If    Dim lRet As Long, sReturned As String * 32767 ' max chars allowed in Win95    Erase psSectionNames()
    plSectionCount = 0    lRet = GetPrivateProfileSectionNames(sReturned, Len(sReturned), m_FileName)    If lRet = 0 Then
        GetTheLastError
        GetAllSectionNames = m_LastErrorNumber
    Else
        Dim iNull As Integer, iStart As Integer, i As Integer        i = 0
        iStart = 1
        
        iNull = InStr(iStart, sReturned, vbNullChar)        Do While iNull
            ReDim Preserve psSectionNames(i)            psSectionNames(i) = Mid(sReturned, iStart, iNull - iStart)
            iStart = iNull + 1
            iNull = InStr(iStart, sReturned, vbNullChar)
            If iNull = iStart Then iNull = 0
            ' lRet contains the numbers of chars copied to the buffer, so if iNull > lRet then we have it all...
            If iNull > lRet Then iNull = 0
            i = i + 1
        Loop
        
        plSectionCount = i
        GetAllSectionNames = 0
    End IfEnd Function 'GetAllSectionNames(psSectionNames() As String) As Long'=========================================================================================
' ReadSection: 一次读取指定的节下的所有内容
'=========================================================================================
Public Function ReadSection(ByRef psKeys() As String, ByRef psValues() As String, ByRef plKeyCount As Long) As Long    ClearError
    If Not HaveFileName Then
        ReadSection = m_LastErrorNumber
        Exit Function
    End If    Erase psKeys()
    Erase psValues()
    plKeyCount = 0    Dim lRet As Long, sReturned As String * 32767 ' max chars allowed in Win95
    lRet = GetPrivateProfileSection(m_SectionKey, sReturned, Len(sReturned), m_FileName)
    If lRet = 0 Then
        GetTheLastError
        ReadSection = m_LastErrorNumber
    Else        Dim iNull As Integer, iStart As Integer, i As Integer, s As String        i = 0
        iStart = 1        iNull = InStr(iStart, sReturned, vbNullChar)
        Do While iNull
            ReDim Preserve psKeys(i)
            ReDim Preserve psValues(i)
            s = Mid(sReturned, iStart, iNull - iStart)
            psKeys(i) = Left(s, InStr(1, s, "=") - 1)
            psValues(i) = Right(s, Len(s) - InStr(1, s, "="))
            iStart = iNull + 1
            iNull = InStr(iStart, sReturned, vbNullChar)
            If iNull = iStart Then iNull = 0
            ' lRet contains the numbers of chars copied to the buffer, so if iNull > lRet then we have it all...
            If iNull > lRet Then iNull = 0
            i = i + 1
        Loop
        plKeyCount = i
        ReadSection = 0
    End IfEnd Function 'ReadSection(psKeys() As String, psValues() As String) As Long

Answer 6

'=========================================================================================
' PRIVATE FUNCTIONS
'=========================================================================================
' 检测是否设置了文件名
'=========================================================================================
Private Function HaveFileName() As Boolean    If m_FileName = "" Then
        m_LastErrorNumber = INI_ERROR + 1
        m_LastErrorDescription = "No filename specified"
        HaveFileName = False
    Else
        HaveFileName = True
    End If
End Function 'HaveFileName() As Boolean'=========================================================================================
' 设置 m_LastErrorDescription
'=========================================================================================
Private Sub GetTheLastError()    m_LastErrorNumber = Err.LastDllError    If m_LastErrorNumber <> 0 Then
        Dim strError As String * 255
        Call FormatMessage(FORMAT_PARAM, 0, m_LastErrorNumber, 0, strError, Len(strError), 0)
        m_LastErrorDescription = StripTerminator(strError)
    Else
        m_LastErrorDescription = "An unknown error has occured"
        m_LastErrorNumber = INI_ERROR + 300
    End IfEnd Sub 'GetTheLastError()'=========================================================================================
'读取字符串
'=========================================================================================
Private Function StripTerminator(sInput As String) As String    Dim ZeroPos As Integer
    'Search the first chr$(0)
    ZeroPos = InStr(1, sInput, vbNullChar)
    If ZeroPos > 0 Then
        StripTerminator = Left$(sInput, ZeroPos - 1)
    Else
        StripTerminator = sInput
    End IfEnd Function 'StripTerminator(sInput As String) As String'=========================================================================================
Private Sub ClearError()    m_LastErrorNumber = 0
    m_LastErrorDescription = ""End Sub 'ClearError()
'========================================================================================= 总说我“回复太长”，没办法，给不了例子了，不过用上面的类，很简单。