2017-01-12 124 views
1

我必須做一些處理來自web服務器的json格式化輸出的vbscript。我使用的是我發現的名爲「aspJSON」的舊vbscript代碼片段 - 我認爲它來自www.aspjson.com,但該站點不再可用。使用VBscript訪問JSON數據中的所有值

我有這個JSON文件:

{ 
"VAT":12678967.543233, 
"buyInfo":{ 
    "maximumBuyAmount":100, 
    "minimumBuyAmount":1, 
}, 
"prices":[{ 
    "unitPrice":12.50 
    "specialOfferPrice":8.75, 
    "period":{ 
     "endDate":"\/Date(928142400000+0200)\/", 
     "startDate":"\/Date(928142400000+0200)\/", 
    }, 
}], 
} 

隨着aspJSON代碼,我可以得到一些從數據中值。 Theese兩人將很好地工作:

Msgbox oJSON.data("VAT") 

MsgBox oJSON.data("buyInfo").item("maximumBuyAmount") 

但我似乎無法存取權限的prices值:

[{"unitPrice":12.50}] 

period

[{"period":{"endDate":"xxx"}}] 

如何才能獲得這些價值?

這是aspJSON代碼:

'Februari 2014 - Version 1.17 by Gerrit van Kuipers 
Class aspJSON 
Public data 
Private p_JSONstring 
private aj_in_string, aj_in_escape, aj_i_tmp, aj_char_tmp, aj_s_tmp, aj_line_tmp, aj_line, aj_lines, aj_currentlevel, aj_currentkey, aj_currentvalue, aj_newlabel, aj_XmlHttp, aj_RegExp, aj_colonfound 

Private Sub Class_Initialize() 
    Set data = Collection() 

    Set aj_RegExp = new regexp 
    aj_RegExp.Pattern = "\s{0,}(\S{1}[\s,\S]*\S{1})\s{0,}" 
    aj_RegExp.Global = False 
    aj_RegExp.IgnoreCase = True 
    aj_RegExp.Multiline = True 
End Sub 

Private Sub Class_Terminate() 
    Set data = Nothing 
    Set aj_RegExp = Nothing 
End Sub 

Public Sub loadJSON(inputsource) 
    inputsource = aj_MultilineTrim(inputsource) 
    If Len(inputsource) = 0 Then Err.Raise 1, "loadJSON Error", "No data to load." 

    select case Left(inputsource, 1) 
     case "{", "[" 
     case else 
      Set aj_XmlHttp = CreateObject("Msxml2.ServerXMLHTTP") 
      aj_XmlHttp.open "GET", inputsource, False 
      aj_XmlHttp.setRequestHeader "Content-Type", "text/json" 
      aj_XmlHttp.setRequestHeader "CharSet", "UTF-8" 
      aj_XmlHttp.Send 
      inputsource = aj_XmlHttp.responseText 
      set aj_XmlHttp = Nothing 
    end select 

    p_JSONstring = CleanUpJSONstring(inputsource) 
    aj_lines = Split(p_JSONstring, Chr(13) & Chr(10)) 

    Dim level(99) 
    aj_currentlevel = 1 
    Set level(aj_currentlevel) = data 
    For Each aj_line In aj_lines 
     aj_currentkey = "" 
     aj_currentvalue = "" 
     If Instr(aj_line, ":") > 0 Then 
      aj_in_string = False 
      aj_in_escape = False 
      aj_colonfound = False 
      For aj_i_tmp = 1 To Len(aj_line) 
       If aj_in_escape Then 
        aj_in_escape = False 
       Else 
        Select Case Mid(aj_line, aj_i_tmp, 1) 
         Case """" 
          aj_in_string = Not aj_in_string 
         Case ":" 
          If Not aj_in_escape And Not aj_in_string Then 
           aj_currentkey = Left(aj_line, aj_i_tmp - 1) 
           aj_currentvalue = Mid(aj_line, aj_i_tmp + 1) 
           aj_colonfound = True 
           Exit For 
          End If 
         Case "\" 
          aj_in_escape = True 
        End Select 
       End If 
      Next 
      if aj_colonfound then 
       aj_currentkey = aj_Strip(aj_JSONDecode(aj_currentkey), """") 
       If Not level(aj_currentlevel).exists(aj_currentkey) Then level(aj_currentlevel).Add aj_currentkey, "" 
      end if 
     End If 
     If right(aj_line,1) = "{" Or right(aj_line,1) = "[" Then 
      If Len(aj_currentkey) = 0 Then aj_currentkey = level(aj_currentlevel).Count 
      Set level(aj_currentlevel).Item(aj_currentkey) = Collection() 
      Set level(aj_currentlevel + 1) = level(aj_currentlevel).Item(aj_currentkey) 
      aj_currentlevel = aj_currentlevel + 1 
      aj_currentkey = "" 
     ElseIf right(aj_line,1) = "}" Or right(aj_line,1) = "]" or right(aj_line,2) = "}," Or right(aj_line,2) = "]," Then 
      aj_currentlevel = aj_currentlevel - 1 
     ElseIf Len(Trim(aj_line)) > 0 Then 
      if Len(aj_currentvalue) = 0 Then aj_currentvalue = aj_line 
      aj_currentvalue = getJSONValue(aj_currentvalue) 

      If Len(aj_currentkey) = 0 Then aj_currentkey = level(aj_currentlevel).Count 
      level(aj_currentlevel).Item(aj_currentkey) = aj_currentvalue 
     End If 
    Next 
End Sub 

Public Function Collection() 
    set Collection = CreateObject("Scripting.Dictionary") 
End Function 

Public Function AddToCollection(dictobj) 
    if TypeName(dictobj) <> "Dictionary" then Err.Raise 1, "AddToCollection Error", "Not a collection." 
    aj_newlabel = dictobj.Count 
    dictobj.Add aj_newlabel, Collection() 
    set AddToCollection = dictobj.item(aj_newlabel) 
end function 

Private Function CleanUpJSONstring(aj_originalstring) 
    aj_originalstring = Replace(aj_originalstring, Chr(13) & Chr(10), "") 
    aj_originalstring = Mid(aj_originalstring, 2, Len(aj_originalstring) - 2) 
    aj_in_string = False : aj_in_escape = False : aj_s_tmp = "" 
    For aj_i_tmp = 1 To Len(aj_originalstring) 
     aj_char_tmp = Mid(aj_originalstring, aj_i_tmp, 1) 
     If aj_in_escape Then 
      aj_in_escape = False 
      aj_s_tmp = aj_s_tmp & aj_char_tmp 
     Else 
      Select Case aj_char_tmp 
       Case "\" : aj_s_tmp = aj_s_tmp & aj_char_tmp : aj_in_escape = True 
       Case """" : aj_s_tmp = aj_s_tmp & aj_char_tmp : aj_in_string = Not aj_in_string 
       Case "{", "[" 
        aj_s_tmp = aj_s_tmp & aj_char_tmp & aj_InlineIf(aj_in_string, "", Chr(13) & Chr(10)) 
       Case "}", "]" 
        aj_s_tmp = aj_s_tmp & aj_InlineIf(aj_in_string, "", Chr(13) & Chr(10)) & aj_char_tmp 
       Case "," : aj_s_tmp = aj_s_tmp & aj_char_tmp & aj_InlineIf(aj_in_string, "", Chr(13) & Chr(10)) 
       Case Else : aj_s_tmp = aj_s_tmp & aj_char_tmp 
      End Select 
     End If 
    Next 

    CleanUpJSONstring = "" 
    aj_s_tmp = split(aj_s_tmp, Chr(13) & Chr(10)) 
    For Each aj_line_tmp In aj_s_tmp 
     aj_line_tmp = replace(replace(aj_line_tmp, chr(10), ""), chr(13), "") 
     CleanUpJSONstring = CleanUpJSONstring & aj_Trim(aj_line_tmp) & Chr(13) & Chr(10) 

    Next 


    End Function 

Private Function getJSONValue(ByVal val) 
    val = Trim(val) 
    If Left(val,1) = ":" Then val = Mid(val, 2) 
    If Right(val,1) = "," Then val = Left(val, Len(val) - 1) 
    val = Trim(val) 

    Select Case val 
     Case "true" : getJSONValue = True 
     Case "false" : getJSONValue = False 
     Case "null" : getJSONValue = Null 
     Case Else 
      If (Instr(val, """") = 0) Then 
       If IsNumeric(val) Then 
        getJSONValue = CDbl(val) 
       Else 
        getJSONValue = val 
       End If 
      Else 
       If Left(val,1) = """" Then val = Mid(val, 2) 
       If Right(val,1) = """" Then val = Left(val, Len(val) - 1) 
       getJSONValue = aj_JSONDecode(Trim(val)) 
      End If 
    End Select 
