vbs读写ini配置文件

感谢程序员先驱们的无私奉献，作为一名程序员我也希望能为江海填一滴水，哪怕为看到此文的同行节省一点时间，也是我无上的荣幸。

config.ini

[Age]
val=39
[Name]
val=andy

 test.vbs

Dim cp,configpath
Set objShell = CreateObject("Wscript.Shell")
configpath = objShell.CurrentDirectory                             '得到当前脚本的目录位置
configpath = configpath & "\config.ini"

WriteINIStringVirtual "Age", "val", "39", configpath            '修改配置项
cp = GetINIStringVirtual("Age", "val", "", configpath)         '读取配置项
MsgBox cp

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



 ' Work with INI files In VBS (ASP/WSH)
' v1.00
' 2003 Antonin Foller, PSTRUH Software, http://www.pstruh.cz
' 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