How to make my VB.NET code dynamic instead of static? - json

The following code gives me the error system.argumentexception an element with the same key already exists. When I use in the the Friend Sub Test the following line instead: 'Dim str_rootdirectory As String = Directory.GetCurrentDirectory() ' "C:\TEMP" it works. Whats the difference?
My VB.NET code:
Public Class Form1
Public Sub recur_getdirectories(ByVal di As DirectoryInfo)
For Each directory As DirectoryInfo In di.GetDirectories()
'get each directory and call the module main to get the security info and write to json
Call Module1.Main(directory.FullName)
recur_getdirectories(directory)
Next
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim rootDirectory As String = TextBox1.Text.Trim()
Dim di As New DirectoryInfo(rootDirectory)
'get directories recursively and work with each of them
recur_getdirectories(di)
End Sub
End Class
Public Module RecursiveEnumerableExtensions
Iterator Function Traverse(Of T)(ByVal root As T, ByVal children As Func(Of T, IEnumerable(Of T)), ByVal Optional includeSelf As Boolean = True) As IEnumerable(Of T)
If includeSelf Then Yield root
Dim stack = New Stack(Of IEnumerator(Of T))()
Try
stack.Push(children(root).GetEnumerator())
While stack.Count <> 0
Dim enumerator = stack.Peek()
If Not enumerator.MoveNext() Then
stack.Pop()
enumerator.Dispose()
Else
Yield enumerator.Current
stack.Push(children(enumerator.Current).GetEnumerator())
End If
End While
Finally
For Each enumerator In stack
enumerator.Dispose()
Next
End Try
End Function
End Module
Public Module TestClass
Function GetFileSystemAccessRule(d As DirectoryInfo) As IEnumerable(Of FileSystemAccessRule)
Dim ds As DirectorySecurity = d.GetAccessControl()
Dim arrRules As AuthorizationRuleCollection = ds.GetAccessRules(True, True, GetType(Security.Principal.NTAccount))
For Each authorizationRule As FileSystemAccessRule In arrRules
Dim strAclIdentityReference As String = authorizationRule.IdentityReference.ToString()
Dim strInheritanceFlags As String = authorizationRule.InheritanceFlags.ToString()
Dim strAccessControlType As String = authorizationRule.AccessControlType.ToString()
Dim strFileSystemRights As String = authorizationRule.FileSystemRights.ToString()
Dim strIsInherited As String = authorizationRule.IsInherited.ToString()
Next
' This function should return the following values, because they should be mentoined in the JSON:
' IdentityReference = strAclIdentityReference
' InheritanceFlags = strInheritanceFlags
' AccessControlType = strAccessControlType
' FileSystemRights = strFileSystemRights
' IsInherited = strIsInherited
Return ds.GetAccessRules(True, True, GetType(System.Security.Principal.NTAccount)).Cast(Of FileSystemAccessRule)()
End Function
Friend Sub Test(ByVal curDirectory As String)
'Dim str_rootdirectory As String = Directory.GetCurrentDirectory() ' "C:\TEMP"
Dim str_rootdirectory As String = curDirectory
Dim di As DirectoryInfo = New DirectoryInfo(str_rootdirectory)
Dim directoryQuery = RecursiveEnumerableExtensions.Traverse(di, Function(d) d.GetDirectories())
Dim list = directoryQuery.Select(
Function(d) New With {
.directory = d.FullName,
.permissions = {
GetFileSystemAccessRule(d).ToDictionary(Function(a) a.IdentityReference.ToString(), Function(a) a.FileSystemRights.ToString())
}
}
)
Dim json = JsonConvert.SerializeObject(list, Formatting.Indented)
File.WriteAllText("ABCD.json", json)
End Sub
End Module
Public Module Module1
Public Sub Main(ByVal curDirectory As String)
Console.WriteLine("Environment version: " & Environment.Version.ToString())
Console.WriteLine("Json.NET version: " & GetType(JsonSerializer).Assembly.FullName)
Console.WriteLine("")
Try
TestClass.Test(curDirectory)
Catch ex As Exception
Console.WriteLine("Unhandled exception: ")
Console.WriteLine(ex)
Throw
End Try
End Sub
End Module
My example folder structure:
Folder: "C:\Temp"
Permissions: SecurityGroup-A has Fullcontrol,
SecurityGroup-B has Modify permission
Folder: "C:\Temp\Folder_A"
Permissions: SecurityGroup-C has Fullcontrol
But this is only an example of two folders. In real, it will run over several hundered folders with sub-folders. Accordingly the JSON will extend.
My json output expectation:
[{
"directory": "C:\\TEMP",
"permissions": [{
"IdentityReference": "CONTOSO\\SecurityGroup-A",
"AccessControlType": "Allow",
"FileSystemRights": "FullControl",
"IsInherited": "TRUE"
}, {
"IdentityReference": "CONTOSO\\SecurityGroup-B",
"AccessControlType": "Allow",
"FileSystemRights": "Modify",
"IsInherited": "False"
}
]
}, {
"directory": "C:\\TEMP\\Folder_A",
"permissions": [{
"IdentityReference": "CONTOSO\\SecurityGroup-C",
"AccessControlType": "Allow",
"FileSystemRights": "Full Control",
"IsInherited": "False"
}
]
}
]

