读取和写入Windows的INI文件

代码如下：

Sub WriteINIStringVirtual(Section, KeyName, value, FileName)
    WriteINIString Section, KeyName, value, _
                   Server.MapPath(FileName)
End Sub
Function GetINIStringVirtual(Section, KeyName, Default, FileName)
    GetINIStringVirtual = GetINIString(Section, KeyName, Default, _
                          Server.MapPath(FileName))
End Function

'Work with INI files In VBS (ASP/WSH)
'v1.00
'Function GetINIString(Section, KeyName, Default, FileName)
'Sub WriteINIString(Section, KeyName, value, FileName)

Sub WriteINIString(Section, KeyName, value, FileName)
    Dim INIContents, PosSection, PosEndSection

    'Get contents of the INI file As a string
    INIContents = GetFile(FileName)

    'Find section
    PosSection = InStr(1, INIContents, "[" & Section & "]", vbTextCompare)
    If PosSection > 0 Then
        'Section exists. Find end of section
        PosEndSection = InStr(PosSection, INIContents, vbCrLf & "[")
        '?Is this last section?
        If PosEndSection = 0 Then PosEndSection = Len(INIContents) + 1

        'Separate section contents
        Dim OldsContents, NewsContents, Line
        Dim sKeyName, Found
        OldsContents = Mid$(INIContents, PosSection, PosEndSection - PosSection)
        OldsContents = Split(OldsContents, vbCrLf)

        'Temp variable To find a Key
        sKeyName = LCase$(KeyName & "=")

        'Enumerate section lines
        For Each Line In OldsContents
            If LCase$(Left$(Line, Len(sKeyName))) = sKeyName Then
                Line = KeyName & "=" & value
                Found = True
            End If
            NewsContents = NewsContents & Line & vbCrLf
        Next

        If IsEmpty(Found) Then
            'key Not found - add it at the end of section
            NewsContents = NewsContents & KeyName & "=" & value
        Else
            'remove last vbCrLf - the vbCrLf is at PosEndSection
            NewsContents = Left$(NewsContents, Len(NewsContents) - 2)
        End If

        'Combine pre-section, new section And post-section data.
        INIContents = Left$(INIContents, PosSection - 1) & _
                      NewsContents & Mid$(INIContents, PosEndSection)
    Else 'if PosSection>0 Then
        'Section Not found. Add section data at the end of file contents.
        If Right$(INIContents, 2) <> vbCrLf And Len(INIContents) > 0 Then
            INIContents = INIContents & vbCrLf
        End If
        INIContents = INIContents & "[" & Section & "]" & vbCrLf & _
                      KeyName & "=" & value
    End If 'if PosSection>0 Then
    WriteFile FileName, INIContents
End Sub

Function GetINIString(Section, KeyName, Default, FileName)
    Dim INIContents, PosSection, PosEndSection, sContents, value, Found

    'Get contents of the INI file As a string
    INIContents = GetFile(FileName)

    'Find section
    PosSection = InStr(1, INIContents, "[" & Section & "]", vbTextCompare)
    If PosSection > 0 Then
        'Section exists. Find end of section
        PosEndSection = InStr(PosSection, INIContents, vbCrLf & "[")
        '?Is this last section?
        If PosEndSection = 0 Then PosEndSection = Len(INIContents) + 1

        'Separate section contents
        sContents = Mid$(INIContents, PosSection, PosEndSection - PosSection)

        If InStr(1, sContents, vbCrLf & KeyName & "=", vbTextCompare) > 0 Then
            Found = True
            'Separate value of a key.
            value = SeparateField(sContents, vbCrLf & KeyName & "=", vbCrLf)
        End If
    End If
    If IsEmpty(Found) Then value = Default
    GetINIString = value
End Function

'Separates one field between sStart And sEnd
Function SeparateField(ByVal sFrom, ByVal sStart, ByVal sEnd)
    Dim PosB
    PosB = InStr(1, sFrom, sStart, 1)
    If PosB > 0 Then
        PosB = PosB + Len(sStart)
        Dim PosE
        PosE = InStr(PosB, sFrom, sEnd, 1)
        If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf, 1)
        If PosE = 0 Then PosE = Len(sFrom) + 1
        SeparateField = Mid$(sFrom, PosB, PosE - PosB)
    End If
End Function

'File functions
Function GetFile(ByVal FileName)
    Dim FS
    Set FS = CreateObject("Scripting.FileSystemObject")
    'Go To windows folder If full path Not specified.
    If InStr(FileName, ":") = 0 And Left$(FileName, 2) <> "/" Then
        FileName = FS.GetSpecialFolder(0) & "" & FileName
    End If
    On Error Resume Next

    GetFile = FS.OpenTextFile(FileName).ReadAll
End Function
Function WriteFile(ByVal FileName, ByVal Contents)

    Dim FS
    Set FS = CreateObject("Scripting.FileSystemObject")
    'On Error Resume Next

    'Go To windows folder If full path Not specified.
    If InStr(FileName, ":") = 0 And Left$(FileName, 2) <> "/" Then
        FileName = FS.GetSpecialFolder(0) & "" & FileName
    End If

    Dim OutStream
    Set OutStream = FS.OpenTextFile(FileName, 2, True)
    OutStream.Write Contents
End Function

摘自：网络整理

---

★VB部分相关文章推荐：★

---

☆VB6 中善用ByRef 提升速度

☆[vb] Set 语句

☆VB_Format自定义格式

☆用VB如读取内存地址

☆vb FindwindowEx的用法实例

☆进制转化进10进制数

☆收藏:如何获取当前已经打开的IE对象(VB6