I look for a solution to my problem since 2 weeks without solution.
I would like to deserialize JSON with JSON.NET, but noway ...
I create class but when i deserialize the object stay empty (Nothing).
Here the JSON :
{"plannifReponse":
{"#competence":"Abonnement","plannifDonnees":
{"entry":
[
{"key":"2013-8-11T00:00","value":
{"creneaux":
[
{"#jour":"2013-8-11T00:00","#heure":"09","#minute":"30","nombreRessources":10},
{"#jour":"2013-8-11T00:00","#heure":"10","#minute":"30","nombreRessources":2},
{"#jour":"2013-8-11T00:00","#heure":"17","#minute":"30","nombreRessources":5},
{"#jour":"2013-8-11T00:00","#heure":"20","#minute":"30","nombreRessources":5},
{"#jour":"2013-8-11T00:00","#heure":"21","#minute":"00","nombreRessources":16}
]
}
},
{"key":"2013-7-30T00:00","value":
{"creneaux":
[{"#jour":"2013-7-30T00:00","#heure":"12","#minute":"00","nombreRessources":4},{"#jour":"2013-7-30T00:00","#heure":"12","#minute":"15","nombreRessources":10},{"#jour":"2013-7-30T00:00","#heure":"12","#minute":"30","nombreRessources":3},{"#jour":"2013-7-30T00:00","#heure":"14","#minute":"00","nombreRessources":8},{"#jour":"2013-7-30T00:00","#heure":"18","#minute":"30","nombreRessources":10}]}}]}}}
For this i translate with that Class:
Public Class plannifReponse
Public competence As String
Public plannifDonnees As Dictionary(Of String, ListCreneaux)
End Class
Public Class ListCreneaux
Public listCreneaux() As Creneau
End Class
Public Class Creneau
Public jour As String
Public heure As String
Public minute As String
Public nombreRessources As Integer
Public Sub New(ByVal _jour, ByVal _heure, ByVal _minute, ByVal _nombreRessources)
jour = _jour
heure = _heure
minute = _minute
nombreRessources = _nombreRessources
End Sub
End Class
And the code :
Dim prev As plannifReponse = JsonConvert.DeserializeObject(Of plannifReponse)(My_dispos)
But it doesn't work, no error message, but prev stay "Nothing"
For help, here the source object use to serialise (it is on Java)
public class OutputPlannif {
private String competence;
private HashMap<String, ListCreneaux> plannifDonnees;
}
public class ListCreneaux {
private ArrayList<Creneau> listCrenaux;
}
public class Creneau {
private String jour;
private String heure;
private String minute;
private int nombreRessources;
}
If anyone have an idea...
Thanks
Matt
You should create a series of classes which map the JSON you want to deserialize. There are tools (such as this one) which can do that for you. Or you can do it by hand, taking one member at a time, with the result shown below:
Public Class StackOverflow_17956746
Public Class OutputPlannif
<JsonProperty("plannifReponse")> _
Public PlannifReponse As PlannifReponse
End Class
Public Class PlannifReponse
<JsonProperty("#competence")> _
Public Competence As String
<JsonProperty("plannifDonnees")> _
Public PlannifDonnees As PlannifDonnees
End Class
Public Class PlannifDonnees
<JsonProperty("entry")> _
Public Entries As List(Of Entry)
End Class
Public Class Entry
<JsonProperty("key")> _
Public Key As String
<JsonProperty("value")> _
Public Value As Value
End Class
Public Class Value
<JsonProperty("creneaux")> _
Public ListCreneaux As List(Of Creneau)
End Class
Public Class Creneau
<JsonProperty("#jour")> _
Public Jour As String
<JsonProperty("#heure")> _
Public Heure As String
<JsonProperty("#minute")> _
Public Minute As String
<JsonProperty("nomberRessources")> _
Public NombreRessources As Integer
End Class
Const JSON As String = "{" & vbCrLf & _
" ""plannifReponse"":" & vbCrLf & _
"{""#competence"":""Abonnement"",""plannifDonnees"":" & vbCrLf & _
"{""entry"":" & vbCrLf & _
"[" & vbCrLf & _
"{""key"":""2013-8-11T00:00"",""value"":" & vbCrLf & _
"{""creneaux"":" & vbCrLf & _
"[" & vbCrLf & _
"{""#jour"":""2013-8-11T00:00"",""#heure"":""09"",""#minute"":""30"",""nombreRessources"":10}," & vbCrLf & _
"{""#jour"":""2013-8-11T00:00"",""#heure"":""10"",""#minute"":""30"",""nombreRessources"":2}," & vbCrLf & _
"{""#jour"":""2013-8-11T00:00"",""#heure"":""17"",""#minute"":""30"",""nombreRessources"":5}," & vbCrLf & _
"{""#jour"":""2013-8-11T00:00"",""#heure"":""20"",""#minute"":""30"",""nombreRessources"":5}," & vbCrLf & _
"{""#jour"":""2013-8-11T00:00"",""#heure"":""21"",""#minute"":""00"",""nombreRessources"":16}" & vbCrLf & _
"]" & vbCrLf & _
"}" & vbCrLf & _
"}," & vbCrLf & _
"{""key"":""2013-7-30T00:00"",""value"":" & vbCrLf & _
"{""creneaux"":" & vbCrLf & _
"[{""#jour"":""2013-7-30T00:00"",""#heure"":""12"",""#minute"":""00"",""nombreRessources"":4},{""#jour"":""2013-7-30T00:00"",""#heure"":""12"",""#minute"":""15"",""nombreRessources"":10},{""#jour"":""2013-7-30T00:00"",""#heure"":""12"",""#minute"":""30"",""nombreRessources"":3},{""#jour"":""2013-7-30T00:00"",""#heure"":""14"",""#minute"":""00"",""nombreRessources"":8},{""#jour"":""2013-7-30T00:00"",""#heure"":""18"",""#minute"":""30"",""nombreRessources"":10}]}}]}}}"
Public Shared Sub Test()
Dim output As OutputPlannif
output = JsonConvert.DeserializeObject(Of OutputPlannif)(JSON)
Console.WriteLine(output)
End Sub
End Class
Related
I need result from this JSON:
{
"access_token": "eyJhbGciOiJSUzI1NiIsImtpZCI6IjBGOTkyNkZFQTUyOTgxRjZDMjBENUMzNUQ0NjUxMzAzQ0QzQzBFMzIiLCJ0eXAiOiJhdCtqd 3QiLCJ4NXQiOiJENWttX3FVcGdmYkNEVncxMUdVVEE4MDhEakkifQ.eyJuYmYiOjE2MjA3NzEyNDEsImV4cCI6MTYyMDc3NDg0MSwiaXNzIjoiaH R0cHM6Ly9pZC5wcmVwcm9kLmV0YS5nb3YuZWciLCJhdWQiOiJJbnZvaWNpbmdBUEkiLCJjbGllbnRfaWQiOiJlZWQ4YWY2MS01ZjRmLTQxM2MtYWZlN S1jYjg0YjBiOTlhOGMiLCJJbnRlcm1lZElkIjoiMCIsIkludGVybWVkUklOIjoiIiwiSW50ZXJtZWRFbmZvcmNlZCI6IjIiLCJuYW1lIjoiMjAyNDY5NzM 1OmVlZDhhZjYxLTVmNGYtNDEzYy1hZmU1LWNiODRiMGI5OWE4YyIsInNpZCI6IjJiYzcxYTlhLWQ1MzAtMzc1ZC0zNjMzLTUwN2E3OWFjY2Y1ZiIsInByZW ZlcnJlZF91c2VybmFtZSI6IkVSUCIsIlRheElkIjoiNTE4MDEiLCJUYXhSaW4iOiIyMDI0Njk3MzUiLCJQcm9mSWQiOiI1NDgxNCIsIklzVGF4QWRtaW4iO
iIwIiwiSXNTeXN0ZW0iOiIxIiwiTmF0SWQiOiIiLCJzY29wZSI6WyJJbnZvaWNpbmdBUEkiXX0.IIxTKWdH0cUInlzrIMON95f7S6vW-CBfRoK8ZxOI6mqp
DbRLBaZQZyNoYl4A6JYQR6FJY4YVIFUsAbkKEKwwB1MaOpMMWmkyySfUmgvBMvEo6EZnT-oewnSd2EPF_bIK7-HTGug7Rjdy__wTpBr-6PH5kzR79xXzNh_s
R7TIPcvjJ-nx7eNZREdk4J7M3X8Mfjzww2RkbizN5zXNpmc5OHh_VLtlkA-4zQrs102HA9VFTxLEIdXhrpBqEBmy9dt-onZpuiKbkioV5iH2uwAkQbDvnM9h
p7EJscL0y0xFjfwbAUxQx3ohcXtA31fwyYazKQVKHCtNm9SPgSsQ-rKevQ",
"expires_in": 3600,
"scope": "Accecc DB"
}
I used:
Dim Mytoken As JObject = JObject.Parse(TextBox1.Text)
TextBox2.Text = Mytoken.SelectToken("access_token").ToString
Now I Need to get the uuid, longId, internalId, and hashKey from the acceptedDocuments like this:
{
"submissionId": "5hfhfgy5653uytyu45fg457",
"acceptedDocuments": [
{
"uuid": "hlg5fdg7ggnjgh",
"longId": "jgjhk78jm,jhk54567ujnfgh7fggh",
"internalId": "477",
"hashKey": "dfgdfhdyjfghryjghjj"
}
],
"rejectedDocuments": []
}
You could use Newtonsoft.Json and deserialize the response into an object:
Imports Newtonsoft.Json
Public Class Submission
Public submissionId As String
Public acceptedDocuments As List(Of AcceptedDocuments)
Public rejectedDocuements As String 'not sure of the type of this property
End Class
Public Class AcceptedDocuments
Public uuid As String
Public longId As String
Public internalId As Integer
Public hashKey As String
End Class
Public Function DeserilizeJson(ByRef json As String) As Submission
Dim doc As Submission = JsonConvert.DeserializeObject(Of Submission)(json)
Return doc
End Function
This should result in a Submission class object being created, to which you can reference all of the members of it, including the List of AcceptedDocuments (you can iterate over the list as needed).
I solved the problem
Dim Mytoken As JObject = JObject.Parse(TextBox1.Text)
TextBox2.Text = "My submissionId IS: " & Mytoken.SelectToken("submissionId").ToString & Environment.NewLine & Environment.NewLine
Dim arrray As JArray = JArray.Parse(Mytoken.SelectToken("acceptedDocuments").ToString)
For Each acceptedDocuments In arrray
TextBox2.Text = TextBox2.Text & "My uuid IS: " & acceptedDocuments.SelectToken("uuid").ToString & Environment.NewLine
TextBox2.Text = TextBox2.Text & "My longId IS: " & acceptedDocuments.SelectToken("longId").ToString & Environment.NewLine
TextBox2.Text = TextBox2.Text & "My internalId IS: " & acceptedDocuments.SelectToken("internalId").ToString & Environment.NewLine
TextBox2.Text = TextBox2.Text & "My hashKey IS: " & acceptedDocuments.SelectToken("hashKey").ToString & Environment.NewLine
Next
I'm working with a coworker's code trying to recreate his REST web service in a console application. I'm very new to web services and VB so it's been quite difficult for me. It will work fine on his but I keep getting an Internal Server Error (500). I have looked this up and some suggestions I found were changing "POST" to "GET" but I received "Cannot get content body with this verb-type". I've seen forums about something like this not working from another person's machine. My coworker and I have tried going through it over and over but getting the same results.
This is the Console App
Imports System
Imports System.Collections.Generic
Imports System.IO
Imports System.Linq
Imports System.Net
Imports System.Reflection
Imports System.Text
Imports System.Threading.Tasks
Imports System.Web
Imports System.Web.UI
Imports System.Xml
Module RestConsoleClient
Private req As HttpWebRequest = Nothing
Private res As HttpWebResponse = Nothing
Private responseText As String = ""
Sub Main(args As String())
Dim url As String = ""
Try
If args.Count < 1 OrElse String.IsNullOrEmpty(args(0)) Then
Console.WriteLine("Endpoint Address is required as commandline argument;" _
& vbCrLf & "Copy/Paste one of the endpoint addresses from My.Settings into the Debug commandline arguments section" _
& vbCrLf & vbCrLf & "Press ENTER to start over...")
Console.ReadKey()
Return
Else
url = args(0)
End If
req = CType(WebRequest.Create(url), HttpWebRequest)
req.Method = "POST"
'** The conditions below allowed for generic raw data to be input as text vs. processing input data as a json object.
'** These conditions became redundant with the addition of config for WebContentTypeMapper and corresponding class to accept
'** a post declared with application/json ContentType as generic raw data, and then SUBSEQUENTLY de/serialize the json data as necessary
'If url.Contains("streamweaver") Then
' req.ContentType = "text"
'ElseIf url.Contains("auth") Then
' req.ContentType = "application/json" '; charset=utf-8"
'Else
' 'No other options are yet determined
'End If
req.Timeout = 30000
Dim sJson As String = "{""Name"":""Ashu"",""Age"":""29"",""Exp"":""7 Years"",""Technology"":"".NET""}"
Dim postBytes = Encoding.UTF8.GetBytes(sJson)
req.ContentLength = postBytes.Length
Dim requestStream As Stream = req.GetRequestStream()
requestStream.Write(postBytes, 0, postBytes.Length)
res = CType(req.GetResponse(), HttpWebResponse)
' I retained the basics for response reception even though it was not integral to this test
Dim responseStream As Stream = res.GetResponseStream()
Dim streamReader = New StreamReader(responseStream)
responseText = streamReader.ReadToEnd()
Console.WriteLine("HTTP Response: " & res.StatusCode & " - " & res.StatusDescription.Trim)
Console.WriteLine("[ Response Data: " & responseText.Trim & " ]")
Console.ReadKey()
Catch ex As Exception
Console.WriteLine(ex.Message)
Console.ReadKey()
End Try
End Sub
End Module
This here is the Interface
Imports System.IO
Imports System.ServiceModel
Imports System.ServiceModel.Web
<ServiceContract> _
Public Interface IRestServiceImpl
'<OperationContract> _
'<WebInvoke(Method:="GET", ResponseFormat:=WebMessageFormat.Xml, BodyStyle:=WebMessageBodyStyle.Wrapped, UriTemplate:="xml/{id}")> _
'Function XMLData(id As String) As String
'<OperationContract> _
'<WebInvoke(Method:="GET", ResponseFormat:=WebMessageFormat.Json, BodyStyle:=WebMessageBodyStyle.Wrapped, UriTemplate:="json/{id}")> _
'Function JSONData(id As String) As String
<OperationContract> _
<WebInvoke(Method:="POST", ResponseFormat:=WebMessageFormat.Json, RequestFormat:=WebMessageFormat.Json, BodyStyle:=WebMessageBodyStyle.Bare, UriTemplate:="auth")> _
Function Auth(rData As Stream) As ResponseData
<OperationContract> _
<WebInvoke(Method:="POST", ResponseFormat:=WebMessageFormat.Json, RequestFormat:=WebMessageFormat.Json, BodyStyle:=WebMessageBodyStyle.Bare, UriTemplate:="streamweaver")> _
Function StreamWeaver(sData As Stream) As String
End Interface
And here is the class
Imports System
Imports System.IO
Imports System.Reflection
Imports System.Security.AccessControl
Imports System.Text
Imports Newtonsoft.Json
Public Class RestServiceImpl
Implements IRestServiceImpl
Private filePathOnServer As String = My.Settings.OutputFolder
'Public Function XMLData(id As String) As String Implements IRestServiceImpl.XMLData
' Return "You requested product " & id
'End Function
'Public Function JSONData(id As String) As String Implements IRestServiceImpl.JSONData
' Return "You requested product " & id
'End Function
Public Function Auth(request As Stream) As ResponseData Implements IRestServiceImpl.Auth
Dim streamReader = New StreamReader(request)
Dim requestText As String = streamReader.ReadToEnd()
Dim rData As RequestData = JsonConvert.DeserializeObject(Of RequestData)(requestText)
Dim response = New ResponseData() With { _
.Name = rData.Name, _
.Age = rData.Age, _
.Exp = rData.Exp, _
.Technology = rData.Technology _
}
Dim fileOutput As String = "As of " & DateTime.Now & ", " _
& response.Name.Trim & " is a person who is " _
& response.Age.Trim & " years old, having " _
& response.Exp.Trim & " of experience with " _
& response.Technology.Trim & " technology."
Console.SetError(New StreamWriter("C:\Users\apearson\Documents\Eureka.txt"))
Console.[Error].WriteLine(fileOutput)
Console.[Error].Close()
Dim ctx As WebOperationContext = WebOperationContext.Current
If rData IsNot Nothing Then
ctx.OutgoingResponse.StatusCode = Net.HttpStatusCode.Accepted
Else
ctx.OutgoingResponse.StatusCode = Net.HttpStatusCode.NotAcceptable
End If
Return response
End Function
Public Function StreamWeaver(reqData As Stream) As String Implements IRestServiceImpl.StreamWeaver
StreamWeaver = Nothing
Dim ctx As WebOperationContext = WebOperationContext.Current
If reqData IsNot Nothing Then
ctx.OutgoingResponse.StatusCode = Net.HttpStatusCode.Accepted
Else
ctx.OutgoingResponse.StatusCode = Net.HttpStatusCode.NotAcceptable
End If
Dim streamReader As StreamReader = New StreamReader(reqData)
StreamWeaver = streamReader.ReadToEnd()
Console.SetError(New StreamWriter(filePathOnServer.Trim & "\RestServiceJSONRaw.txt"))
Console.[Error].WriteLine(DateTime.Now & ": " & vbCrLf & StreamWeaver.Trim)
Console.[Error].Close()
Return StreamWeaver
End Function
End Class
If there is anymore information needed, let me know. Again, this is kind of new to me.
I have a form in Access 2010 that allows the user to find an Excel file and map it so that it can easily be accessed from another form. The simplest way to explain it, I think, is with a picture:
The form has this On Load event:
Private Sub Form_Load()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sSQL As String
Dim sPath As String
Set db = CurrentDb
On Error GoTo Error_Handler
sPath = Application.CurrentProject.Path
sSQL = "Select Setting from tblBackendFiles where Code = 'SourceVerification'"
Set rs = db.OpenRecordset(sSQL)
Me.tVerificationPath = Nz(rs!Setting, "")
If Len(Me.tVerificationPath) = 0 Then
Me.tExcelPath = sPath
End If
Me.cmdAcceptPath.SetFocus
rs.Close
GoTo exit_sub
Error_Handler:
MsgBox Err.number & ": " & Err.Description, vbInformation + vbOKOnly, "Error!"
exit_sub:
Set rs = Nothing
Set db = Nothing
End Sub
What I want is to have the current path of the Excel file displayed in the textbox, which is currently unbound. I've looked around online but I'm having a hard time finding how to actually get the path to show up.
What would be the best way to do this? I'd prefer to do it without VBA if at all possible, but I'm not 100% opposed to it.
I have done this many times. You will have to create a form. On that form, place a textbox called "tbFile", another called "tbFileName" (which is invisible) and a button called "bBrowse".
Then, behind your form, put this:
Option Compare Database
Option Explicit
Private Sub bBrowse_Click()
On Error GoTo Err_bBrowse_Click
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
Me.tbHidden.SetFocus
' strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
' & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
' strFilter = "Access Files (*.mdb)" & vbNullChar & "*.mdb*"
strFilter = "All Files (*.*)" & vbNullChar & "*.*"
lngFlags = tscFNPathMustExist Or tscFNFileMustExist Or tscFNHideReadOnly
varFileName = tsGetFileFromUser( _
fOpenFile:=True, _
strFilter:=strFilter, _
rlngflags:=lngFlags, _
strInitialDir:="C:\Windows\", _
strDialogTitle:="Find File (Select The File And Click The Open Button)")
'remove the strInitialDir:="C:\Windows\", _ line if you do not want the Browser to open at a specific location
If IsNull(varFileName) Or varFileName = "" Then
Debug.Print "User pressed 'Cancel'."
Beep
MsgBox "File selection was canceled.", vbInformation
Exit Sub
Else
'Debug.Print varFileName
tbFile = varFileName
End If
Call ParseFileName
Exit_bBrowse_Click:
Exit Sub
Err_bBrowse_Click:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_bBrowse_Click
End Sub
Private Function ParseFileName()
On Error GoTo Err_ParseFileName
Dim sFullName As String
Dim sFilePathOnly As String
Dim sDrive As String
Dim sPath As String
Dim sLocation As String
Dim sFileName As String
sFullName = tbFile.Value
' Find the final "\" in the path.
sPath = sFullName
Do While Right$(sPath, 1) <> "\"
sPath = Left$(sPath, Len(sPath) - 1)
Loop
' Find the Drive.
sDrive = Left$(sFullName, InStr(sFullName, ":") + 1)
'tbDrive = sDrive
' Find the Location.
sLocation = Mid$(sPath, Len(sDrive) - 2)
'tbLocation = sLocation
' Find the Path.
sPath = Mid$(sPath, Len(sDrive) + 1)
'tbPath = sPath
' Find the file name.
sFileName = Mid$(sFullName, Len(sPath) + 4)
tbFileName = sFileName
Exit_ParseFileName:
Exit Function
Err_ParseFileName:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ParseFileName
End Function
Then, create a new Module and paste this into it:
Option Compare Database
Option Explicit
Private Declare Function ts_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean
Private Declare Function ts_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean
Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Private Type tsFileName
lStructSize As Long
hwndOwner As Long
hInstance As Long
strFilter As String
strCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
strFile As String
nMaxFile As Long
strFileTitle As String
nMaxFileTitle As Long
strInitialDir As String
strTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
strDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
' Flag Constants
Public Const tscFNAllowMultiSelect = &H200
Public Const tscFNCreatePrompt = &H2000
Public Const tscFNExplorer = &H80000
Public Const tscFNExtensionDifferent = &H400
Public Const tscFNFileMustExist = &H1000
Public Const tscFNPathMustExist = &H800
Public Const tscFNNoValidate = &H100
Public Const tscFNHelpButton = &H10
Public Const tscFNHideReadOnly = &H4
Public Const tscFNLongNames = &H200000
Public Const tscFNNoLongNames = &H40000
Public Const tscFNNoChangeDir = &H8
Public Const tscFNReadOnly = &H1
Public Const tscFNOverwritePrompt = &H2
Public Const tscFNShareAware = &H4000
Public Const tscFNNoReadOnlyReturn = &H8000
Public Const tscFNNoDereferenceLinks = &H100000
Public Function tsGetFileFromUser( _
Optional ByRef rlngflags As Long = 0&, _
Optional ByVal strInitialDir As String = "", _
Optional ByVal strFilter As String = "All Files (*.*)" & vbNullChar & "*.*", _
Optional ByVal lngFilterIndex As Long = 1, _
Optional ByVal strDefaultExt As String = "", _
Optional ByVal strFileName As String = "", _
Optional ByVal strDialogTitle As String = "", _
Optional ByVal fOpenFile As Boolean = True) As Variant
On Error GoTo tsGetFileFromUser_Err
Dim tsFN As tsFileName
Dim strFileTitle As String
Dim fResult As Boolean
' Allocate string space for the returned strings.
strFileName = Left(strFileName & String(256, 0), 256)
strFileTitle = String(256, 0)
' Set up the data structure before you call the function
With tsFN
.lStructSize = Len(tsFN)
.hwndOwner = Application.hWndAccessApp
.strFilter = strFilter
.nFilterIndex = lngFilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = strDialogTitle
.flags = rlngflags
.strDefExt = strDefaultExt
.strInitialDir = strInitialDir
.hInstance = 0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
.lpfnHook = 0
End With
' Call the function in the windows API
If fOpenFile Then
fResult = ts_apiGetOpenFileName(tsFN)
Else
fResult = ts_apiGetSaveFileName(tsFN)
End If
' If the function call was successful, return the FileName chosen
' by the user. Otherwise return null. Note, the CancelError property
' used by the ActiveX Common Dialog control is not needed. If the
' user presses Cancel, this function will return Null.
If fResult Then
rlngflags = tsFN.flags
tsGetFileFromUser = tsTrimNull(tsFN.strFile)
Else
tsGetFileFromUser = Null
End If
tsGetFileFromUser_End:
On Error GoTo 0
Exit Function
tsGetFileFromUser_Err:
Beep
MsgBox Err.Description, , "Error: " & Err.Number _
& " in function basBrowseFiles.tsGetFileFromUser"
Resume tsGetFileFromUser_End
End Function
' Trim Nulls from a string returned by an API call.
Private Function tsTrimNull(ByVal strItem As String) As String
On Error GoTo tsTrimNull_Err
Dim I As Integer
I = InStr(strItem, vbNullChar)
If I > 0 Then
tsTrimNull = Left(strItem, I - 1)
Else
tsTrimNull = strItem
End If
tsTrimNull_End:
On Error GoTo 0
Exit Function
tsTrimNull_Err:
Beep
MsgBox Err.Description, , "Error: " & Err.Number _
& " in function basBrowseFiles.tsTrimNull"
Resume tsTrimNull_End
End Function
Public Sub tsGetFileFromUserTest()
On Error GoTo tsGetFileFromUserTest_Err
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
' strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
' & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
strFilter = "All Files (*.*)" & vbNullChar & "*.*"
lngFlags = tscFNPathMustExist Or tscFNFileMustExist Or tscFNHideReadOnly
varFileName = tsGetFileFromUser( _
fOpenFile:=True, _
strFilter:=strFilter, _
rlngflags:=lngFlags, _
strDialogTitle:="GetFileFromUser Test (Please choose a file)")
If IsNull(varFileName) Then
Debug.Print "User pressed 'Cancel'."
Else
Debug.Print varFileName
'Forms![Form1]![Text1] = varFileName
End If
If varFileName <> "" Then MsgBox "You selected the '" & varFileName & "' file.", vbInformation
tsGetFileFromUserTest_End:
On Error GoTo 0
Exit Sub
tsGetFileFromUserTest_Err:
Beep
MsgBox Err.Description, , "Error: " & Err.Number _
& " in sub basBrowseFiles.tsGetFileFromUserTest"
Resume tsGetFileFromUserTest_End
End Sub
VOILA! Easy as that. ;o)
I am having a troble parsing JSON using vb.net with Newtonsoft Json library.
My JSON Data is as follows :
{
"Result":"Success",
"UserID":"johns",
"Password":null,
"Locked":"False",
"Comment":"",
"LastLoggedOn":"11/9/2013 9:14:17 PM",
"NumFailedAttempts":"1",
"FirstName":"John",
"LastName":"Smith",
"MessageNum":"UA-000",
"MessageText":"Authorisation successful"
}
My code is as follows :
Dim a As saLoginResponse = JsonConvert.DeserializeObject(Of saLoginResponse)(strJSONEncode)
Response.Write(a.ToString)
Response.Write(a.MessageText)
This does not produce any output.
Any help is appreciated.
Assuming your saLoginResponse class is defined like the following, and your strJSONEncode string contains the JSON data you posted in your question, your code should work fine.
Public Class saLoginResponse
Public Property Result As String
Public Property UserID As String
Public Property Password As String
Public Property Locked As Boolean
Public Property Comment As String
Public Property LastLoggedOn As String
Public Property NumFailedAttempts As String
Public Property FirstName As String
Public Property LastName As String
Public Property MessageNum As String
Public Property MessageText As String
End Class
Demo:
Sub Main()
Dim json As String = _
"{" + _
"""Result"":""Success""," + _
"""UserID"":""johns""," + _
"""Password"":null," + _
"""Locked"":""False""," + _
"""Comment"":""""," + _
"""LastLoggedOn"":""11/9/2013 9:14:17 PM""," + _
"""NumFailedAttempts"":""1""," + _
"""FirstName"":""John""," + _
"""LastName"":""Smith""," + _
"""MessageNum"":""UA-000""," + _
"""MessageText"":""Authorisation successful""" + _
"}"
Dim a As saLoginResponse = JsonConvert.DeserializeObject(Of saLoginResponse)(json)
Debug.WriteLine(a.MessageText + " for " + a.FirstName + " " + a.LastName)
End Sub
Output in debug window:
Authorisation successful for John Smith
i have 2 classes
connect class
Imports MySql.Data
Imports MySql.Data.MySqlClient
Public Class connect
Dim dbCon As MySqlConnection
Dim strQuery As String = ""
Dim SqlCmd As MySqlCommand
Dim DR As MySqlDataReader
Public Function Con2Db() As Boolean
Try
'Prepare connection and query
dbCon = New MySqlConnection("Server=localhost; User Id = root; Pwd = 12345; Database = digitallibrary")
If dbCon.State = ConnectionState.Closed Then
dbCon.Open()
Return True
Else
dbCon.Close()
splash.Label1.Text = "Connection is Close"
Return False
End If
Catch ex As Exception
MsgBox("FAIL")
Return False
End Try
End Function
End Class
And query Class
Imports MySql.Data
Imports MySql.Data.MySqlClient
Public Class query
Dim dbCon As MySqlConnection
Dim strQuery As String = ""
Dim SqlCmd As MySqlCommand
Dim DR As MySqlDataReader
Public Sub insert(ByVal ln As String, ByVal fn As String, ByVal mn As String, ByVal user As String, ByVal email As String, ByVal bdate As String, ByVal jdate As String, ByVal jtime As String, ByVal pwd As String)
Try
strQuery = "INSERT INTO user_tbl(user_ln,user_fn,user_mn,username,user_email,user_bdate, user_jdate, user_jtime)VALUES('" + ln + "','" + fn + "','" + mn + "','" + user + "','" + email + "','" + bdate + "','" + jdate + "','" + jtime + "' );" & _
"INSERT INTO login_tbl(username,password)VALUES('" + user + "','" + pwd + "')"
SqlCmd = New MySqlCommand(strQuery, dbCon)
SqlCmd.ExecuteNonQuery()
dbCon.Close()
Catch ex As Exception
MsgBox("Error " & ex.Message)
End Try
End Sub
End Class
Also A registration form
Public Class registration
Private Sub registration_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim con As New connect
If (con.Con2Db = True) Then
Label13.Text = "Connected To Database"
Else
Label13.Text = "Not Connected To Database"
End If
End Sub
Private Sub submit_btn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles submit_btn.Click
Dim ins As New query
Dim ln As String = ln_txt.Text
Dim fn As String = fn_txt.Text
Dim mn As String = mn_txt.Text
Dim user As String = user_txt.Text
Dim pwd As String = pwd_txt.Text
Dim cpwd As String = cpwd_txt.Text
Dim email As String = email_txt.Text
Dim year As String = year_cbx.Text
Dim month As String = month_cbx.Text
Dim day As String = day_cbx.Text
Dim bdate As String = year + "-" + month + "-" + day
Dim jdate As String = Format(Date.Now, "yyyy-MM-dd")
Dim jtime As String = Format(Date.Now, "HH:mm:ss")
ins.insert(ln, fn, mn, user, email, bdate, jdate, jtime, pwd)
End Sub
End Class
Everything is okay and it is saying on the label that the connection is successful but when I run the code it gives an error
Error Connection must be valid and open
I don't understand why the connection is said to be closed when the function is returning true...
If people are wondering why separate it to each classes it's because i'm trying to code cleanly(i hope and think) and i want to be more flexible in programming
The problem is that your 'connect' class has no relationship to your 'insert' function, meaning you are creating a new connection in each one. What you would have to do is create a Shared connection to your database that your connect class would manage, and your 'insert' function would use the existing connection.
There is nothing wrong with separating code into various sections, but you must know how to do it efficiently. I typically keep connection management and query execution in the same sections to avoid passing around extra objects. Here is what I would do:
Imports MySql.Data
Imports MySql.Data.MySqlClient
Public Class QueryManager
Dim dbCon As MySqlConnection
Public Sub ManageConnection(ByVal CloseConnection As Boolean)
Try
'Prepare connection and query'
dbCon = New MySqlConnection("Server=localhost; User Id = root; Pwd = 12345; Database = digitallibrary")
If CloseConnection = False Then
If dbCon.State = ConnectionState.Closed Then _
dbCon.Open()
Else
dbCon.Close()
End If
Catch ex As Exception
MsgBox("FAIL")
End Try
End Sub
Public Sub Insert(ByVal ln As String, ByVal fn As String, ByVal mn As String, ByVal user As String, ByVal email As String, ByVal bdate As String, ByVal jdate As String, ByVal jtime As String, ByVal pwd As String)
Try
ManageConnection(True) 'Open connection'
Dim strQuery As String = "INSERT INTO user_tbl(user_ln,user_fn,user_mn,username,user_email,user_bdate, user_jdate, user_jtime)" & _
"VALUES('" + ln + "','" + fn + "','" + mn + "','" + user + "','" + email + "','" + bdate + "','" + jdate + "','" + jtime + "' );" & _
"INSERT INTO login_tbl(username,password)VALUES('" + user + "','" + pwd + "')"
Dim SqlCmd As New MySqlCommand(strQuery, dbCon)
SqlCmd.ExecuteNonQuery()
ManageConnection(False) 'Close connection'
Catch ex As Exception
MsgBox("Error " & ex.Message)
End Try
End Sub
End Class
You would also no longer require the 'registration_Load' sub since the connection will only be opened while it's being used. If you wanted to create one shared connection and persist it through the entire application, you could adjust the functions to reflect your needs.