Your current JSON uses static property names for the [*].permissions[*] objects so there is no need to try to convert a list of them into a dictionary with variable key names via ToDictionary():
' This is not needed
.permissions = {
GetFileSystemAccessRule(d).ToDictionary(Function(a) a.IdentityReference.ToString(), Function(a) a.FileSystemRights.ToString())
}
Instead, convert each FileSystemAccessRule into some appropriate DTO for serialization. An anonymous type object works nicely for this purpose:
Public Module DirectoryExtensions
Function GetFileSystemAccessRules(d As DirectoryInfo) As IEnumerable(Of FileSystemAccessRule)
Dim ds As DirectorySecurity = d.GetAccessControl()
Dim arrRules As AuthorizationRuleCollection = ds.GetAccessRules(True, True, GetType(Security.Principal.NTAccount))
Return arrRules.Cast(Of FileSystemAccessRule)()
End Function
Public Function SerializeFileAccessRules(ByVal curDirectory As String, Optional ByVal formatting As Formatting = Formatting.Indented)
Dim di As DirectoryInfo = New DirectoryInfo(curDirectory)
Dim directoryQuery = RecursiveEnumerableExtensions.Traverse(di, Function(d) d.GetDirectories())
Dim list = directoryQuery.Select(
Function(d) New With {
.directory = d.FullName,
.permissions = GetFileSystemAccessRules(d).Select(
Function(a) New With {
.IdentityReference = a.IdentityReference.ToString(),
.AccessControlType = a.AccessControlType.ToString(),
.FileSystemRights = a.FileSystemRights.ToString(),
.IsInherited = a.IsInherited.ToString()
}
)
}
)
Return JsonConvert.SerializeObject(list, formatting)
End Function
End Module
Public Module RecursiveEnumerableExtensions
' Translated to vb.net from this answer https://stackoverflow.com/a/60997251/3744182
' To https://stackoverflow.com/questions/60994574/how-to-extract-all-values-for-all-jsonproperty-objects-with-a-specified-name-fro
' which was rewritten from the answer by Eric Lippert https://stackoverflow.com/users/88656/eric-lippert
' to "Efficient graph traversal with LINQ - eliminating recursion" https://stackoverflow.com/questions/10253161/efficient-graph-traversal-with-linq-eliminating-recursion
Iterator Function Traverse(Of T)(ByVal root As T, ByVal children As Func(Of T, IEnumerable(Of T)), ByVal Optional includeSelf As Boolean = True) As IEnumerable(Of T)
If includeSelf Then Yield root
Dim stack = New Stack(Of IEnumerator(Of T))()
Try
stack.Push(children(root).GetEnumerator())
While stack.Count <> 0
Dim enumerator = stack.Peek()
If Not enumerator.MoveNext() Then
stack.Pop()
enumerator.Dispose()
Else
Yield enumerator.Current
stack.Push(children(enumerator.Current).GetEnumerator())
End If
End While
Finally
For Each enumerator In stack
enumerator.Dispose()
Next
End Try
End Function
End Module
Demo fiddle here (which unfortunately does not work on https://dotnetfiddle.net because of security restrictions on client code but should be runnable in full trust).

Related

How to return Func(Of T, IEnumerable(Of T)) inside a function which handles the exception?

How can I handle the following exception?
My code:
Public Module RecursiveEnumerableExtensions
'credits Eric Lippert https://stackoverflow.com/users/88656/eric-lippert
Iterator Function Traverse(Of T)(ByVal root As T, ByVal children As Func(Of T, IEnumerable(Of T)), ByVal Optional includeSelf As Boolean = True) As IEnumerable(Of T)
If includeSelf Then Yield root
Dim stack = New Stack(Of IEnumerator(Of T))()
Try
stack.Push(children(root).GetEnumerator())
While stack.Count <> 0
Dim enumerator = stack.Peek()
If Not enumerator.MoveNext() Then
stack.Pop()
enumerator.Dispose()
Else
Yield enumerator.Current
stack.Push(children(enumerator.Current).GetEnumerator())
End If
End While
Finally
For Each enumerator In stack
enumerator.Dispose()
Next
End Try
End Function
End Module
Friend Sub Main()
Dim dinfo As DirectoryInfo = New DirectoryInfo(curDirectory)
Dim dquery = RecursiveEnumerableExtensions.Traverse(dinfo, Function(d) d.GetDirectories())
End Sub
When I run my code, for some of the directories, which are not accessible, I receive inside the Friend Sub Main() in the part Function(d) d.GetDirectories()) the exception System.UnauthorizedAccessException. I would like to handle this by Try Catch.
I tried to edit the Friend Sub Main() and export the Lambda expression to a function funcGetDirectories, but it fails with following error: System.InvalidCastException
Friend Sub Main()
Dim dinfo As DirectoryInfo = New DirectoryInfo(curDirectory)
Dim dquery = RecursiveEnumerableExtensions.Traverse(dinfo, funcGetDirectories(dinfo))
End Sub
Function funcGetDirectories(di As DirectoryInfo)
Try
Return di.GetDirectories()
Catch ex As UnauthorizedAccessException
Throw
Catch ex_default As Exception
Throw
End Try
End Function
Whats wrong with my Return di.GetDirectories()?
Note I'm working with .NET 4.8.
One option is to pass in an error handler to your DirectoryInfo and FileSystemAccessRule enumeration methods. Those methods can catch all errors and pass then to the handler, which can optionally handle the error and allow traversal to continue:
Public Class DirectoryExtensions
Shared Function GetFileSystemAccessRules(d As DirectoryInfo, ByVal errorHandler As Action(Of Object, DirectoryTraversalErrorEventArgs)) As IEnumerable(Of FileSystemAccessRule)
Try
Dim ds As DirectorySecurity = d.GetAccessControl()
Dim arrRules As AuthorizationRuleCollection = ds.GetAccessRules(True, True, GetType(Security.Principal.NTAccount))
Return arrRules.Cast(Of FileSystemAccessRule)()
Catch ex As Exception
If (Not HandleError(errorHandler, d.FullName, ex))
Throw
End If
Return Enumerable.Empty(Of FileSystemAccessRule)()
End Try
End Function
Shared Function EnumerateDirectories(ByVal directory As String, ByVal errorHandler As Action(Of Object, DirectoryTraversalErrorEventArgs)) As IEnumerable(Of DirectoryInfo)
Dim di As DirectoryInfo
Try
di = new DirectoryInfo(directory)
Catch ex As Exception
If (Not HandleError(errorHandler, directory, ex))
Throw
End If
Return Enumerable.Empty(Of DirectoryInfo)()
End Try
' In .NET Core 2.1+ it should be able to recursively enumerate directories and ignore errors as follows:
' Dim query = { di }.Concat(di.EnumerateDirectories("*", New System.IO.EnumerationOptions With { .RecurseSubdirectories = True, .IgnoreInaccessible = True })))
' In the meantime, it's necessary to manually catch and ignore errors.
Dim query = RecursiveEnumerableExtensions.Traverse(di,
Function(d)
Try
Return d.GetDirectories()
Catch ex As Exception
If (Not HandleError(errorHandler, d.FullName, ex))
Throw
End If
Return Enumerable.Empty(Of DirectoryInfo)()
End Try
End Function
)
Return query
End Function
Shared Function EnumerateDirectoryFileSystemAccessRules(ByVal directory As String, ByVal errorHandler As Action(Of Object, DirectoryTraversalErrorEventArgs)) As IEnumerable(Of Tuple(Of DirectoryInfo, IEnumerable(Of FileSystemAccessRule)))
Return EnumerateDirectories(directory, errorHandler).Select(Function(d) Tuple.Create(d, GetFileSystemAccessRules(d, errorHandler)))
End Function
Shared Public Function SerializeFileAccessRules(ByVal directory As String, ByVal errorHandler As Action(Of Object, DirectoryTraversalErrorEventArgs), Optional ByVal formatting As Formatting = Formatting.Indented)
Dim query = EnumerateDirectoryFileSystemAccessRules(directory, errorHandler).Select(
Function(tuple) New With {
.directory = tuple.Item1.FullName,
.permissions = tuple.Item2.Select(
Function(a) New With {
.IdentityReference = a.IdentityReference.ToString(),
.AccessControlType = a.AccessControlType.ToString(),
.FileSystemRights = a.FileSystemRights.ToString(),
.IsInherited = a.IsInherited.ToString()
}
)
}
)
Return JsonConvert.SerializeObject(query, formatting)
End Function
Private Shared Function HandleError(ByVal errorHandler As Action(Of Object, DirectoryTraversalErrorEventArgs), ByVal fullName as String, ByVal ex as Exception) As Boolean
If (errorHandler Is Nothing)
Return False
End If
Dim args As New DirectoryTraversalErrorEventArgs(fullName, ex)
errorHandler(GetType(DirectoryExtensions), args)
return args.Handled
End Function
End Class
Public Class DirectoryTraversalErrorEventArgs
Inherits EventArgs
Private _directory As String
Private _exception As Exception
Public Sub New(ByVal directory as String, ByVal exception as Exception)
Me._directory = directory
Me._exception = exception
End Sub
Public Property Handled As Boolean = false
Public Readonly Property Directory As String
Get
Return _directory
End Get
End Property
Public Readonly Property Exception As Exception
Get
Return _exception
End Get
End Property
End Class
Public Module RecursiveEnumerableExtensions
' Translated to vb.net from this answer https://stackoverflow.com/a/60997251/3744182
' To https://stackoverflow.com/questions/60994574/how-to-extract-all-values-for-all-jsonproperty-objects-with-a-specified-name-fro
' which was rewritten from the answer by Eric Lippert https://stackoverflow.com/users/88656/eric-lippert
' to "Efficient graph traversal with LINQ - eliminating recursion" https://stackoverflow.com/questions/10253161/efficient-graph-traversal-with-linq-eliminating-recursion
Iterator Function Traverse(Of T)(ByVal root As T, ByVal children As Func(Of T, IEnumerable(Of T)), ByVal Optional includeSelf As Boolean = True) As IEnumerable(Of T)
If includeSelf Then Yield root
Dim stack = New Stack(Of IEnumerator(Of T))()
Try
stack.Push(children(root).GetEnumerator())
While stack.Count <> 0
Dim enumerator = stack.Peek()
If Not enumerator.MoveNext() Then
stack.Pop()
enumerator.Dispose()
Else
Yield enumerator.Current
stack.Push(children(enumerator.Current).GetEnumerator())
End If
End While
Finally
For Each enumerator In stack
enumerator.Dispose()
Next
End Try
End Function
End Module
Then call the method and accumulate the errors in a list of errors like so:
Dim errors = New List(Of Tuple(Of String, String))
Dim handler As Action(Of Object, DirectoryTraversalErrorEventArgs) =
Sub(sender, e)
errors.Add(Tuple.Create(e.Directory, e.Exception.Message))
e.Handled = true
End Sub
Dim json As String = DirectoryExtensions.SerializeFileAccessRules(curDirectory, handler)
' Output the JSON and the errors somehow
Console.WriteLine(json)
For Each e In errors
Console.WriteLine("Error in directory {0}: {1}", e.Item1, e.Item2)
Next
Notes:
I am using tuples in a couple of places. Newer versions of VB.NET have a cleaner syntax for tuples, see Tuples (Visual Basic) for details.
The code manually traverses the directory hierarchy by stacking calls to DirectoryInfo.GetDirectories() and trapping errors from each call.
In .NET Core 2.1+ it should be possible to recursively enumerate directories and ignore errors by using DirectoryInfo.EnumerateDirectories(String, EnumerationOptions) as follows:
Dim query = { di }.Concat(di.EnumerateDirectories("*", New System.IO.EnumerationOptions With { .RecurseSubdirectories = True, .IgnoreInaccessible = True })))
This overload does not exist in .Net Framework 4.8 though.
Demo fiddle here

How do I create a new JSON object from another JSON object in VB.Net?

I'm using the following code in VB.Net to fetch a set of time and temperature data in JSON format that I will end up charting. I want to convert the JSON data but I only get far as creating the jObject. After that, I get lost. I'll admit, I'm a bit of a newbie!
Imports System.Collections.Generic
Imports System.IO
Imports System.Net
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Linq
Partial Class public_html_JSON
Inherits System.Web.UI.Page
Public jResults As JObject
Public rawresp As String
Public strStartTime As String = ""
Public strEndTime As String = ""
Public rangeMinutes As Long
Public debugText As String
Private Sub form1_Load(sender As Object, e As EventArgs) Handles form1.Load
Dim request As HttpWebRequest
Dim response As HttpWebResponse = Nothing
Dim reader As StreamReader
Dim cstZone As TimeZoneInfo = TimeZoneInfo.FindSystemTimeZoneById("Central Standard Time")
Dim cstTime As DateTime = TimeZoneInfo.ConvertTimeFromUtc(DateAdd(DateInterval.Day, 0, DateAdd(DateInterval.Hour, 0, Now().ToUniversalTime)), cstZone)request =
Dim url As String = "https://[somesite]?method=queryList4Chart&device.id=17002&endTime=" + strEndTime + "&sensorNumber=-1&startTime=" + strStartTime
request = DirectCast(WebRequest.Create(url), HttpWebRequest)
response = DirectCast(request.GetResponse(), HttpWebResponse)
reader = New StreamReader(response.GetResponseStream())
rawresp = reader.ReadToEnd()
response = Nothing
jResults = JObject.Parse(rawresp)
But before I send it to the client-side, I want to:
Create a new JSON string using an "x, y" format with timeArray as "x" and dataArray[0] as
"y".
Reduce the number of data points by only keeping times with minutes divisible by 5. (i.e. 5,10,15,etc...)
Here is the data I want to transform:
"dataArray":[
[
{
"value":13.4
},
{
"value":13.2
},
{
"value":13.2
},
{
"value":13.5
}
],
[
{
"value":2.8
},
{
"value":2.8
},
{
"value":2.9
},
{
"value":3.0
}
]
],
"sensorArray":[
"1.TP1(℃)",
"2.TP2(℃)"
],
"timeArray":[
"2019/11/10 14:00:41",
"2019/11/10 14:05:40",
"2019/11/10 14:07:40",
"2019/11/10 14:10:40"
]
}
And I need it in this format:
[
{
"x":2019/11/10 14:00:00,
"y":13.4
},
{
"x":2019/11/10 14:05:00,
"y":13.2
},
{
"x":2019/11/10 14:10:00,
"y":13.5
}
]
How would I go about doing that?
Thanks to Craig's suggestion, here's the final, working code!
Imports System.Collections.Generic
Imports System.IO
Imports System.Net
Imports Newtonsoft.Json
Partial Class KFPTempsV2
Inherits System.Web.UI.Page
Public strStartTime As String = ""
Public strEndTime As String = ""
Public rangeMinutes As Long
Public debugText As String
Public JSONxy As ArrayList = New ArrayList 'List of JSON strings
Private Sub form1_Load(sender As Object, e As EventArgs) Handles form1.Load
Dim request As HttpWebRequest
Dim response As HttpWebResponse = Nothing
Dim reader As StreamReader
Dim cstZone As TimeZoneInfo = TimeZoneInfo.FindSystemTimeZoneById("Central Standard Time")
Dim cstTime As DateTime = TimeZoneInfo.ConvertTimeFromUtc(DateAdd(DateInterval.Day, 0, DateAdd(DateInterval.Hour, 0, Now().ToUniversalTime)), cstZone)
Dim DeviceList As IEnumerable(Of TemperatureDevice) = GetTemperatureDevices()
Dim rawResp As String
Dim url As String = ""
Dim objXY As New List(Of List(Of XY))
rangeMinutes = 1440
strStartTime = DateAdd(DateInterval.Minute, -rangeMinutes, cstTime).ToString("MM/dd/yyyy\%20HH:mm:00")
strEndTime = cstTime.ToString("MM/dd/yyyy\%20HH:mm:ss")
'Get data from each device
For Each dv As TemperatureDevice In DeviceList
url = "https://www.[somesite].com/deviceDataAction.do?method=queryList4Chart&device.id=" & dv.ID & "&endTime=" + strEndTime + "&sensorNumber=-1&startTime=" + strStartTime
request = DirectCast(WebRequest.Create(url), HttpWebRequest)
response = DirectCast(request.GetResponse(), HttpWebResponse)
reader = New StreamReader(response.GetResponseStream())
rawResp = reader.ReadToEnd()
response = Nothing
Dim XYList As List(Of XY) = ConvertToXY(JsonConvert.DeserializeObject(Of JSONData)(rawResp))
JSONxy.Add(JsonConvert.SerializeObject(XYList))
objXY.Add(XYList) 'Store XYList for later use
Next
'Populate Current/H/L temperatures
Current1.InnerHtml = objXY(0)(objXY(0).Count - 1).y
High1.InnerHtml = MaxValue(objXY(0)).ToString
Low1.InnerHtml = MinValue(objXY(0)).ToString
Current2.InnerHtml = objXY(1)(objXY(1).Count - 1).y
High2.InnerHtml = MaxValue(objXY(1)).ToString
Low2.InnerHtml = MinValue(objXY(1)).ToString
Current3.InnerHtml = objXY(2)(objXY(2).Count - 1).y
High3.InnerHtml = MaxValue(objXY(2)).ToString
Low3.InnerHtml = MinValue(objXY(2)).ToString
Current4.InnerHtml = objXY(3)(objXY(3).Count - 1).y
High4.InnerHtml = MaxValue(objXY(2)).ToString
Low4.InnerHtml = MinValue(objXY(3)).ToString
End Sub
Function ConvertToXY(obj As JSONData) As List(Of XY)
Dim NewObj As List(Of XY) = New List(Of XY)
For i As Int16 = 0 To obj.DataArray(1).Length - 1
Dim oDate As DateTime = Convert.ToDateTime(obj.TimeArray(i))
Dim oNewDate As DateTime = New DateTime(oDate.Year, oDate.Month, oDate.Day, oDate.Hour, oDate.Minute, 0).AddMinutes(Math.Round(oDate.Second / 60))
If oNewDate.Minute Mod 5 = 0 Then
Dim objXY As XY = New XY
objXY.x = oNewDate.ToString("yyyy/MM/dd HH:mm:ss")
objXY.y = obj.DataArray(1)(i).Value
NewObj.Add(objXY)
End If
Next
Return NewObj
End Function
Function MinValue(oList As List(Of XY)) As String
Dim sglMin As Single = 200
For Each row As XY In oList
Try
If CSng(row.y) < sglMin Then
sglMin = CSng(row.y)
End If
Catch ex As Exception
End Try
Next
Return sglMin.ToString("F1")
End Function
Function MaxValue(oList As List(Of XY)) As String
Dim sglMax As Single = -200
For Each row As XY In oList
Try
If CSng(row.y) > sglMax Then
sglMax = CSng(row.y)
End If
Catch ex As Exception
End Try
Next
Return sglMax.ToString("F1")
End Function
Public Class JSONData
Public Property DataArray As DataArray()()
Public Property SensorArray As String()
Public Property TimeArray As String()
End Class
Public Class DataArray
Public Property Value As String
End Class
Class XY 'Important that xy field names be lowercase
Property x As String
Property y As String
End Class
Public Class TemperatureDevice
Public Name As String
Public ID As String
Public DatasetNum As Int16
Public Sub New()
End Sub
Public Sub New(ByVal _name As String,
ByVal _id As String,
ByVal _datasetNum As Int16
)
Name = _name
ID = _id
DatasetNum = _datasetNum
End Sub
End Class
Private Function GetTemperatureDevices() As IEnumerable(Of TemperatureDevice)
'Dataset choices TP1=0 Or TP2=1
Return New List(Of TemperatureDevice) From
{
New TemperatureDevice("Pump House", "17002", 1),
New TemperatureDevice("Planer", "7199", 1),
New TemperatureDevice("Sawmill", "7123", 1),
New TemperatureDevice("Wellons", "13293", 1)
}
End Function
End Class

Deserializing JSON in Visual basic

Basically, I'm trying to parse the comments from a 4chan thread using the 4chan JSON API. https://github.com/4chan/4chan-API
basically, there is one rich text box called input, and another called post_text_box. What im trying to do is make it so that JSON from a 4chan thread entered in the input text box, and comments are extracted from that JSON and displayed in the output text box
however, whenever I try clicking the Go button nothing happens.
Here is my code so far
Imports System.Web.Script.Serialization
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Linq
Public Class Form1
Private Sub start_button_Click(sender As Object, e As EventArgs) Handles start_button.Click
Dim j As Object = New JavaScriptSerializer().Deserialize(Of Post)(input.Text)
post_text_box.Text = j.com
End Sub
End Class
Public Class Rootobject
Public Property posts() As Post
End Class
Public Class Post
Public Property no As Integer
Public Property now As String
Public Property name As String
Public Property com As String
Public Property filename As String
Public Property ext As String
Public Property w As Integer
Public Property h As Integer
Public Property tn_w As Integer
Public Property tn_h As Integer
Public Property tim As Long
Public Property time As Integer
Public Property md5 As String
Public Property fsize As Integer
Public Property resto As Integer
Public Property bumplimit As Integer
Public Property imagelimit As Integer
Public Property replies As Integer
Public Property images As Integer
End Class
Since you're importing Newtonsoft.Json, you can just use the JsonConvert.DeserializeObject<T>(String) method:
Dim exampleJson As String = "{ 'no':'123', 'name':'Some Name', 'com':'This is a comment'}"
Dim post As Post = JsonConvert.DeserializeObject(Of Post)(exampleJson)
Dim com As String = post.com
post_text_box.Text = com
Alternatively, if you don't want to create a class for Post, you can use JsonConvert.DeserializeAnonymousType<T>(String, T):
Dim exampleJson As String = "{ 'no':'123', 'name':'Some Name', 'com':'This is a comment'}"
Dim tempPost = New With {Key .com = ""}
Dim post = JsonConvert.DeserializeAnonymousType(exampleJson, tempPost)
Dim com As String = post.com
post_text_box.Text = com
EDIT: It looks like you're getting an array back from the API:
{
"posts" : [{
"no" : 38161812,
"now" : "11\/19\/13(Tue)15:18",
"name" : "Anonymous",
"com" : ‌​ "testing thread for JSON stuff",
"filename" : "a4c",
"ext" : ".png",
"w" : 386,
"h" : 378,
"tn_w" : 250,
"tn_h" : 244,
"tim" ‌​ : 1384892303386,
"time" : 1384892303,
"md5" : "tig\/aNmBqB+zOZY5upx1Fw==",
"fsize" : 6234,
"‌​resto" : 0,
"bumplimit" : 0,
"imagelimit" : 0,
"replies" : 0,
"images" : 0
}
]
}
In that case, you will need to change the type that is being deserialized to Post():
First, add another small wrapper class:
Public Class PostWrapper
Public posts() As Post
End Class
Then adjust your deserialization code:
Dim json As String = input_box.Text
Dim postWrapper = JsonConvert.DeserializeObject(Of PostWrapper)(json) ' Deserialize array of Post objects
Dim posts = postWrapper.posts
If posts.Length = 1 Then ' or whatever condition you prefer
post_text_box.Text = posts(0).com
End If
Instead of needing to define a class, you can deserialize the JSON into an Object, like this:
Dim json As String = "{""items"":[{""Name"":""John"",""Age"":""20"",""Gender"":""Male""},{""Name"":""Tom"",""Age"":""25"",""Gender"":""Male""},{""Name"":""Sally"",""Age"":""30"",""Gender"":""Female""}]}"
Dim jss = New JavaScriptSerializer()
Dim data = jss.Deserialize(Of Object)(json)
Now, as an example, you could loop through the deserialized JSON and build an HTML table, like this:
Dim sb As New StringBuilder()
sb.Append("<table>" & vbLf & "<thead>" & vbLf & "<tr>" & vbLf)
' Build the header based on the keys of the first data item.
For Each key As String In data("items")(0).Keys
sb.AppendFormat("<th>{0}</th>" & vbLf, key)
Next
sb.Append("</tr>" & vbLf & "</thead>" & vbLf & "<tbody>" & vbLf)
For Each item As Dictionary(Of String, Object) In data("items")
sb.Append("<tr>" & vbLf)
For Each val As String In item.Values
sb.AppendFormat(" <td>{0}</td>" & vbLf, val)
Next
Next
sb.Append("</tr>" & vbLf & "</tbody>" & vbLf & "</table>")
Dim myTable As String = sb.ToString()
Disclaimer: I work with C# on a daily basis and this is a C# example using dynamic that was converted to VB.NET, please forgive me if there are any syntax errors with this.
Note:
First you have to install Newtonsoft.Json on nuget console. Then include following code on top of your code.
Imports Newtonsoft.Json
Step:1 Create class with get & set properties.
Public Class Student
Public Property rno() As String
Get
Return m_rno
End Get
Set(value As String)
m_rno = value
End Set
End Property
Private m_rno As String
Public Property name() As String
Get
Return m_name
End Get
Set(value As String)
m_name = value
End Set
End Property
Private m_name As String
Public Property stdsec() As String
Get
Return m_StdSec
End Get
Set(value As String)
m_StdSec = value
End Set
End Property
Private m_stdsec As String
End Class
Step: 2 Create string as a json format and conver as a json object model.
Dim json As String = "{'rno':'09MCA08','name':'Kannadasan Karuppaiah','stdsec':'MCA'}"
Dim stuObj As Student = JsonConvert.DeserializeObject(Of Student)(json)
Step: 3 Just traverses by object.entity name as follows.
MsgBox(stuObj.rno)
MsgBox(stuObj.name)
MsgBox(stuObj.stdsec)
Also, if you have complex json string. If there is subclasses, arrays, etc. in the json string, you can use this way at below. I tried it and it worked for me. I hope it will useful for you.
I accessed root->simpleforecast->forecastday[]->date->hight->celsius,fahrenheit values etc. in the json string.
Dim tempforecast = New With {Key .forecast = New Object}
Dim sFile As String = SimpleTools.RWFile.ReadFile("c:\\testjson\\test.json")
Dim root = JsonConvert.DeserializeAnonymousType(sFile, tempforecast)
Dim tempsimpleforecast = New With {Key .simpleforecast = New Object}
Dim forecast = jsonConvert.DeserializeAnonymousType(root.forecast.ToString(), tempsimpleforecast)
Dim templstforecastday = New With {Key .forecastday = New Object}
Dim simpleforecast = JsonConvert.DeserializeAnonymousType(forecast.simpleforecast.ToString(), templstforecastday)
Dim lstforecastday = simpleforecast.forecastday
For Each jforecastday In lstforecastday
Dim tempDate = New With {Key .date = New Object, .high = New Object, .low = New Object}
Dim forecastday = JsonConvert.DeserializeAnonymousType(jforecastday.ToString(), tempDate)
Dim tempDateDetail = New With {Key .day = "", .month = "", .year = ""}
Dim fcDateDetail = JsonConvert.DeserializeAnonymousType(forecastday.date.ToString(), tempDateDetail)
Weather_Forcast.ForcastDate = fcDateDetail.day.ToString() + "/" + fcDateDetail.month.ToString() + "/" + fcDateDetail.year.ToString()
Dim temphighDetail = New With {Key .celsius = "", .fahrenheit = ""}
Dim highDetail = JsonConvert.DeserializeAnonymousType(forecastday.high.ToString(), temphighDetail)
Dim templowDetail = New With {Key .celsius = "", .fahrenheit = ""}
Dim lowDetail = JsonConvert.DeserializeAnonymousType(forecastday.low.ToString(), templowDetail)
Weather_Forcast.highCelsius = Decimal.Parse(highDetail.celsius.ToString())
Weather_Forcast.lowCelsius = Decimal.Parse(lowDetail.celsius.ToString())
Weather_Forcast.highFahrenheit = Decimal.Parse(lowDetail.fahrenheit.ToString())
Weather_Forcast.lowFahrenheit = Decimal.Parse(lowDetail.fahrenheit.ToString())
Weather_Forcast09_Result.Add(Weather_Forcast)
Next

