Bug in Custom properties and how to fix it

Message Topic Search Topic Options Post Reply Create New Topic Printable Version Translate Topic

   Hi

I use a lot Custom properties to store informations for the rest of the application.

Here is a sample of my custom properties :
<Calendar CompactMode="1">
<CustomProperties>
<CustomProperty Name="taskdone" Value="0" VariantType="8"/>
<CustomProperty Name="lightbody" Value="Il faut v�rifier l'�tat de la toiture" VariantType="8"/>
</CustomProperties>
</Calendar>

Notice the custom property  Name="lightbody"  , there are some 'French chars', and using it, the calendar can't reload them after.

So to fix it, you need to encode the text before storing in the custom property, then decode it.

I think you could easilly fix it in the OCX.

In the meantime, here are the 2 functions for the workarround :

Public Function HTMLEncodeEx(ByVal Text As String, Optional ByVal vfHREFEncode _
   As Boolean = False, Optional ByVal vstrAmpChar As String = "&") As String
   ' #VBIDEUtils#************************************************************
   ' * E-Mail           : waty.thierry@vbdiamond.com
   ' * Date             : 06/27/2008
   ' * Time             : 14:52
   ' * Module Name      : Lib_Module
   ' * Module Filename  : Lib.bas
   ' * Procedure Name   : HTMLEncodeEx
   ' * Purpose          :
   ' * Parameters       :
   ' *                    ByVal Text As String
   ' *                    Optional ByVal vfHREFEncode As Boolean = False
   ' *                    Optional ByVal vstrAmpChar As String = "&"
   ' * Purpose          :
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' * Example          :
   ' *
   ' * See Also         :
   ' *
   ' * History          :
   ' *
   ' *
   ' **********************************************************************
   ' #VBIDEUtilsERROR#
   On Error GoTo ERROR_HTMLEncodeEx
   Dim aTokens()        As Byte
   Dim nTotal           As Long
   Dim nCount           As Long
   Dim aReturn()        As String
   Dim sReturn          As String
   sReturn = Text
   If Trim$(sReturn) <> "" Then
      ' *** Convert to an array
      aTokens = StrConv(Text, vbFromUnicode)
      nTotal = UBound(aTokens)
      ' *** Dimension enough space for the return
      ReDim aReturn(nTotal)
      For nCount = 0 To nTotal
         Select Case aTokens(nCount)
            Case 32
               If vfHREFEncode Then
                  aReturn(nCount) = "%20"
               Else
                  aReturn(nCount) = vstrAmpChar & "nbsp;"
               End If
            Case 34
               aReturn(nCount) = vstrAmpChar & "quot;"
            Case 38
               aReturn(nCount) = vstrAmpChar & "amp;"
            Case 60
               aReturn(nCount) = vstrAmpChar & "lt;"
            Case 62
               aReturn(nCount) = vstrAmpChar & "gt;"
            Case 32 To 127
               ' don't touch alphanumeric chars
               aReturn(nCount) = Chr$(aTokens(nCount))
            Case Else
               aReturn(nCount) = vstrAmpChar & "#" & CStr(aTokens _
                  (nCount)) & ";"
         End Select
      Next
      sReturn = Join(aReturn, "")
      Erase aReturn
   End If
   ' *** Join the return tokens together
   HTMLEncodeEx = sReturn
EXIT_HTMLEncodeEx:
   On Error Resume Next
   Exit Function
   ' #VBIDEUtilsERROR#
ERROR_HTMLEncodeEx:
   Resume EXIT_HTMLEncodeEx