End Function 

Private JSONoutput_level 
Public Function JSONoutput() 
    dim wrap_dicttype, aj_label 
    JSONoutput_level = 1 
    wrap_dicttype = "[]" 
    For Each aj_label In data 
     If Not aj_IsInt(aj_label) Then wrap_dicttype = "{}" 
    Next 
    JSONoutput = Left(wrap_dicttype, 1) & Chr(13) & Chr(10) & GetDict(data) & Right(wrap_dicttype, 1) 
End Function 

Private Function GetDict(objDict) 
    dim aj_item, aj_keyvals, aj_label, aj_dicttype 
    For Each aj_item In objDict 
     Select Case TypeName(objDict.Item(aj_item)) 
      Case "Dictionary" 
       GetDict = GetDict & Space(JSONoutput_level * 4) 

       aj_dicttype = "[]" 
       For Each aj_label In objDict.Item(aj_item).Keys 
        If Not aj_IsInt(aj_label) Then aj_dicttype = "{}" 
       Next 
       If aj_IsInt(aj_item) Then 
        GetDict = GetDict & (Left(aj_dicttype,1) & Chr(13) & Chr(10)) 
       Else 
        GetDict = GetDict & ("""" & aj_JSONEncode(aj_item) & """" & ": " & Left(aj_dicttype,1) & Chr(13) & Chr(10)) 
       End If 
       JSONoutput_level = JSONoutput_level + 1 

       aj_keyvals = objDict.Keys 
       GetDict = GetDict & (GetSubDict(objDict.Item(aj_item)) & Space(JSONoutput_level * 4) & Right(aj_dicttype,1) & aj_InlineIf(aj_item = aj_keyvals(objDict.Count - 1),"" , ",") & Chr(13) & Chr(10)) 
      Case Else 
       aj_keyvals = objDict.Keys 
       GetDict = GetDict & (Space(JSONoutput_level * 4) & aj_InlineIf(aj_IsInt(aj_item), "", """" & aj_JSONEncode(aj_item) & """: ") & WriteValue(objDict.Item(aj_item)) & aj_InlineIf(aj_item = aj_keyvals(objDict.Count - 1),"" , ",") & Chr(13) & Chr(10)) 
     End Select 
    Next 
End Function 

Private Function aj_IsInt(val) 
    aj_IsInt = (TypeName(val) = "Integer" Or TypeName(val) = "Long") 
End Function 

Private Function GetSubDict(objSubDict) 
    GetSubDict = GetDict(objSubDict) 
    JSONoutput_level= JSONoutput_level -1 
End Function 

Private Function WriteValue(ByVal val) 
    Select Case TypeName(val) 
     Case "Double", "Integer", "Long": WriteValue = val 
     Case "Null"      : WriteValue = "null" 
     Case "Boolean"     : WriteValue = aj_InlineIf(val, "true", "false") 
     Case Else      : WriteValue = """" & aj_JSONEncode(val) & """" 
    End Select 
End Function 

Private Function aj_JSONEncode(ByVal val) 
    val = Replace(val, "\", "\\") 
    val = Replace(val, """", "\""") 
    'val = Replace(val, "/", "\/") 
    val = Replace(val, Chr(8), "\b") 
    val = Replace(val, Chr(12), "\f") 
    val = Replace(val, Chr(10), "\n") 
    val = Replace(val, Chr(13), "\r") 
    val = Replace(val, Chr(9), "\t") 
    aj_JSONEncode = Trim(val) 
End Function 

Private Function aj_JSONDecode(ByVal val) 
    val = Replace(val, "\""", """") 
    val = Replace(val, "\\", "\") 
    val = Replace(val, "\/", "/") 
    val = Replace(val, "\b", Chr(8)) 
    val = Replace(val, "\f", Chr(12)) 
    val = Replace(val, "\n", Chr(10)) 
    val = Replace(val, "\r", Chr(13)) 
    val = Replace(val, "\t", Chr(9)) 
    aj_JSONDecode = Trim(val) 
End Function 

Private Function aj_InlineIf(condition, returntrue, returnfalse) 
    If condition Then aj_InlineIf = returntrue Else aj_InlineIf = returnfalse 
End Function 

Private Function aj_Strip(ByVal val, stripper) 
    If Left(val, 1) = stripper Then val = Mid(val, 2) 
    If Right(val, 1) = stripper Then val = Left(val, Len(val) - 1) 
    aj_Strip = val 
End Function 

Private Function aj_MultilineTrim(TextData) 
    aj_MultilineTrim = aj_RegExp.Replace(TextData, "$1") 
End Function 

private function aj_Trim(val) 
    aj_Trim = Trim(val) 
    Do While Left(aj_Trim, 1) = Chr(9) : aj_Trim = Mid(aj_Trim, 2) : Loop 
    Do While Right(aj_Trim, 1) = Chr(9) : aj_Trim = Left(aj_Trim, Len(aj_Trim) - 1) : Loop 
    aj_Trim = Trim(aj_Trim) 
end function 
End Class 
+0

不同的是'prices'是一個集合,所以你需要遍歷的情況下才可以訪問每個實例的基本屬性。像「For Each」循環這樣的應用程序應該能夠做到這一點。 – Lankymart

+0

嘗試'Msgbox TypeName(oJSON.data(「prices」))'''''Msgbox Join(oJSON.data(「prices」)。Keys(),「,」)' – omegastripes

+0

@omegastripes如果'prices'包含'Scripting .Dictionary'拉動'.Keys()'做些什麼?你仍然會缺少這些值。可能會幫助調試字典的內容,但僅此而已。 – Lankymart

回答

0

不同於VATbuyInfoprices是它可以包含多個實例集合(請注意在JSON結構上的差異,prices由方括號封裝的)。無論何時處理集合,都需要循環遍歷實例以獲取其基礎屬性。

我推薦一個For Each循環,如下所示。

Dim key, price 

'Iterating a Scripting.Dictionary using For Each returns the key. 
For Each key In oJSON.data("prices") 
    'Get the price instance by passing the key back into 
    'the Scripting.Dictionary. 
    Set price = oJSON.data("prices")(key) 
    MsgBox price.item("unitPrice") 
    MsgBox price.item("specialOfferPrice") 
    MsgBox price.item("period").item("endDate") 
    MsgBox price.item("period").item("startDate") 
    'Clear object before iterating the next instance. 
    Set price = Nothing 
Next 

法典規定未經檢驗


展望本多用一些有益的討論了一下在評論@omegastripes並通過aspJSON類看,你應該能夠按順序訪問Collection/Array項目,例如獲得您要使用的unitPrice;

oJSON("prices")(0).Item("unitPrice") 

考慮到這一點,做了一個快速測試腳本,這裏是結果。

Option Explicit 

Dim prices: Set prices = CreateObject("Scripting.Dictionary") 
Dim price, period 

With prices 
    Set price = CreateObject("Scripting.Dictionary") 
    With price 
     Call .Add("unitPrice", 12.50) 
     Call .Add("specialOfferPrice", 8.75) 
     Set period = CreateObject("Scripting.Dictionary") 
     With period 
      Call .Add("endDate", "/Date(928142400000+0200)/") 
     End With 
     Call .Add("period", period) 
    End With 
    'Uses same method as the AddToCollection() in aspJSON to 
    'assign the ordinal position when adding the child Dictionary. 
    Call .Add(.Count, price) 
End With 

WScript.Echo prices(0).Item("unitPrice") 
WScript.Echo prices(0).Item("period").Item("endDate") 

輸出:

12.5 
/Date(928142400000+0200)/ 
+0

嗨Lankymart 我試過的代碼,但它給了我一個錯誤:對象需要:'價格' – svlarsen

+0

@slarson我說沒有經過測試,這是我最好的猜測根據您提供的。問題在於'prices'是一個數組/集合,需要迭代以獲取底層數據。 – Lankymart

+0

@svlarsen它使用'ADODB.Dictionary'來存儲集合,我已經更新了我的答案,以反映這一點,因爲'ADODB.Dictionary'只是迭代鍵,並且需要將密鑰傳遞回來以獲取實例。 – Lankymart