asmx won't return JSON

I've completely rewritten this old asmx service function but I still can't get it to return JSON. It returns XML, even if I use ajax() and set the datatype and contenttype to json. I'm trying to use this function with Jquery dataTables. And I know there are tons of questions like this but all of them I've found are C# and I was unable to adapt them.
up-to-date pastebin of full asmx file: http://pastebin.com/swXKqgd4
new code
<WebMethod()> _
<WebGet(ResponseFormat:=WebMessageFormat.Json)> _
Public Function rptPendingServerRequests() As Generic.List(Of request)
Dim _conn As SqlConnection = New SqlConnection(connectionString)
Dim _dr As SqlDataReader
Dim Sql As String = String.Empty
Sql += "<My query here>"
Try
Dim _cmd As SqlCommand = New SqlCommand(Sql, _conn)
_conn.Open()
_dr = _cmd.ExecuteReader(CommandBehavior.CloseConnection)
If _dr.HasRows Then
Dim s As request
Dim c As New Generic.List(Of request)
While _dr.Read
s = New request
With s
.requestID = _dr("request_id")
.status = _dr("status")
.requester = _dr("req_by_user_id")
.assignee = _dr("user_id")
.nextAction = _dr("description")
End With
c.Add(s)
End While
Return c
End If
Catch ex As Exception
MsgBox(ex.Message)
Finally
_conn.Close()
End Try
End Function
New class
<Serializable()> _
Public Class request
Private _requestID As Integer
Public Property requestID() As Integer
Get
Return _requestID
End Get
Set(ByVal value As Integer)
_requestID = value
End Set
End Property
Private _requester As String
Public Property requester() As String
Get
Return _requester
End Get
Set(ByVal value As String)
_requester = value
End Set
End Property
Private _requestDate As Date
Public Property requestDate() As Date
Get
Return _requestDate
End Get
Set(ByVal value As Date)
_requestDate = value
End Set
End Property
Private _status As Integer
Public Property status() As Integer
Get
Return _status
End Get
Set(ByVal value As Integer)
_status = value
End Set
End Property
Private _assignee As String
Public Property assignee() As String
Get
Return _assignee
End Get
Set(ByVal value As String)
_assignee = value
End Set
End Property
Private _nextAction As String
Public Property nextAction() As String
Get
Return _nextAction
End Get
Set(ByVal value As String)
_nextAction = value
End Set
End Property
End Class
Original Code
<WebMethod()> _
<WebGet(ResponseFormat:=WebMessageFormat.Json)> _
Public Function rptPendingServerRequestsOld() As DataSet
Dim connection As SqlConnection
Dim command As SqlCommand
Dim adapter As New SqlDataAdapter
Dim ds As New DataSet
Dim sql As String
sql = ""
sql += "<MY query here>"
connection = New SqlConnection(connectionString)
Try
connection.Open()
command = New SqlCommand(sql, connection)
adapter.SelectCommand = command
adapter.Fill(ds)
adapter.Dispose()
command.Dispose()
connection.Close()
Return ds
Catch ex As Exception
End Try
End Function
Client
$('#report').dataTable({
"bProcessing": true,
"sAjaxSource": 'reportdata.asmx/rptPendingServerRequests'
});
Since you're calling this method from JS instead of
<WebGet(ResponseFormat:=WebMessageFormat.Json)>
use
<ScriptMethod(ResponseFormat:=ResponseFormat.Json)>
attribute. Also don't forget to mark your WebService class with
<ScriptService()>
attribute.
Change this line.
Public Function rptPendingServerRequests() As Generic.List(Of request)
to
Public Function rptPendingServerRequests() As String.

