Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- '/// JSON Parser for VK API
- '/// by EverybodyLies
- '/// mailto:sungik108@yandex.ru
- Const c_separator As String = "." 'tag.tag.tag
- Const c_numValue As String = "!" 'value = "!12345"
- Const c_strValue As String = "~" 'value = "~string"
- Const c_valueOnly As String = "^" '[value,{... // tag(^)=value
- Const c_container1_open As String = "{"
- Const c_container1_close As String = "}"
- Const c_container2_open As String = "["
- Const c_container2_close As String = "]"
- Private i_container1_opened As Long, i_container2_opened As Long
- '\\\
- '0) {...} // [...] // [*,...]
- '1) "tag":numeric_value,...
- '2) "tag":"value",...
- '3) "tag":{"tag1":value,"tag2":"value",...}
- '4) "tag":[{param1},{param2},...]
- '5) "tag":[param,{param1},{param2},...]
- '///
- Function Parse(ByRef post As String, ByRef tag As Collection, ByRef value As Collection, Optional ByVal ParseOneBlock As Boolean = False) As Long
- '\\\
- Dim tmp As String, res As Long
- '///
- On Error GoTo ParseError
- '\\\\\
- Do While Len(post) > 0
- 'MsgBox post
- Rem \\ detect "{" and "}"
- Select Case Left$(post, 1)
- Case "," '#
- post = Right$(post, Len(post) - 1)
- Case "{" '#
- post = Right$(post, Len(post) - 1)
- i_container1_opened = i_container1_opened + 1
- tag.add c_container1_open
- value.add c_container1_open
- Case "}" '#
- 'If ParseOneBlock And i_container1_opened = 0 And i_container2_opened = 0 Then
- ' Exit Do
- 'Else
- post = Right$(post, Len(post) - 1)
- i_container1_opened = i_container1_opened - 1
- tag.add c_container1_close
- value.add c_container1_close
- If i_container1_open = 0 And i_container2_open = 0 Then Exit Do
- 'End If
- Case "[" '#
- post = Right$(post, Len(post) - 1)
- i_container2_opened = i_container2_opened + 1
- tag.add c_container2_open
- value.add c_container2_open
- Case "]" '#
- 'If ParseOneBlock And i_container1_opened = 0 And i_container2_opened = 0 Then
- ' Exit Do
- 'Else
- post = Right$(post, Len(post) - 1)
- i_container2_closed = i_container2_closed - 1
- tag.add c_container2_close
- value.add c_container2_close
- If i_container2_opened = 0 And i_container1_opened = 0 Then Exit Do
- 'End If
- Case Else '#
- '\\\ tags, values, syntax
- res = ParseTagAndValue(post, tag, value)
- If res <> 0 Then 'error
- Parse = res
- Exit Function
- End If
- '///
- End Select
- Loop
- '/////
- Exit Function
- ParseError:
- Parse = Err.Number
- End Function
- Private Function ParseTagAndValue(ByRef post As String, ByRef tag As Collection, ByRef value As Collection) As Long
- Dim t As String, v As String, err_num As Long, tmp As String, res As Long, i As Long, i2 As Long
- Dim multivalue_type As Boolean, end_line_type As Boolean
- On Error GoTo ParseError
- If Left$(post, 1) = Chr(34) Then 'ok
- '\\\
- t = getTag(post, err_num)
- If t = "" Or err_num <> 0 Then 'error
- If err_num <> 0 Then ParseTagAndValue = err_num Else ParseTagAndValue = -1
- Else 'ok
- Rem \\ get value type
- Select Case Left$(post, 1)
- Case "{" 'multivalue #1
- multivalue_type = True
- GoTo multivalue2
- Case "[" 'multivalue #2
- multivalue2:
- '\\\
- If multivalue_type = False Then
- tag.add c_container2_open
- value.add c_container2_open
- End If
- post = Right$(post, Len(post) - 1)
- Dim JsonParser2 As New clsJson
- Dim new_tag As New Collection, new_value As New Collection
- res = JsonParser2.Parse(post, new_tag, new_value, True)
- If res = 0 Then 'ok
- For i = 1 To new_tag.count
- tag.add t & c_separator & new_tag.Item(i)
- value.add new_value.Item(i)
- Next
- Else 'error
- ParseTagAndValue = res
- Exit Function
- End If
- '///
- Case Else 'value
- '\\\
- v = getValue(post, err_num) ', tag, value)
- If err_num = 0 Then
- tag.add t
- value.add v
- Else
- ParseTagAndValue = err_num
- Exit Function
- End If
- '///
- End Select
- If Left$(post, 1) = "," Then post = Right$(post, Len(post) - 1)
- End If
- '///
- Else '[value_only,... or error
- '\\\
- i = InStr(1, post, ",")
- i2 = InStr(1, post, "]")
- If i2 < i And i > 0 Then i = i2
- If i = 0 And i2 > 0 Then i = i2: end_line_type = True
- If i > 0 Then
- v = Mid$(post, 1, i - 1)
- c_container2_closed = c_container2_closed - 1
- tag.add c_valueOnly
- value.add v
- If end_line_type Then
- tag.add c_container2_close
- value.add c_container2_close
- End If
- post = Right$(post, Len(post) - Len(v) - 1)
- If Left$(post, 1) = "," Then post = Right$(post, Len(post) - 1)
- Else
- ParseTagAndValue = -2
- End If
- '///
- End If
- Exit Function
- ParseError:
- ParseTagAndValue = Err.Number
- End Function
- Private Function getTag(ByRef string_ As String, ByRef err_num As Long) As String
- Dim i As Integer
- On Error GoTo ParseError
- err_num = 0
- Rem // "tag":value,...
- i = InStr(1, string_, ":")
- getTag = Mid$(string_, 2, i - 3)
- Rem // delete tag from string_
- string_ = Right$(string_, Len(string_) - Len(getTag) - 3)
- Exit Function
- ParseError:
- err_num = Err.Number
- End Function
- Private Function getValue(ByRef string_ As String, ByRef err_num As Long) As String ', tag As Collection, value As Collection) As String
- Dim a As Long, tmpi As Long, tmp As String
- '\\
- On Error GoTo ParseError
- err_num = 0
- '//
- Select Case Left$(string_, 1) 'first char of value
- Case "-" ' - number value redirect
- GoTo num_value
- Case "+" ' - number value redirect
- GoTo num_value
- Case "0" To "9"
- num_value:
- '\\\' number value \\\ "," Or "}"
- tmpi = InStr(1, string_, ",") ' ...value,
- a = InStr(1, string_, "}") ' ...value}
- If a = 0 And tmpi = 0 Then 'error
- err_num = -4
- Else 'ok
- If a < tmpi And a > 0 Then tmpi = a
- If tmpi = 0 And a > 0 Then tmpi = a
- 'else tmpi = tmpi
- a = InStr(1, string_, "]") ' ...value]
- If a > 0 Then
- If a < tmpi And a > 0 Then tmpi = a
- If tmpi = 0 And a > 0 Then tmpi = a
- 'else tmpi = tmpi
- getValue = c_numValue & Mid$(string_, 1, tmpi - 1)
- string_ = Right$(string_, Len(string_) - (Len(getValue) - 1)) ' - 1)
- End If
- End If
- '///
- Case Chr(34)
- '\\\' string value \\\ Chr(34)
- tmpi = InStr(2, string_, Chr(34))
- If tmpi > 0 Then 'ok
- If tmpi = 2 Then getValue = c_strValue Else getValue = c_strValue & Mid$(string_, 2, tmpi - 2)
- string_ = Right$(string_, Len(string_) - (Len(getValue) - 1) - 2)
- Else 'error
- err_num = -5
- End If
- '///
- Case Else 'unknown value, error
- 'WTF?! (o_0)
- err_num = -6
- End Select
- Exit Function
- ParseError:
- err_num = Err.Number
- End Function
- '/// The End of JsonParser. 14:07, 13 July 2012. bugfix #3
- Const c_strValue As String =
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement