-
Notifications
You must be signed in to change notification settings - Fork 6
/
frmTest.frm
143 lines (107 loc) · 3.85 KB
/
frmTest.frm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmTest
BorderStyle = 1 'Fixed Single
Caption = "VBJSON Test Form"
ClientHeight = 2490
ClientLeft = 45
ClientTop = 330
ClientWidth = 2730
Icon = "frmTest.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2490
ScaleWidth = 2730
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdRunJSC
Caption = "Run JSONScript Program"
Height = 615
Left = 120
TabIndex = 2
Top = 1800
Width = 2535
End
Begin MSComDlg.CommonDialog cd
Left = 960
Top = 2280
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton cmdReadJSON
Caption = "Read JSON Data From File"
Height = 735
Left = 120
TabIndex = 1
Top = 960
Width = 2535
End
Begin VB.CommandButton cmdObjToJSON
Caption = "Test JSON Object"
Height = 735
Left = 120
TabIndex = 0
Top = 120
Width = 2535
End
End
Attribute VB_Name = "frmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' VBJSON is a VB6 adaptation of the VBA JSON project at http://code.google.com/p/vba-json/
' Some bugs fixed, speed improvements added for VB6 by Michael Glaser ([email protected])
' BSD Licensed
Private Sub cmdObjToJSON_Click()
Dim p As Object
Dim sInputJson As String
sInputJson = "{ width: '200', frame: false, height: 130, bodyStyle:'background-color: #ffffcc;',buttonAlign:'right', items: [{ xtype: 'form', url: '/content.asp'},{ xtype: 'form2', url: '/content2.asp'}] }"
MsgBox "Input JSON string: " & sInputJson
' sets p
Set p = JSON.parse(sInputJson)
MsgBox "Parsed object output: " & JSON.toString(p)
MsgBox "Get Bodystyle data: " & p.Item("bodyStyle")
MsgBox "Get Form Url data: " & p.Item("items").Item(1).Item("url")
p.Item("items").Item(1).Add "ExtraItem", "Extra Data Value"
MsgBox "Parsed object output with added item: " & JSON.toString(p)
End Sub
Private Sub cmdReadJSON_Click()
Dim p As Object
cd.ShowOpen
If cd.FileName <> "" Then
Set p = JSON.parse(ReadTextFile(cd.FileName))
If Not (p Is Nothing) Then
If JSON.GetParserErrors <> "" Then
MsgBox JSON.GetParserErrors, vbInformation, "Parsing Error(s) occured"
Else
MsgBox "Base item count: " & p.Count
MsgBox "JSON toString: " & Left(JSON.toString(p), 1000)
End If
Else
MsgBox "An error occurred parsing " & cd.FileName
End If
End If
End Sub
Private Sub cmdRunJSC_Click()
Dim JSC As New cJSONScript
Dim p As Object
cd.InitDir = App.Path
cd.ShowOpen
If cd.FileName <> "" Then
MsgBox JSC.Eval(ReadTextFile(cd.FileName)), vbInformation, "Program Output"
End If
End Sub
Public Function ReadTextFile(sFilePath As String) As String
On Error Resume Next
Dim handle As Integer
If LenB(Dir$(sFilePath)) > 0 Then
handle = FreeFile
Open sFilePath For Binary As #handle
ReadTextFile = Space$(LOF(handle))
Get #handle, , ReadTextFile
Close #handle
End If
End Function