End Function
Public Function HTMLDecodeEx(ByVal Text As String, Optional ByVal vfHREFDecode _
   As Boolean = False, Optional ByVal vstrAmpChar As String = "&") As String
   ' #VBIDEUtils#************************************************************
   ' * Author           : Waty Thierry
   ' * Web Site         : http://www.vbdiamond.com
   ' * E-Mail           : waty.thierry@vbdiamond.com
   ' * Date             : 12/12/2007
   ' * Time             : 09:24
   ' * Module Name      : Lib_Module
   ' * Module Filename  : Lib.bas
   ' * Procedure Name   : HTMLDecodeEx
   ' * Purpose          :
   ' * Parameters       :
   ' *                    ByVal Text As String
   ' *                    Optional ByVal vfHREFDecode As Boolean = False
   ' *                    Optional ByVal vstrAmpChar As String = "&"
   ' * Purpose          :
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' * Example          :
   ' *
   ' * See Also         :
   ' *
   ' * History          :
   ' *
   ' *
   ' **********************************************************************
   ' #VBIDEUtilsERROR#
   On Error GoTo ERROR_HTMLDecodeEx
   Dim sTokens()        As String
   Dim nTotal           As Long
   Dim nCount           As Long
   Dim sToken           As String
   Dim sCode            As String
   Dim nPos             As Long
   Dim aReturn()        As String
   Dim sReturn          As String
   sReturn = Text
   If Trim$(sReturn) <> "" Then
      ' tokenize the text
      sTokens = Split(Text, vstrAmpChar, -1, vbTextCompare)
      nTotal = UBound(sTokens)
      ' create enough space for the return
      ReDim aReturn(nTotal)
      For nCount = 0 To nTotal
         ' look for the end of the token
         sToken = sTokens(nCount)
         nPos = InStr(1, sToken, ";", vbTextCompare)
         If (nPos = 0) Then
            aReturn(nCount) = sToken
         Else
            sCode = Mid$(sToken, 1, nPos)
            Select Case sCode
               Case "nbsp;"
                  aReturn(nCount) = " " & Mid$(sToken, nPos + 1)
               Case "quot;"
                  aReturn(nCount) = """" & Mid$(sToken, nPos + 1)
               Case "amp;"
                  aReturn(nCount) = vstrAmpChar & Mid$(sToken, _
                     nPos + 1)
               Case "lt;"
                  aReturn(nCount) = "<" & Mid$(sToken, nPos + 1)
               Case "gt;"
                  aReturn(nCount) = ">" & Mid$(sToken, nPos + 1)
               Case Else
                  ' see if it's
                  If Left$(sToken, 1) = "#" Then
                     aReturn(nCount) = Chr$(Mid$(sToken, 2, _
                        nPos - 2)) & Mid$(sToken, nPos + 1)
                  Else
                     aReturn(nCount) = sToken
                  End If
            End Select
         End If
      Next ' nCount
      Erase sTokens
      sReturn = Join(aReturn, "")
      Erase aReturn
   End If
   HTMLDecodeEx = sReturn
EXIT_HTMLDecodeEx:
   On Error Resume Next
   Exit Function
   ' #VBIDEUtilsERROR#
ERROR_HTMLDecodeEx:
   Resume EXIT_HTMLDecodeEx
End Function

Author	Message Topic Search Topic Options Post Reply Create New Topic Printable Version Translate Topic
immoassist Members Profile Send Private Message Find Members Posts Add to Buddy List Groupie Joined: 19 June 2008 Status: Offline Points: 20	Post Options Post Reply Quote immoassist Report Post Thanks(0) Quote Reply Topic: Bug in Custom properties and how to fix it Posted: 27 June 2008 at 9:08am
	Hi I use a lot Custom properties to store informations for the rest of the application. Here is a sample of my custom properties : <Calendar CompactMode="1"> <CustomProperties> <CustomProperty Name="taskdone" Value="0" VariantType="8"/> <CustomProperty Name="lightbody" Value="Il faut v�rifier l'�tat de la toiture" VariantType="8"/> </CustomProperties> </Calendar> Notice the custom property Name="lightbody" , there are some 'French chars', and using it, the calendar can't reload them after. So to fix it, you need to encode the text before storing in the custom property, then decode it. I think you could easilly fix it in the OCX. In the meantime, here are the 2 functions for the workarround : Public Function HTMLEncodeEx(ByVal Text As String, Optional ByVal vfHREFEncode _ As Boolean = False, Optional ByVal vstrAmpChar As String = "&") As String ' #VBIDEUtils#************************************************************ ' * E-Mail : waty.thierry@vbdiamond.com ' * Date : 06/27/2008 ' * Time : 14:52 ' * Module Name : Lib_Module ' * Module Filename : Lib.bas ' * Procedure Name : HTMLEncodeEx ' * Purpose : ' * Parameters : ' * ByVal Text As String ' * Optional ByVal vfHREFEncode As Boolean = False ' * Optional ByVal vstrAmpChar As String = "&" ' * Purpose : ' ********************************************************************** ' * Comments : ' * ' * ' * Example : ' * ' * See Also : ' * ' * History : ' * ' * ' ******************************************************************** ' #VBIDEUtilsERROR# On Error GoTo ERROR_HTMLEncodeEx Dim aTokens() As Byte Dim nTotal As Long Dim nCount As Long Dim aReturn() As String Dim sReturn As String sReturn = Text If Trim$(sReturn) <> "" Then ' * Convert to an array aTokens = StrConv(Text, vbFromUnicode) nTotal = UBound(aTokens) ' * Dimension enough space for the return ReDim aReturn(nTotal) For nCount = 0 To nTotal Select Case aTokens(nCount) Case 32 If vfHREFEncode Then aReturn(nCount) = "%20" Else aReturn(nCount) = vstrAmpChar & "nbsp;" End If Case 34 aReturn(nCount) = vstrAmpChar & "quot;" Case 38 aReturn(nCount) = vstrAmpChar & "amp;" Case 60 aReturn(nCount) = vstrAmpChar & "lt;" Case 62 aReturn(nCount) = vstrAmpChar & "gt;" Case 32 To 127 ' don't touch alphanumeric chars aReturn(nCount) = Chr$(aTokens(nCount)) Case Else aReturn(nCount) = vstrAmpChar & "#" & CStr(aTokens _ (nCount)) & ";" End Select Next sReturn = Join(aReturn, "") Erase aReturn End If ' * Join the return tokens together HTMLEncodeEx = sReturn EXIT_HTMLEncodeEx: On Error Resume Next Exit Function ' #VBIDEUtilsERROR# ERROR_HTMLEncodeEx: Resume EXIT_HTMLEncodeEx End Function Public Function HTMLDecodeEx(ByVal Text As String, Optional ByVal vfHREFDecode _ As Boolean = False, Optional ByVal vstrAmpChar As String = "&") As String ' #VBIDEUtils#************************************************************ ' * Author : Waty Thierry ' * Web Site : http://www.vbdiamond.com ' * E-Mail : waty.thierry@vbdiamond.com ' * Date : 12/12/2007 ' * Time : 09:24 ' * Module Name : Lib_Module ' * Module Filename : Lib.bas ' * Procedure Name : HTMLDecodeEx ' * Purpose : ' * Parameters : ' * ByVal Text As String ' * Optional ByVal vfHREFDecode As Boolean = False ' * Optional ByVal vstrAmpChar As String = "&" ' * Purpose : ' ********************************************************************** ' * Comments : ' * ' * ' * Example : ' * ' * See Also : ' * ' * History : ' * ' * ' ********************************************************************** ' #VBIDEUtilsERROR# On Error GoTo ERROR_HTMLDecodeEx Dim sTokens() As String Dim nTotal As Long Dim nCount As Long Dim sToken As String Dim sCode As String Dim nPos As Long Dim aReturn() As String Dim sReturn As String sReturn = Text If Trim$(sReturn) <> "" Then ' tokenize the text sTokens = Split(Text, vstrAmpChar, -1, vbTextCompare) nTotal = UBound(sTokens) ' create enough space for the return ReDim aReturn(nTotal) For nCount = 0 To nTotal ' look for the end of the token sToken = sTokens(nCount) nPos = InStr(1, sToken, ";", vbTextCompare) If (nPos = 0) Then aReturn(nCount) = sToken Else sCode = Mid$(sToken, 1, nPos) Select Case sCode Case "nbsp;" aReturn(nCount) = " " & Mid$(sToken, nPos + 1) Case "quot;" aReturn(nCount) = """" & Mid$(sToken, nPos + 1) Case "amp;" aReturn(nCount) = vstrAmpChar & Mid$(sToken, _ nPos + 1) Case "lt;" aReturn(nCount) = "<" & Mid$(sToken, nPos + 1) Case "gt;" aReturn(nCount) = ">" & Mid$(sToken, nPos + 1) Case Else ' see if it's If Left$(sToken, 1) = "#" Then aReturn(nCount) = Chr$(Mid$(sToken, 2, _ nPos - 2)) & Mid$(sToken, nPos + 1) Else aReturn(nCount) = sToken End If End Select End If Next ' nCount Erase sTokens sReturn = Join(aReturn, "") Erase aReturn End If HTMLDecodeEx = sReturn EXIT_HTMLDecodeEx: On Error Resume Next Exit Function ' #VBIDEUtilsERROR# ERROR_HTMLDecodeEx: Resume EXIT_HTMLDecodeEx End Function
	Come and try our application : http://www.immoassist.com

sserge Members Profile Send Private Message Find Members Posts Add to Buddy List Moderator Group Joined: 01 December 2004 Status: Offline Points: 1297	Post Options Post Reply Quote sserge Report Post Thanks(0) Quote Reply Posted: 10 July 2008 at 5:28pm
	Hi, Do you use Unicode version of the Calendar OCX? Also, which DataProvider do you use? Regular Memory DP with XML serialization? Or something else? -- WBR, Serge

immoassist Members Profile Send Private Message Find Members Posts Add to Buddy List Groupie Joined: 19 June 2008 Status: Offline Points: 20	Post Options Post Reply Quote immoassist Report Post Thanks(0) Quote Reply Posted: 11 July 2008 at 3:56am
	Hello Serge, I don't use the Unicode version I think. So I fixed it my way I will try the unicode version Thierry
	Come and try our application : http://www.immoassist.com