纯VBS编写INI解析 [复制链接]

VBSBegin

Public Function toString(ByRef obj)

Dim section,key

For Each section In obj

If Mid(section,1,1) = "[" Then

toString = toString & section & vbCrLf

For Each key In obj(section)

If mid(key, 1, 1) = "#" Then

'输出注解

toString = toString & obj(section)(key) & vbCrLf

Else

toString = toString & key & "=" & obj(section)(key) & vbCrLf

End if

Next

Else

'输出注解

toString = toString & obj(section) & vbCrLf

End if

Next

End Function

Public Function parse(ByVal str)

Set parse= CreateObject("Scripting.Dictionary")

Dim index,i,ch

index = 1

i = 1

Do

Call skipWhiteSpace(str, index)

ch = Mid(str,index,1)

If ch = "[" Then

Dim neme

neme = parseSectionName(str, index)

parse.add "[" & Trim(neme) & "]", parseSection(str, index)

ElseIf ch = "#" or ch = ";" or ch = "\"Then

Dim comment

comment = parseSectionComment(str, index)

parse.add "#" & i, comment

i = i + 1

ElseIf index > len(str) Then

Exit Function

Else

Set parse = Nothing

Exit Function

End If

Loop

End Function

Private Function parseSectionComment(ByVal str,ByRef index)

Dim s

s = index

Do While index<=len(str)

If isLineEnd(mid(str,index,1)) Then

parseSectionComment = mid(str,s,index - s)

Exit Do

End If

index = index + 1

Loop

End Function

Private Function parseSectionName(ByVal str,ByRef index)

Dim s

index = index + 1

s = index

Do While index<=len(str)

If mid(str, index, 1) = "]" Then

index = index + 1

parseSectionName = mid(str,s,index - s - 1)

Exit Do

End If

index = index + 1

Loop

End Function

Private Function parseSection(ByVal str, ByRef index)

Set parseSection = CreateObject("Scripting.Dictionary")

Dim key,value,ch,i

i = 1

Do

Call skipWhiteSpace(str, index)

ch = mid(str, index, 1)

If index > len(str) or ch = "["Then

Exit Function

ElseIf ch = "#" or ch = ";" or ch = "\" Then

Dim comment

comment = parseSectionComment(str, index)

parseSection.add "#" & i, comment

i = i + 1

Else

key = parseKey(str, index)

value = parseValue(str, index)

parseSection.add key, value

End If

Loop

End Function

Private Function parseKey(ByVal str, ByRef index)

Dim s

s = index

Do While index<=len(str)

If mid(str, index, 1) = "=" Then

index = index + 1

parseKey = mid(str, s, index - s - 1)

Exit Function

End If

index = index + 1

Loop

parseKey = mid(str, s, index - s)

End Function

Private Function parseValue(ByVal str, ByRef index)

Do While index <= len(str)

If Not isSpace(mid(str, index, 1)) Then

Exit Do

End if

index = index + 1

Loop

If index > len(str) Then

parseValue = ""

Exit Function

ElseIf isLineEnd(mid(str, index, 1)) Then

parseValue = ""

Exit Function

ElseIf isDigit(mid(str, index, 1)) or mid(str, index, 1) = "-" Then

parseValue = parseNumber(str, index)

Else

parseValue = parseSring(str, index)

End if

End Function

Private Function parseSring(ByVal str, index)

Dim s

s = index

Do While index<=len(str)

If isLineEnd(mid(str, index, 1)) Then

Exit Do

End If

index = index + 1

Loop

parseSring = mid(str, s,index-s)

End Function

Private Function isLineEnd(ByVal ch)

If ch = vbCr Then

isLineEnd=True

ElseIf ch = vbLf Then

isLineEnd = True

ElseIf ch = vbCrLf Then

isLineEnd = True

Else

isLineEnd=False

End If

end Function

Private Function isSpace(ByVal ch)

If ch = " " Then

isSpace=True

ElseIf ch = vbTab Then

isSpace=True

Else

isSpace=False

End If

end Function

Private Sub skipWhiteSpace(ByVal str, ByRef index)

'跳过空白符

Dim ch

Do While index <= len(str)

ch = Mid(str, index, 1)

If ch = " " Then

ElseIf ch = vbTab Then

ElseIf ch = vbCr Then

ElseIf ch = vbLf Then

Else

Exit Sub

End If

index = index + 1

Loop

End Sub

Private Function parseNumber(ByVal str, ByRef index)

'解析数值

Dim start, ch

start = index

If Mid(str, index, 1) = "-" Then

index = index + 1

End If

If not isDigit(Mid(str, index, 1)) Then

'printErrMsgPos "存在非法数值", start

End If

If Mid(str, index, 1) = "0" Then

index = index + 1

Else

Do

index = index + 1

Loop While isDigit(Mid(str, index, 1))

End If

If Mid(str, index, 1) = "." Then

index = index + 1

If not isDigit(Mid(str, index, 1)) Then

'printErrMsgPos "存在非法数值", start

End If

Do

index = index + 1

Loop While isDigit(Mid(str, index, 1))

End If

ch = Mid(str, index, 1)

If ch = "e" or ch = "E" Then

index = index + 1

ch = Mid(str, index, 1)

If ch = "-" or ch = "+" Then

index = index + 1

End If

If not isDigit(Mid(str, index, 1)) Then

'printErrMsgPos "存在非法数值", start

End If

Do

index = index + 1

Loop While isDigit(Mid(str, index, 1))

End If

parseNumber = Eval(Mid(str, start, index - start))

End Function

Private Function isDigit(ByVal ch)

'判断字符是否为数字

Dim c

c = ascw(ch)

isDigit = c >= 48 and c <= 57

End Function

VBSEnd

Function readINI(ByVal section, ByVal key, ByVal path)

Dim fso, f

Set fso = CreateObject("Scripting.FileSystemObject")

If Not fso.FileExists(path) Then

f.Close

Exit Function

End If

Set f = fso.OpenTextFile(path, 1, True)

Dim d

Set d = parse(f.ReadAll)

f.Close

Dim s

s = "[" & Trim(section) & "]"

If d.Exists(s) Then

If d(s).Exists(key) Then

readINI=d(s)(key)

End If

End If

End Function

Function writeINI(ByVal section, ByVal key,ByVal value, ByVal path)

Dim fso, f

Set fso = CreateObject("Scripting.FileSystemObject")

Dim d

Set f = fso.OpenTextFile(path, 1, True)

If fso.FileExists(path) Then

Set d = parse(f.ReadAll)

f.Close

Else

Set d = CreateObject("Scripting.Dictionary")

End If

Dim s

s = "[" & Trim(section) & "]"

If Not d.Exists(s) Then

d.add s,CreateObject("Scripting.Dictionary")

End If

d(s)(key) = value

Set f = fso.OpenTextFile(path, 2, True)

f.Write toString(d)

f.Close

End Function

Call writeINI("BeginnerHelpShow", "HelpShowState", 2,"C:\a.ini")

TracePrint ReadINI("BeginnerHelpShow", "HelpShowState", "C:\a.ini")