|
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 : mailto:waty.thierry@vbdiamond.com - 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 - http://www.vbdiamond.com
' * E-Mail : mailto:waty.thierry@vbdiamond.com - 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
|