I'm generating a JSON file using VB6 and one of my strings has a double quote in between. I have used the double quote escape character but now the escape character is also printing in the string, even though the JSON is successful when I put the file in JSON formatter.
The string is:
"productName":"16X12 / 46/4X46 63" DRILL"
This string have a double quote in it when I use escape character and check it the JSON formatter , the JSON is successful but product name string becomes
"productName":"16X12 / 46/4X46 63\"DRILL"
as u can see the escape character is printing in the string before the double quote, How can I escape the double quote without printing the escape character.
I have tried with \ and \\ but every \ get prints.
You need a proper JSON string escaping implementation, e.g. try this
Private Function JsonEscape(sText As String) As String
Const STR_CODES As String = "\u0000|\u0001|\u0002|\u0003|\u0004|\u0005|\u0006|\u0007|\b|\t|\n|\u000B|\f|\r|\u000E|\u000F|\u0010|\u0011|\u0012|\u0013|\u0014|\u0015|\u0016|\u0017|\u0018|\u0019|\u001A|\u001B|\u001C|\u001D|\u001E|\u001F"
Static vTranscode As Variant
Dim lIdx As Long
Dim lAsc As Long
If IsEmpty(vTranscode) Then
vTranscode = Split(STR_CODES, "|")
End If
For lIdx = 1 To Len(sText)
lAsc = AscW(Mid$(sText, lIdx, 1))
If lAsc = 92 Or lAsc = 34 Then '--- \ and "
JsonEscape = JsonEscape & "\" & ChrW$(lAsc)
ElseIf lAsc >= 32 And lAsc < 256 Then
JsonEscape = JsonEscape & ChrW$(lAsc)
ElseIf lAsc >= 0 And lAsc < 32 Then
JsonEscape = JsonEscape & vTranscode(lAsc)
ElseIf Asc(Mid$(sText, lIdx, 1)) <> 63 Or Mid$(sText, lIdx, 1) = "?" Then '--- ?
JsonEscape = JsonEscape & ChrW$(AscW(Mid$(sText, lIdx, 1)))
Else
JsonEscape = JsonEscape & "\u" & Right$("0000" & Hex$(lAsc), 4)
End If
Next
End Function
This takes care of " and \ in strings as well as vbCrLf and other special symbols (charcode < 32). This handles unicode characters too (charcode > 256).
Btw, you'll have to escape all user-supplied strings (either in keys or values) to prevent producing invalid JSON in all cases.
Related
I am working with an old classic asp/vbscript app that has a json class.
I have a string literal: asdf\\nsedfgs e.g. thats not escaped json or anything. its literally those characters.
So, to use that value in a JSON string, it should be something like this, right?
{"somedesc":"asdf\\\\nsedfgs"}
...with the two backslash characters escaped.
However, on the way out of JSON and back to string literal, we'd do something like this (in this order)
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))
...but for the string above, this sequence of replace() gives us the incorrect decoded value:
result (note the newline, as the 4 \ got replaced to two, then the \n got replaced to a newline)
asdf\
sedfgs
So questions:
how does one encode and decode a literal asdf\\nsedfgs to and from json correctly?
is that decode logic correct? in the correct order? It seems not, because how could it distinguish between a literal \n vs an escaped chr(13)?
is there something else I am missing here?
The important part is isolating the escaped backslashes from the rest of the string so that they don't interfere with escape sequences- You can split the string, reattach the missing parts later:
Const ENCODE = FALSE
Const DECODE = TRUE
val = "asdf\\\\nsedfgs"
val = JSON(val, DECODE)
MsgBox val
'Swap replacement values & dividers + concatenation characters
val = JSON(val, ENCODE)
MsgBox val
Function JSON(ByVal str, ByVal mode)
Dim key, val
Set d = CreateObject("Scripting.Dictionary")
d.Add "\/", "/"
d.Add "\b", Chr(8)
d.Add "\f", Chr(12)
d.Add "\n", Chr(10)
d.Add "\r", Chr(13)
d.Add "\t", Chr(9)
If mode Then
d.Add "\""", """"
d.Add "\\", "\"
div = "\\"
cat = "\"
key = d.Keys
val = d.Items
Else
d.Add "\\", "\"
d.Add "\""", """"
div = "\"
cat = "\\"
key = d.Items
val = d.Keys
End If
arr = Split(str, div)
For i = 0 To UBound(arr)
For j = 0 To UBound(key)
arr(i) = Replace(arr(i), key(j), val(j))
Next
output = output & arr(i)
If i <> UBound(arr) Then output = output & cat
Next
d.RemoveAll
JSON = output
End Function
I've come up with a bit of a weird situation. I have a string that was entered into a form from a webpage. I noticed that the string wasn't behaving as expected when I was trying to apply a filter.
The crux of the matter is depending on how I view the string it appears differently.
Form View - "523548"
Datasheet View - " 523548"
Raw Sql - " 523548"
Actually, when I view the datasheet value it appears as "523548 " but copies as " 523548".
Asc(Left(string),1) tells me the first character is Chr9 (Tab Key)
I am really stuck to find out why this is happening or more importantly, what I can do to correct it.
Thanks!
Dave.
I'd use the Trim() function here. Although the link is for Excel, it's the same syntax in Access.
Use this function when you write the value to the table, and you can use this function to clean up your current data as well. This should remove phantom tabs, as well as spaces.
Thanks for the tips. I found this function and added in a couple of items to suit my needs.
' Strip Illegal Characters
' http://www.utteraccess.com/wiki/index.php/Strip_Illegal_Characters
' Code courtesy of UtterAccess Wiki
' Licensed under Creative Commons License
' http://creativecommons.org/licenses/by-sa/3.0/
'
' You are free to use this code in any application,
' provided this notice is left unchanged.
'
' rev date brief descripton
' 1.0 2010-10-23 Writing files to disk that contain illegal file characters can cause sometimes obscure error message(s)
'
Public Function fStripIllegal(strCheck As String, Optional strReplaceWith As String = "") As String
On Error GoTo StripIllErr
'illegal file name characters included in default string are ? [ ] / \ = + < > :; * " , '
Dim intI As Integer
Dim intPassedString As Integer
Dim intCheckString As Integer
Dim strChar As String
Dim strIllegalChars As String
Dim intReplaceLen As Integer
If IsNull(strCheck) Then Exit Function
strIllegalChars = "?[]/\=+<>:;,*" & Chr(34) & Chr(39) & Chr(32) & Chr(9) 'add/remove characters you need removed to this string
intPassedString = Len(strCheck)
intCheckString = Len(strIllegalChars)
intReplaceLen = Len(strReplaceWith)
If intReplaceLen > 0 Then 'a character has been entered to use as the replacement character
If intReplaceLen = 1 Then 'check the character itself isn't an illegal character
If InStr(strIllegalChars, strReplaceWith) > 0 Then
MsgBox "You can't replace an illegal character with another illegal character", _
vbOKOnly + vbExclamation, "Invalid Character"
fStripIllegal = strCheck
Exit Function
End If
Else 'only one replacement character allowed
MsgBox "Only one character is allowed as a replacement character", _
vbOKOnly + vbExclamation, "Invalid Replacement String"
fStripIllegal = strCheck
Exit Function
End If
End If
If intPassedString < intCheckString Then
For intI = 1 To intCheckString
strChar = Mid(strIllegalChars, intI, 1)
If InStr(strCheck, strChar) > 0 Then
strCheck = Replace(strCheck, strChar, strReplaceWith)
End If
Next intI
Else
For intI = 1 To intPassedString
strChar = Mid(strIllegalChars, intI, 1)
If InStr(strCheck, strChar) > 0 Then
strCheck = Replace(strCheck, strChar, strReplaceWith)
End If
Next intI
End If
fStripIllegal = Trim(strCheck)
StripIllErrExit:
Exit Function
StripIllErr:
MsgBox "The following error occured: " & err.Number & vbCrLf _
& err.Description, vbOKOnly + vbExclamation, "Unexpected Error"
fStripIllegal = strCheck
Resume StripIllErrExit
End Function
Well, adjust your routine to not include the tab for new entries.
The old entries you can adjust with Replace:
NewValue = Replace([OldValue], Chr(9), "")
I have a search form I creating in access with a code to search for keywords and then create a table with the results:
Like"*"&[FORMS]![Search_Form]![KW_Text]&"*"
WHich basically tells it to read the keyword i type in and pull up any matching results.
I would like to be able to type in multiple words, in the table containing all the data I have multiple keywords for each bit of data all separated by comas. So if I type in Manager it returns all results with the word Manager in it, I would like to be able to type in Manager, Supervisor and have it return all results for manager and all results for supervisor.
You can use the SPLIT() function in VBA to split the search string into an array, then For Each through the array to build up a search/filter string such as
(thing LIKE "*Manager*") OR (thing LIKE "*Supervisor*")
I use this code. It create a OR between your sting separated by a space. I put this processed string in an querydefs
Function CreateOr(MyCriteria As String, MyField As String) As String
Dim MyChar As String
Dim MyUniqueCriteria As String
Dim MyFinalCriteria As String
Dim I, j As Integer
j = 0
For I = 1 To Len(MyCriteria)
MyChar = Mid(MyCriteria, I, 1)
If MyChar = " " Then
If j = 0 Then
MyFinalCriteria = MyFinalCriteria & MyField & "=" & MyUniqueCriteria
Else
MyFinalCriteria = MyFinalCriteria & " or " & MyField & "=" & MyUniqueCriteria
End If
MyUniqueCriteria = ""
j = j + 1
Else
MyUniqueCriteria = MyUniqueCriteria & MyChar
End If
Next
CreateOr = MyFinalCriteria
End Function
Hope it help you
i have the following function on vbscript:
Function HTMLEncode(sText)
Dim regEx
Dim matches
Dim match
sText = Replace(sText, Chr(34), """)
sText = Replace(sText, Chr(60) , "<")
sText = Replace(sText, Chr(62) , ">")
sText = Replace(sText, Chr(38), "&")
sText = Replace(sText, Chr(32), " ")
Set regEx= New RegExp
With regEx
.Pattern = "&#(\d+);" 'Match html unicode escapes
.Global = True
End With
Set matches = regEx.Execute(sText)
'Iterate over matches
For Each match in matches
'For each unicode match, replace the whole match, with the ChrW of the digits.
sText = Replace(sText, ChrW(match.SubMatches(0)), match.Value)
Next
HTMLEncode = sText
End Function
However, this doesn't encode space. when i type >, <, ", & they get encoded. but when i type space it doesnt get encoded. It does, but its encoded when I enter multiple spaces, for example:
"thishas4spaces word"
the first three get encoded except the last space. so it goes like this:
"thishas4spaces word"
Any idea why? help please. language is vbscript
I need to remove line breaks from the beginning of a memo type records. I dont want to use the replace function as it would remove all line breaks from the record which is not desired. Its only the line breaks at the beginning of the field that I am interested in removing.
Furthermore, the my records do not always begin with a line break so I cant really use text positioning, the solution would be to look for line break at the beginning instead of always expecting it at the beginning.
If Len(string) > 0 Then
Do While Left(string,1)= chr(13) Or Left(string,1)= chr(10) or Left(string,1) = " "
string = Right(string, len(string)-1)
Loop
End If
This will check to make sure the string isn't empty, then runs a simple loop to remove the left-most character as long as it is either a CR (chr(13)), LF (chr(10)), or a space (" ").
Once the loop hits the first character that doesn't match the criteria, it stops and you have the desired result of trimming all extra CR, LF, and space characters only from the beginning of the string.
Since it's relatively short, I just put it in the event procedure where needed, you could also modify it to be a public function in a module if you see fit.
Replace does not replace all occurences when you use the count argument: http://office.microsoft.com/en-us/access/HA012288981033.aspx
You can test it like so:
s1 = vbCrLf & "abc"
s2 = "ab" & vbCrLf & "c"
MsgBox "---" & IIf(Left(s1, 2) = vbCrLf, Replace(s1, vbCrLf, "", , 1), s1)
MsgBox "---" & IIf(Left(s2, 2) = vbCrLf, Replace(s2, vbCrLf, "", , 1), s2)
Improving upon what SBinVA wrote
The following code does not need the if statement and it is easy to expand to more character (space, tabs, etc.).
(It also assumes line breaks can originate from a file that can comes from other systems, so vbCr and vbLf are used separately, which takes care of all scenarios.)
Public Function trimCrOrLf(ByVal s As String) As String
Dim firstChar As String
firstChar = Left(s, 1)
Do While InStr(vbCr & vbLf, firstChar) > 0
s = Mid(s, 2)
firstChar = Left(s, 1)
Loop
trimCrOrLf = s
End Function
Consider a SQL UPDATE statement to discard only those CRLF at the beginning of each memo field.
UPDATE MyTable SET MyTable.memo_field = Mid([memo_field],3)
WHERE (((MyTable.memo_field) Like Chr(13) & Chr(10) & "*"));
Private Sub TestLineFeed()
Dim strString$, strTestChar, booStartsWith_CR As Boolean
strString = Chr$(13) & "some text"
strTestChar = "2"
'strTestChar = Chr$(13) ''This is a CR.
booStartsWith_CR = (Left(strString, 1) = strTestChar)
Debug.Print "-----"
Debug.Print "Raw: " & strString
Debug.Print booStartsWith_CR
If booStartsWith_CR Then
strString = Mid(strString, 2, 100)
End If
Debug.Print "-----"
Debug.Print "New: " & strString
End Sub
Note alternatives for strTestChar so you can see the action. You should notice "-----" in your Immediate Window is followed by a CR, thus a blank line; and this can be removed. Mid(strString, 2, 100) will need some tweaking, but the idea is to copy over your memo string without the first character.
I would use a function like this. It's fairly straight-forward and easily adapted to other circumstances. For example, to remove leading spaces too, add another test to the if (c = vbCr) line.
Function LTrimCRLF(s As String) As String
Dim index As Integer, start As Integer, strLen As Integer
Dim c As String
strLen = Len(s)
index = 1
start = -1
Do While (index <= strLen) And (start = -1)
c = Mid(s, index, 1)
If (c = vbCr) Or (c = vbLf) Then
index = index + 1
Else
start = index
End If
Loop
If start = -1 Then
LTrimCRLF = ""
Else
LTrimCRLF = Mid(s, start)
End If
End Function
Here's a test routine:
Sub TestLTrimCRLF()
Dim withWS As String, noWS As String, blank As String, onlyWS As String
withWS = vbCrLf & " this string has leading white space"
noWS = "this string has no leading white space"
onlyWS = vbCrLf & " " & vbCrLf & " "
blank = ""
Say "with WS: {" & LTrimCRLF(withWS) & "}"
Say "no WS: {" & LTrimCRLF(noWS) & "}"
Say "only WS: {" & LTrimCRLF(onlyWS) & "}"
Say "blank: {" & LTrimCRLF(blank) & "}"
End Sub
BTW, I tried looking at your sample data, but it says the document is not available. Maybe you need to make it public or something?
My contribution to VBA trimwhitespace() function, loop finds for first non-whitespace index, splits a string, then same thing for trailing whitespaces. Left+Right functions are run only once. If you need just leftTrim or rightTrim it's easy to introduce new arguments or separate functions.
Function trimWhitespace(str As String) As String
Dim idx As Long
Dim ch As String
' LeftTrim
If Len(str) > 0 Then
idx = 1
ch = Mid(str, idx, 1)
Do While ch = Chr(13) Or ch = Chr(10) Or ch = " "
idx = idx + 1
ch = Mid(str, idx, 1)
Loop
If (idx > 1) Then str = Right(str, Len(str) - idx)
End If
' RightTrim
idx = Len(str)
If idx > 0 Then
ch = Mid(str, idx, 1)
Do While ch = Chr(13) Or ch = Chr(10) Or ch = " "
idx = idx - 1
ch = Mid(str, idx, 1)
Loop
If (idx < Len(str)) Then str = Left(str, idx)
End If
trimWhitespace = str
End Function
This will trim all leading and trailing spaces, carriage returns, tabs, and other non-printable characters.
Public Function TrimSpecial(InputString As Variant) As String
' This will trim leading/trailing spaces and non-printable characters from the passed string.
Dim i As Integer
Dim str As String
On Error GoTo ErrorHandler
str = InputString
For i = 1 To Len(str)
If Asc(Mid(str, i, 1)) > 32 And Asc(Mid(str, i, 1)) < 127 Then
' Valid character found. Truncate leading characters before this.
str = Mid(str, i)
Exit For
End If
Next i
For i = Len(str) To 1 Step -1
If Asc(Mid(str, i, 1)) > 32 And Asc(Mid(str, i, 1)) < 127 Then
' Valid character found. Truncate trailing characters after this.
str = Mid(str, 1, i)
Exit For
End If
Next i
TrimSpecial = str
Exit_Function:
Exit Function
ErrorHandler:
MsgBox "Error #" & Err.Number & " - " & Err.Description & vbCrLf & "in procedure TrimSpecial"
GoTo Exit_Function
Resume Next
Resume
End Function
You can use this routine to test it:
Public Sub Test_TrimSpecial()
' Run this to test the TrimSpecial function.
Dim x As String
x = vbCrLf & " " & vbTab & " ab cd" & vbCrLf & vbTab & " xyz " & vbCr & vbCrLf
Debug.Print "-----"
Debug.Print ">" & x & "<"
Debug.Print "-----"
Debug.Print ">" & TrimSpecial(x) & "<"
Debug.Print "-----"
End Sub
Like "*" & Chr(13) & Chr(10)
(Access used carriage return + line feed, characters 13 and 10, for a new line).
To remove the carriage return/line feed, change the query to an update query and enter the following in the Update to line:
Replace([FieldName], Chr(13) & Chr(10), "")
or
Replace([FieldName], Chr(10),"")
Replace([FieldName], Chr(13),"")