【vb.net】json文件的读写

这里提供的方式只是个人的摸索，肯定不是正常的方法。由于vb实在缺例子，学习正经的json读写方法有点花时间，而且我也不是专业写程序的，所以秉着“速度要紧，能用就好”宗旨，决定自写json的解析。

======正文=====

对于json文件的解析，我的思路是：

1.字符串去格式化，将无意义的字符去掉（空格、换行等）

2.将字符串对象化，生成为三个数组（因为对类模块使用不熟练，所以用了一个非常土的方法），第一个是Key的名字集合，第二个是数值的集合，第三个是数值类型的集合。

3.能将对象化后的数据，进行修改/添加/删除的操作。

4.将json对象转换为json字符串。

5.将json字符串格式化，转换为便于阅读的格式。

=====数组函数============ Class Arr
Function Cut(ArrayObject, Index) '将指定位置的元素cong
Dim ArrCount, OArr(), i, ci
ArrCount = UBound(ArrayObject)
If ArrCount = 0 Then
Cut = Reset()
Exit Function
End If
ReDim OArr(ArrCount - 1)
ci = 0
For i = 0 To ArrCount
If Index <> i Then
OArr(ci) = ArrayObject(i)
ci = ci + 1
End If
Next
Cut = OArr
End Function
Function Reset() '将变量初始化为数组
Dim arr(0)
arr(0) = "***Arr*initial***"
Reset = arr
End Function
Function Add(ArrayObject, item)
Dim ArrCount, OArr(), i
If TypeName(ArrayObject(0)) = "String" Then
If ArrayObject(0) = "***Arr*initial***" Then
ReDim OArr(0)
OArr(0) = item
Else
ArrCount = UBound(ArrayObject)
ReDim OArr(ArrCount + 1)
For i = 0 To ArrCount
OArr(i) = ArrayObject(i)
Next
OArr(ArrCount + 1) = item
End If
Else
ArrCount = UBound(ArrayObject)
ReDim OArr(ArrCount + 1)
For i = 0 To ArrCount
OArr(i) = ArrayObject(i)
Next
OArr(ArrCount + 1) = item
End If
Add = OArr
End Function
Function IsExistInArray(ArrayObject, MatchingValue) '判断数组中是否存在某一元素
Dim i
Dim RB As Boolean
RB = False
For i = 0 To UBound(ArrayObject)
If MatchingValue = ArrayObject(i) Then
RB = True
Exit For
End If
Next
IsExistInArray = RB
End Function
Function GetIndex(ArrayObject, MatchingValue) '返回元素所在的位置
Dim i
Dim RB, IndexArr
IndexArr = Reset()
For i = 0 To UBound(ArrayObject)
If MatchingValue = ArrayObject(i) Then
IndexArr = i
Exit For
End If
Next
GetIndex = IndexArr
End Function
Function GetIndexs(ArrayObject, MatchingValue) '返回元素所在的位置（数组）
Dim i
Dim RB, IndexArr
IndexArr = Reset()
For i = 0 To UBound(ArrayObject)
If MatchingValue = ArrayObject(i) Then
IndexArr = Add(IndexArr, i)
End If
Next
GetIndexs = IndexArr
End Function
End Class
======读写文件函数====

Class text
Sub swrite(filename, content)
Dim stream
stream = CreateObject("Adodb.Stream")

stream.Open
stream.Type = 2 '"adTypeText"
stream.Charset = "utf-8"
stream.WriteText(content)

'移除前三个字节（0xEF,0xBB,0xBF）
stream.Position = 3

Dim newStream
newStream = CreateObject("Adodb.Stream")
newStream.Type = 1 '"adTypeBinary"
newStream.Mode = 3 '"adModeReadWrite"
newStream.Open

stream.CopyTo(newStream)
stream.Flush
stream.Close

newStream.SaveToFile(filename, 2) '"adSaveCreateOverWrite"
newStream.Flush
newStream.Close
End Sub
Function sread(Path)
Dim stm
stm = CreateObject("Adodb.Stream")
stm.Type = 2
stm.Mode = 3
stm.Charset = "UTF-8"
stm.Open
stm.LoadFromFile(Path)
sread = stm.ReadText()
stm.close()
'stm = Nothing
End Function

Function Read(filePath As String)