save x,y spectrum data in table in ms-access

I want to create a table for LEDs. This table creates information such as name, center wavelength and the spectrum, which itself is data in the format intensity over wavelenth as 2 x n table data.
I am a beginner in access and have currently no clue how to insert this to a table.
I could of course create for each LED a table on its own, but there will be hundreds of these spectrum datas.
Such a complex data structure may be difficult to implement in a database table. An option I propose is to have a set of classes that represent the data. Then you can serialize and deserialize (read and write) the data to a file.
Sample Implementation
Module Module1
Sub Main()
Dim leds = New List(Of LED)()
Dim rnd = New Random()
'create a bunch of LEDs
For i = 1 To 10
Dim led = New LED("LED " & (i + 1).ToString(), rnd.Next(0, i * 100))
For x = 1 To 10
led.Spectrum.Add(New SpectrumInfo(rnd.Next(1, 10), rnd.Next(1000, 10000)))
Next
leds.Add(led)
Next
' write the led data to a file
Using sw As New IO.StreamWriter("LED Data.ledx")
Dim xs = New System.Xml.Serialization.XmlSerializer(leds.GetType())
xs.Serialize(sw, leds)
End Using
'read the led data from a file
Dim leds2 = New List(Of LED)()
Using sr = New System.IO.StreamReader("LED Data.ledx")
Dim xs = New System.Xml.Serialization.XmlSerializer(leds2.GetType())
leds2 = DirectCast(xs.Deserialize(sr), List(Of LED))
End Using
'confirm the two are the same
Console.WriteLine("LEDs and LEDS2 are " & If(leds.SequenceEqual(leds2), "the same", "different"))
' alternate saving using binary serializer
' works in cases where XmlSerializer doesn't
' produces smaller files too
'save the led data
Using fs = New System.IO.FileStream("LED Data.ledb", IO.FileMode.Create)
Dim bf = New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter()
bf.Serialize(fs, leds)
End Using
'read the led data
Dim leds3 = New List(Of LED)()
Using fs = New System.IO.FileStream("LED Data.ledb", IO.FileMode.Open)
Dim bf = New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter()
leds3 = DirectCast(bf.Deserialize(fs), List(Of LED))
End Using
'confirm equality
Console.WriteLine("LEDs and LEDS3 are " & If(leds.SequenceEqual(leds3), "the same", "different"))
Console.WriteLine("LEDs2 and LEDS3 are " & If(leds2.SequenceEqual(leds3), "the same", "different"))
Console.ReadLine()
End Sub
End Module
<Serializable()> _
Public Class LED
Dim _name As String
Dim _cWL As Double
Dim _spectrum As List(Of SpectrumInfo)
Public Sub New()
_name = String.Empty
_cWL = 0
_spectrum = New List(Of SpectrumInfo)()
End Sub
Public Sub New(name As String, cwl As Double, ParamArray spectrum() As SpectrumInfo)
_name = name
_cWL = cwl
_spectrum = New List(Of SpectrumInfo)(spectrum)
End Sub
Public Property Name As String
Get
Return _name
End Get
Set(value As String)
_name = value
End Set
End Property
Public Property CenterWavelength As Double
Get
Return _cWL
End Get
Set(value As Double)
_cWL = value
End Set
End Property
Public ReadOnly Property Spectrum As List(Of SpectrumInfo)
Get
Return _spectrum
End Get
End Property
Public Overrides Function Equals(obj As Object) As Boolean
If Not (TypeOf obj Is LED) Then Return False
Dim l2 = DirectCast(obj, LED)
Return l2._name = _name AndAlso l2._cWL = _cWL AndAlso l2._spectrum.SequenceEqual(_spectrum)
End Function
Public Overrides Function ToString() As String
Return String.Format("{0} [{1}]", _name, _cWL)
End Function
Public Overrides Function GetHashCode() As Integer
Dim result As Integer
For Each spec In _spectrum
result = result Xor spec.GetHashCode()
Next
Return result Xor (_name.GetHashCode() + _cWL.GetHashCode())
End Function
End Class
<Serializable()> _
Public Structure SpectrumInfo
Dim _intensity As Double
Dim _wavelength As Double
Public Sub New(intensity As Double, wavelength As Double)
_intensity = intensity
_wavelength = wavelength
End Sub
Public ReadOnly Property Intensity As Double
Get
Return _intensity
End Get
End Property
Public ReadOnly Property Wavelength As Double
Get
Return _wavelength
End Get
End Property
Public Overrides Function Equals(obj As Object) As Boolean
If TypeOf obj Is SpectrumInfo Then
Dim si = DirectCast(obj, SpectrumInfo)
Return si._wavelength = _wavelength AndAlso si._intensity = _intensity
Else
Return False
End If
End Function
Public Overrides Function ToString() As String
Return String.Format("Intensity: {0}, Wavelength: {1}", _intensity, _wavelength)
End Function
Public Overrides Function GetHashCode() As Integer
Return _intensity.GetHashCode() Xor _wavelength.GetHashCode()
End Function
End Structure
You might look at http://r937.com/relational.html
I think you want:
LED Table
ID
LEDName
CenterWavelength
And then a table for spectra
ID
LedId
Intensisty
WaveLength