3
' Copyright(C) 2011-2014, Michał Głowienka aka eloaders <eloaders@linux.pl>
5
' This program is free software; you can redistribute it and/or modify
6
' it under the terms of the GNU General Public License as published by
7
' the Free Software Foundation; either version 3 of the License, or
8
' (at your option) any later version.
10
' This program is distributed in the hope that it will be useful,
11
' but WITHOUT ANY WARRANTY; without even the implied warranty of
12
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
' GNU General Public License for more details.
15
' You should have received a copy of the GNU General Public License
16
' along with this program. If not, see <http://www.gnu.org/licenses/>.
18
Property Read {Null} As Variant
20
Private $vNull As Variant
21
Private $sStr As String
22
Private $iPos As Integer
23
Private $bUseNull As Boolean
25
Private Sub GetChar() As String
29
If $iPos > Len($sStr) Then Return
30
sCar = Mid$($sStr, $iPos, 1)
37
Private Sub ReadChar() As String
43
If Not sCar Then Return
44
If sCar > " " Then Return sCar
50
Private Sub ReadToken() As String
56
If Not IsLetter(sCar) Then Return sCar
61
If Not sCar Then Break
62
If Not IsLetter(sCar) Then
73
Private Sub ReadString() As String
81
If Not sCar Then Error.Raise("Non terminated string")
82
If sCar = Chr$(34) Then Return sString
85
If Not sCar Then Error.Raise("Non terminated string")
86
iPos = InStr("bfrtn", sCar)
88
sCar = Mid$("\b\f\r\t\n", iPos, 1)
89
Else If sCar = "u" Then
90
Try sCar = String.Chr$(Val("&H" & Mid$($sStr, $iPos, 4)))
91
If Not Error Then $iPos += 4
101
Private Sub ReadObject() As Collection
104
Dim cObject As Collection
108
cObject = New JSONCollection
110
cObject = New Collection
115
If sCar = "}" Then Return cObject
116
If sCar <> Chr$(34) Then Error.Raise("String expected")
119
If sCar <> ":" Then Error.Raise("Colon expected")
120
cObject[sKey] = ReadValue()
122
If sCar = "}" Then Return cObject
123
If sCar <> "," Then Error.Raise("Comma expected")
128
Private Sub ReadArray() As Variant[]
131
Dim aArray As New Variant[]
135
If sCar = "]" Then Return aArray
137
aArray.Add(ReadValue())
139
If sCar = "]" Then Return aArray
140
If sCar <> "," Then Error.Raise("Comma expected")
145
Private Sub ReadNumber(sNumber As String) As Variant
148
Dim vNumber As Variant
149
Dim bFloat As Boolean
153
If Not sCar Then Break
154
If InStr(".eE", sCar) Then
156
Else If InStr("-+0123456789", sCar) = 0 Then
164
Try vNumber = CFloat(sNumber)
165
If Not Error Then Return vNumber
167
Try vNumber = CInt(sNumber)
168
If Not Error Then Return vNumber
169
Try vNumber = CLong(sNumber)
170
If Not Error Then Return vNumber
173
Error.Raise("Incorrect number")
177
Private Sub ReadValue() As Variant
185
Else If sCar = "[" Then
187
Else If sCar = Chr$(34) Then
189
Else If sCar = "-" Or If IsDigit(sCar) Then
190
Return ReadNumber(sCar)
191
Else If sCar = "null" Then
193
Else If sCar = "true" Then
195
Else If sCar = "false" Then
197
Else If Not sCar Then
200
Error.Raise("Incorrect token: " & Quote(sCar))
205
Private Sub WriteValue(vVal As Variant)
210
Dim cCol As Collection
212
Select Case TypeOf(vVal)
224
Case gb.Byte, gb.Short, gb.Integer, gb.Long, gb.Float
228
$sStr &= Chr$(34) & CStr(vVal) & Chr$(34)
233
iPos = InStr(sStr, "\\", iPos + 1)
234
If iPos = 0 Then Break
235
If Mid$(sStr, iPos + 1, 1) = "x" Then
236
Mid$(sStr, iPos, 4) = "\\u00" & Mid$(sStr, iPos + 2, 2)
244
If vVal Is Array Then
247
For iPos = 0 To vVal.Max
248
If iPos Then $sStr &= ", "
249
WriteValue(vVal[iPos])
252
Else If vVal Is Collection Then
255
For Each vVal In cCol
256
If iPos Then $sStr &= ", "
270
Public Sub Decode(JSONString As String, Optional UseNull As Boolean) As Variant
276
If UseNull And If IsNull($vNull) Then $vNull = VarPtr($vNull)
284
Public Sub Encode(Value As Variant) As String
292
Private Function Null_Read() As Variant
added
removed
src/i-nex/.src/JSON.module