Dim txt As StreamReader
Dim st As String, isComment As Boolean = False
Dim isMutiLineComment As Boolean = False
Dim isInString As Boolean = False
b7da
txt = New StreamReader(filePath)
st = txt.ReadToEnd
Read = st
txt.Close()
End Function
Sub save(path As String, str As String)
Using logObject As System.IO.StreamWriter = New System.IO.StreamWriter(path)
logObject.Write(str)
logObject.Close()
End Using
End Sub
End Class
======json========
Class json
Dim arr As New Arr
Function jsStrToRead(jsStr) '将json字符串转换为便于阅读的格式
Dim thisChar As Char
Dim NodeCount As Int64 = 0
Dim isInString As Boolean = False
Dim ns = ""
For Each thisChar In jsStr
Select Case thisChar
Case "{"
ns = ns & thisChar & Chr(13)
NodeCount = NodeCount + 1
ns = ns & writeBlank(NodeCount)
Case "}"
NodeCount = NodeCount - 1
ns = ns & Chr(13) & writeBlank(NodeCount) & thisChar
Case "["
NodeCount = NodeCount + 1
ns = ns & thisChar & Chr(13) & writeBlank(NodeCount)
Case "]"
NodeCount = NodeCount - 1
ns = ns & Chr(13) & writeBlank(NodeCount) & thisChar
Case ","
If isInString = False Then
ns = ns & thisChar & Chr(13) & writeBlank(NodeCount)
Else
ns = ns & thisChar
End If
Case ":"
If isInString = False Then
ns = ns & " " & thisChar & " "
Else
ns = ns & thisChar
End If
Case """"
isInString = Not isInString
ns = ns & thisChar
Case Else
ns = ns & thisChar
End Select
'Stop
Next
Return ns
End Function

Function writeBlank(nodecount) '根据层数，返回用于首行缩进的字符串
Dim s = ""
For i = 1 To nodecount
s = s & Chr(9)
Next
'Stop
Return s
End Function
Function jsObjectToStr(JsObject) '将json对象转换为json字符串
Dim ItemKey, ItemVal, ItemType, ValSt, NameSt
Dim jst As String = "{"
For i = 0 To UBound(JsObject(0))
ItemKey = JsObject(0)(i)
ItemVal = JsObject(1)(i)
ItemType = JsObject(2)(i)
ValSt = ""
Select Case ItemType
Case "string"
ValSt = """" & ItemVal & """"
Case "value"
ValSt = ItemVal
Case "array_Str"
ValSt = "["
For j = 0 To UBound(ItemVal)
ValSt = ValSt & """" & ItemVal(j) & """" & ","
Next
ValSt = Left(ValSt, Len(ValSt) - 1) & "]"
Case "array_Val"
ValSt = "["
For j = 0 To UBound(ItemVal)
ValSt = ValSt & ItemVal(j) & ","
Next
ValSt = Left(ValSt, Len(ValSt) - 1) & "]"
Case "object"
ValSt = ItemVal
End Select
NameSt = """" & ItemKey & """"
jst = jst & NameSt & ":" & ValSt & ","
Next
jst = Left(jst, Len(jst) - 1) & "}"
Return jst
End Function
Function setValue(jsObject, KeyName, NewValue, NewType) '输入Key的名称，并修改对于的数值
Dim jsName, njsObject
njsObject = jsObject
For i = 0 To UBound(njsObject(0))
jsName = njsObject(0)(i)
If jsName = KeyName Then
njsObject(1)(i) = NewValue
If NewType <> "" Then
njsObject(2)(i) = NewType
End If
Exit For
End If
Next
Return njsObject
End Function
Function Formate(st) '去掉json字符串中的空格/换行符等无意义的字符
Dim thisChar As Char
Dim isInString As Boolean = False
Dim nst = ""
For Each thisChar In st
Select Case thisChar
Case " "
If isInString = True Then
nst = nst & thisChar
End If
Case Chr(13)
Case Chr(10)
Case Chr(9)
Case """"
isInString = Not isInString
nst = nst & thisChar
Case Else
nst = nst & thisChar
End Select
Next
Return nst
End Function
Function GetValueType(jsValue) '获取一个json字符中，值的类型
Dim firstChar, SecondChar, tt
firstChar = Mid(jsValue, 1, 1)
SecondChar = Mid(jsValue, 2, 1)
If firstChar = """" Then
tt = "string"
ElseIf IsNumeric(jsValue) = True
tt = "value"
ElseIf firstChar = "[" Then
If SecondChar = """" Then
tt = "array_Str"
Else
tt = "array_Val"
End If

ElseIf firstChar = "{" Then
tt = "object"
Else
tt = "error"
End If
GetValueType = tt
End Function
Function GetJsKeyValue(jsonObject)
Dim thisChar
Dim mmp = 0
Dim isInstring As Boolean = False
For i = 1 To Len(jsonObject)
thisChar = Mid(jsonObject, i, 1)
Select Case thisChar
Case """"
isInstring = Not isInstring
Case ":"
If isInstring = False Then
mmp = i
Exit For
End If
End Select
Next
Dim keyValue
keyValue = Mid(jsonObject, mmp + 1, Len(jsonObject) - mmp)
Return keyValue
End Function
Function GetJsKeyName(jsonObject) '获取key的名字
Dim thisChar
Dim mmp = 0
Dim isInstring As Boolean = False
For i = 1 To Len(jsonObject)
thisChar = Mid(jsonObject, i, 1)
Select Case thisChar
Case """"
isInstring = Not isInstring
Case ":"
If isInstring = False Then
MMP = i
Exit For
End If
End Select
Next
Dim keyname
keyname = Mid(jsonObject, 2, mmp - 3)
Return keyname
End Function
Function GetJsValueByName(jsObject, KeyName)
Dim v
v = ""
For i = 0 To UBound(jsObject(0))
If KeyName = jsObject(0)(i) Then
v = jsObject(1)(i)
Exit For
End If
Next
Return v
End Function
Function GetJsItemObjectArr(jsonValue)
Dim njsVal = Formate(jsonValue)
Dim thisChar As Char
Dim NodeCount As Int64 = 0
Dim isInString As Boolean = False
Dim SplitPositon, jsObject
SplitPositon = arr.Reset()
jsObject = arr.Reset()
SplitPositon = arr.Add(SplitPositon, 1)
For i = 1 To Len(njsVal)
thisChar = Mid(njsVal, i, 1)
Select Case thisChar
Case "{"
NodeCount = NodeCount + 1

Case "}"
NodeCount = NodeCount - 1
If NodeCount = 0 Then
SplitPositon = arr.Add(SplitPositon, i)
End If
Case "["
NodeCount = NodeCount + 1
Case "]"
NodeCount = NodeCount - 1
Case """"
isInString = Not isInString
Case ","
If isInString = False And NodeCount = 1 Then
SplitPositon = arr.Add(SplitPositon, i)
End If
End Select
Next
Dim SP, EP, Stlenth

For i = 0 To UBound(SplitPositon) - 1
SP = SplitPositon(i) + 1
EP = SplitPositon(i + 1)
Stlenth = EP - SP
jsObject = arr.Add(jsObject, Mid(njsVal, SP, Stlenth))
Next
'Stop
Return jsObject
End Function

Function jsonReader(st)
Dim isInString As Boolean = False
Dim jsobject = GetJsItemObjectArr(st)
Dim KeyNameArr, KeyName, KeyValue, ValueType, KeyValueArr, ValueTypeArr
Dim jsonReaderObj
KeyNameArr = arr.Reset()
KeyValueArr = arr.Reset()
ValueTypeArr = arr.Reset()
jsonReaderObj = arr.Reset()
For i = 0 To UBound(jsobject)
KeyName = GetJsKeyName(jsobject(i))
KeyValue = GetJsKeyValue(jsobject(i))
ValueType = GetValueType(KeyValue)
Select Case ValueType
Case "string"
KeyValue = Mid(KeyValue, 2, Len(KeyValue) - 2)
Case "value"
KeyValue = Val(KeyValue)
Case "array_Str"
KeyValue = Mid(KeyValue, 3, Len(KeyValue) - 4)
KeyValue = Split(KeyValue, """,""")
Case "array_Val"
KeyValue = Mid(KeyValue, 2, Len(KeyValue) - 2)
KeyValue = Split(KeyValue, ",")
For j = 0 To UBound(KeyValue)
KeyValue(j) = Val(KeyValue(j))
Next
Case "object"
KeyValue = KeyValue
End Select
KeyNameArr = arr.Add(KeyNameArr, KeyName)
KeyValueArr = arr.Add(KeyValueArr, KeyValue)
ValueTypeArr = arr.Add(ValueTypeArr, ValueType)
Next
jsonReaderObj = arr.Add(jsonReaderObj, KeyNameArr)
jsonReaderObj = arr.Add(jsonReaderObj, KeyValueArr)
jsonReaderObj = arr.Add(jsonReaderObj, ValueTypeArr)

Return jsonReaderObj
End Function

End Class========调用例子========
dim t as new text, js as new json

dim FilePath as string = "json的文件路径\json.dat"

dim jsonObject  = js.jsonReader(FilePath)

dim JsKeyArr = jsonObject(0)    'json的key的数组

dim JsValueArr = jsonObject(1)  'json的值的数组

dim JsTypeArr = jsonObject(2)  'json的各个值的类型数组

dim KVal = js.GetJsValueByName(jsonObject, "Key的名称")

jsonObject = js.setValue(jsonObject, "Key的名称" , 新的值 , 值的类型)