Accueil > > > SÉRIALISER / DÉSÉRIALISER DES VARIABLES EN ASP
SÉRIALISER / DÉSÉRIALISER DES VARIABLES EN ASP
Information sur la source
Description
Permet la sérialisation / désérialisation de scalaires, tableaux et dictionnaires. Utile pour stocker en base de données des variables pour pouvoir les "reconstruire" plus tard. Exemple l'objet session.
Source
- Option Explicit
-
- ' ***********
- ' * Session *
- ' ***********
-
- Function serializeSession()
- serializeSession = serializeIVariantDictionary(Session.Contents)
- End Function
-
- sub unserializeSession(str)
- Dim dict
- Dim itemKey
-
- unserializeDictionary str, dict
- For Each itemKey in dict.keys
- If IsObject(dict(itemKey)) Then
- Set Session(itemKey) = dict(itemKey)
- Else
- Session(itemKey) = dict(itemKey)
- End if
- Next
- End sub
-
- ' ******************************
- ' * Fonctions de sérialisation *
- ' ******************************
-
- Function serializeVar(var)
- If IsObject(var) Then
- serializeVar = serializeObject(var)
- ElseIf IsArray(var) Then
- serializeVar = serializeArray(var)
- Else
- serializeVar = serializeScalaire(var)
- End If
- End Function
-
- Function serializeScalaire(scalaire)
- Select Case TypeName(scalaire)
- Case "Empty"
- serializeScalaire = serializeEmpty
- Case "Null"
- serializeScalaire = serializeNull
- Case "Long"
- serializeScalaire = serializeLong(scalaire)
- Case "Integer"
- serializeScalaire = serializeInteger(scalaire)
- case "Double"
- serializeScalaire = serializeFloat(scalaire)
- Case "Boolean"
- serializeScalaire = serializeBoolean(scalaire)
- Case "Date"
- serializeScalaire = serializeDate(scalaire)
- Case Else
- serializeScalaire = serializeString(scalaire)
- End Select
- End Function
-
- Function serializeArray(arr)
- Dim buffer : buffer = ""
- Dim size : size = 0
- Dim lbnd
- Dim ubnd
- Dim i
-
- On Error Resume Next
- size = UBound(arr) + 1
-
- buffer = "a:" & size & ":"
- For i = 0 To size - 1
- If i > lbnd Then buffer = buffer & ";"
- buffer = buffer & serializeVar(i) & ";" & serializeVar(arr(i))
- Next
-
- serializeArray = buffer
- End Function
-
- Function serializeObject(obj)
- Select Case TypeName(obj)
- Case "Dictionary"
- serializeObject = serializeDictionary(obj)
- Case "IRequestDictionary"
- serializeObject = serializeIRequestDictionary(obj)
- Case "IStringList"
- serializeObject = serializeIStringList(obj)
- End Select
- End Function
-
- Function serializeDictionary(dict)
- Dim buffer : buffer = ""
- Dim i : i = 0
- Dim itemKey
-
- buffer = "o:Dictionary:" & dict.Count & ":"
- For Each itemKey in dict.keys
- If i > 0 Then buffer = buffer & ";"
- buffer = buffer & serializeVar(itemKey) & ";" & serializeVar(dict(itemKey))
- i = i + 1
- Next
-
- serializeDictionary = buffer
- End Function
-
- Function serializeIRequestDictionary(IRDict)
- Dim buffer : buffer = ""
- Dim i : i = 0
- Dim itemKey
-
- buffer = "o:Dictionary:" & IRDict.Count & ":"
- For Each itemKey in IRDict
- If i > 0 Then buffer = buffer & ";"
- buffer = buffer & serializeVar(itemKey) & ";" & serializeVar(IRDict(itemKey))
- i = i + 1
- Next
-
- serializeIRequestDictionary = buffer
- End Function
-
- Function serializeIVariantDictionary(IVarDict)
- Dim buffer : buffer = ""
- Dim i : i = 0
- Dim itemKey
-
- buffer = "o:Dictionary:" & IVarDict.Count & ":"
- For Each itemKey in IVarDict
- If i > 0 Then buffer = buffer & ";"
- buffer = buffer & serializeVar(itemKey) & ";" & serializeVar(IVarDict(itemKey))
- i = i + 1
- Next
-
- serializeIVariantDictionary = buffer
- End Function
-
- Function serializeIStringList(IStrList)
- serializeIStringList = serializeString(IStrList)
- End Function
-
- Function serializeEmpty()
- serializeEmpty = "E"
- End Function
-
- Function serializeNull()
- serializeNull = "N"
- End Function
-
- Function serializeLong(l)
- serializeLong = "l:" & l
- End Function
-
- Function serializeInteger(i)
- serializeInteger = "i:" & i
- End Function
-
- Function serializeFloat(f)
- serializeFloat = "f:" & f
- End Function
-
- Function serializeBoolean(b)
- If b Then
- serializeBoolean = "b:1"
- Else
- serializeBoolean = "b:0"
- End If
- End Function
-
- Function serializeDate(d)
- serializeDate = "d:" & CStr(d)
- End Function
-
- Function serializeString(s)
- serializeString = "s:" & Len(s) & ":" & s
- End Function
-
- ' ********************************
- ' * Fonctions de désérialisation *
- ' ********************************
-
- Sub unserializeVar(str, ByRef var)
- Dim typeVar : typeVar = Left(str, 1)
- Dim vide
-
- Select Case typeVar
- Case "E"
- var = vide
- Case "N"
- var = NULL
- Case "l"
- unserializeLong str, var
- Case "i"
- unserializeInt str, var
- Case "f"
- unserializeFloat str, var
- Case "b"
- unserializeBoolean str, var
- Case "d"
- unserializeDate str, var
- Case "s"
- unserializeString str, var
- Case "a"
- unserializeArray str, var
- Case "o"
- unserializeObject str, var
- End Select
- End Sub
-
- Sub unserializeLong(str, ByRef var)
- Dim pos : pos = InStr(3, str & ";", ";")
- var = CLng(Mid(str, 3, pos - 3))
- End Sub
-
- Sub unserializeInt(str, ByRef var)
- Dim pos : pos = InStr(3, str & ";", ";")
- var = CInt(Mid(str, 3, pos - 3))
- End Sub
-
- Sub unserializeFloat(str, ByRef var)
- Dim pos : pos = InStr(3, str & ";", ";")
- var = CDbl(Mid(str, 3, pos - 3))
- End Sub
-
- Sub unserializeBoolean(str, ByRef var)
- Dim pos : pos = InStr(3, str & ";", ";")
- var = CBool(Mid(str, 3, pos - 3))
- End Sub
-
- Sub unserializeDate(str, ByRef var)
- Dim pos : pos = InStr(3, str & ";", ";")
- var = CDate(Mid(str, 3, pos - 3))
- End Sub
-
- Sub unserializeString(str, ByRef var)
- Dim pos : pos = InStr(3, str, ":")
- Dim length : length = CLng(Mid(str, 3, pos - 3))
- var = CStr(Mid(str, pos + 1, length))
- End Sub
-
- Sub unserializeArray(str, ByRef var)
- Dim pos : pos = InStr(3, str, ":")
- Dim count : count = CLng(Mid(str, 3, pos - 3))
- Dim arr()
- Dim key
- Dim value
- Dim i
-
- If Count > 0 Then
- Redim arr(Count - 1)
- pos = pos + 1
-
- For i = 0 To count - 1
- unserializeVar Mid(str, pos), key
- pos = pos + Len(serializeVar(key)) + 1
-
- unserializeVar Mid(str, pos), value
- pos = pos + Len(serializeVar(value)) + 1
-
- If IsObject(value) Then
- Set arr(key) = value
- Else
- arr(key) = value
- End If
- Next
- End if
-
- var = arr
- End Sub
-
- Sub unserializeObject(str, ByRef var)
- Dim pos : pos = InStr(3, str, ":")
- Dim typeObj : typeObj = Mid(str, 3, pos - 3)
-
- Select Case typeObj
- Case "Dictionary"
- unserializeDictionary str, var
- End Select
- End Sub
-
- Sub unserializeDictionary(str, ByRef var)
- Dim pos : pos = InStr(14, str, ":")
- Dim count : count = CLng(Mid(str, 14, pos - 14))
- Dim dict : set dict = Server.CreateObject("Scripting.Dictionary")
- Dim key
- Dim value
- Dim i
-
- If Count > 0 Then
- pos = pos + 1
-
- For i = 0 To count - 1
- unserializeVar Mid(str, pos), key
- pos = pos + Len(serializeVar(key)) + 1
-
- unserializeVar Mid(str, pos), value
- pos = pos + Len(serializeVar(value)) + 1
-
- dict.Add key, value
- Next
- End if
-
- Set var = dict
- End Sub
Option Explicit
' ***********
' * Session *
' ***********
Function serializeSession()
serializeSession = serializeIVariantDictionary(Session.Contents)
End Function
sub unserializeSession(str)
Dim dict
Dim itemKey
unserializeDictionary str, dict
For Each itemKey in dict.keys
If IsObject(dict(itemKey)) Then
Set Session(itemKey) = dict(itemKey)
Else
Session(itemKey) = dict(itemKey)
End if
Next
End sub
' ******************************
' * Fonctions de sérialisation *
' ******************************
Function serializeVar(var)
If IsObject(var) Then
serializeVar = serializeObject(var)
ElseIf IsArray(var) Then
serializeVar = serializeArray(var)
Else
serializeVar = serializeScalaire(var)
End If
End Function
Function serializeScalaire(scalaire)
Select Case TypeName(scalaire)
Case "Empty"
serializeScalaire = serializeEmpty
Case "Null"
serializeScalaire = serializeNull
Case "Long"
serializeScalaire = serializeLong(scalaire)
Case "Integer"
serializeScalaire = serializeInteger(scalaire)
case "Double"
serializeScalaire = serializeFloat(scalaire)
Case "Boolean"
serializeScalaire = serializeBoolean(scalaire)
Case "Date"
serializeScalaire = serializeDate(scalaire)
Case Else
serializeScalaire = serializeString(scalaire)
End Select
End Function
Function serializeArray(arr)
Dim buffer : buffer = ""
Dim size : size = 0
Dim lbnd
Dim ubnd
Dim i
On Error Resume Next
size = UBound(arr) + 1
buffer = "a:" & size & ":"
For i = 0 To size - 1
If i > lbnd Then buffer = buffer & ";"
buffer = buffer & serializeVar(i) & ";" & serializeVar(arr(i))
Next
serializeArray = buffer
End Function
Function serializeObject(obj)
Select Case TypeName(obj)
Case "Dictionary"
serializeObject = serializeDictionary(obj)
Case "IRequestDictionary"
serializeObject = serializeIRequestDictionary(obj)
Case "IStringList"
serializeObject = serializeIStringList(obj)
End Select
End Function
Function serializeDictionary(dict)
Dim buffer : buffer = ""
Dim i : i = 0
Dim itemKey
buffer = "o:Dictionary:" & dict.Count & ":"
For Each itemKey in dict.keys
If i > 0 Then buffer = buffer & ";"
buffer = buffer & serializeVar(itemKey) & ";" & serializeVar(dict(itemKey))
i = i + 1
Next
serializeDictionary = buffer
End Function
Function serializeIRequestDictionary(IRDict)
Dim buffer : buffer = ""
Dim i : i = 0
Dim itemKey
buffer = "o:Dictionary:" & IRDict.Count & ":"
For Each itemKey in IRDict
If i > 0 Then buffer = buffer & ";"
buffer = buffer & serializeVar(itemKey) & ";" & serializeVar(IRDict(itemKey))
i = i + 1
Next
serializeIRequestDictionary = buffer
End Function
Function serializeIVariantDictionary(IVarDict)
Dim buffer : buffer = ""
Dim i : i = 0
Dim itemKey
buffer = "o:Dictionary:" & IVarDict.Count & ":"
For Each itemKey in IVarDict
If i > 0 Then buffer = buffer & ";"
buffer = buffer & serializeVar(itemKey) & ";" & serializeVar(IVarDict(itemKey))
i = i + 1
Next
serializeIVariantDictionary = buffer
End Function
Function serializeIStringList(IStrList)
serializeIStringList = serializeString(IStrList)
End Function
Function serializeEmpty()
serializeEmpty = "E"
End Function
Function serializeNull()
serializeNull = "N"
End Function
Function serializeLong(l)
serializeLong = "l:" & l
End Function
Function serializeInteger(i)
serializeInteger = "i:" & i
End Function
Function serializeFloat(f)
serializeFloat = "f:" & f
End Function
Function serializeBoolean(b)
If b Then
serializeBoolean = "b:1"
Else
serializeBoolean = "b:0"
End If
End Function
Function serializeDate(d)
serializeDate = "d:" & CStr(d)
End Function
Function serializeString(s)
serializeString = "s:" & Len(s) & ":" & s
End Function
' ********************************
' * Fonctions de désérialisation *
' ********************************
Sub unserializeVar(str, ByRef var)
Dim typeVar : typeVar = Left(str, 1)
Dim vide
Select Case typeVar
Case "E"
var = vide
Case "N"
var = NULL
Case "l"
unserializeLong str, var
Case "i"
unserializeInt str, var
Case "f"
unserializeFloat str, var
Case "b"
unserializeBoolean str, var
Case "d"
unserializeDate str, var
Case "s"
unserializeString str, var
Case "a"
unserializeArray str, var
Case "o"
unserializeObject str, var
End Select
End Sub
Sub unserializeLong(str, ByRef var)
Dim pos : pos = InStr(3, str & ";", ";")
var = CLng(Mid(str, 3, pos - 3))
End Sub
Sub unserializeInt(str, ByRef var)
Dim pos : pos = InStr(3, str & ";", ";")
var = CInt(Mid(str, 3, pos - 3))
End Sub
Sub unserializeFloat(str, ByRef var)
Dim pos : pos = InStr(3, str & ";", ";")
var = CDbl(Mid(str, 3, pos - 3))
End Sub
Sub unserializeBoolean(str, ByRef var)
Dim pos : pos = InStr(3, str & ";", ";")
var = CBool(Mid(str, 3, pos - 3))
End Sub
Sub unserializeDate(str, ByRef var)
Dim pos : pos = InStr(3, str & ";", ";")
var = CDate(Mid(str, 3, pos - 3))
End Sub
Sub unserializeString(str, ByRef var)
Dim pos : pos = InStr(3, str, ":")
Dim length : length = CLng(Mid(str, 3, pos - 3))
var = CStr(Mid(str, pos + 1, length))
End Sub
Sub unserializeArray(str, ByRef var)
Dim pos : pos = InStr(3, str, ":")
Dim count : count = CLng(Mid(str, 3, pos - 3))
Dim arr()
Dim key
Dim value
Dim i
If Count > 0 Then
Redim arr(Count - 1)
pos = pos + 1
For i = 0 To count - 1
unserializeVar Mid(str, pos), key
pos = pos + Len(serializeVar(key)) + 1
unserializeVar Mid(str, pos), value
pos = pos + Len(serializeVar(value)) + 1
If IsObject(value) Then
Set arr(key) = value
Else
arr(key) = value
End If
Next
End if
var = arr
End Sub
Sub unserializeObject(str, ByRef var)
Dim pos : pos = InStr(3, str, ":")
Dim typeObj : typeObj = Mid(str, 3, pos - 3)
Select Case typeObj
Case "Dictionary"
unserializeDictionary str, var
End Select
End Sub
Sub unserializeDictionary(str, ByRef var)
Dim pos : pos = InStr(14, str, ":")
Dim count : count = CLng(Mid(str, 14, pos - 14))
Dim dict : set dict = Server.CreateObject("Scripting.Dictionary")
Dim key
Dim value
Dim i
If Count > 0 Then
pos = pos + 1
For i = 0 To count - 1
unserializeVar Mid(str, pos), key
pos = pos + Len(serializeVar(key)) + 1
unserializeVar Mid(str, pos), value
pos = pos + Len(serializeVar(value)) + 1
dict.Add key, value
Next
End if
Set var = dict
End Sub
Conclusion
Dim dic : set dic = server.CreateObject("Scripting.Dictionary") dic.Ad d "IDA", 10 dic.Add "IDB", 150000 Dim arr : arr = Array("A", "B", 1, 2, dic)
' On sérialise le tableau Dim strSerialize : strSerialize = serializeVar(arr) response.Write strSerialize
response.Write "<br>"
' On désérialise la chaine pour retrouver le tableau Dim arr2 : unserializeVar strSerialize, arr2 ' Et on teste son contenu en le sérialisant response.Write serializeVar(arr2)
=> Résultat
a:5:l:0;s:1:A;l:1;s:1:B;l:2;i:1;l:3;i:2; l:4;o:Dictionary:2:s:3:IDA;i:10;s:3:IDB;l:150000 a :5:l:0;s:1:A;l:1;s:1:B;l:2;i:1;l:3;i:2;l:4;o:Dicti onary:2:s:3:IDA;i:10;s:3:IDB;l:150000
Historique
- 19 janvier 2009 09:47:03 :
- Debug
- 19 janvier 2009 09:50:19 :
- Mise à jour du zip
- 19 janvier 2009 12:14:16 :
- .
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Sérialisation dans un flux [ par quineman ]
Bonjour,Voila, je souhaite avoir un flux XML dans une string pour faire une requete sur un serveur.Pour cela j'utilise la sérialisation dot net.Par co
|
Derniers Blogs
VOTEZ POUR LE TOP 10 DES INFLUENCEURS SHAREPOINT FRANCOPHONES !VOTEZ POUR LE TOP 10 DES INFLUENCEURS SHAREPOINT FRANCOPHONES ! par Patrick Guimonet
Si ce n'est déjà fait (comme plus de 600 personnes déjà), il est encore temps de voter pour le concours TOP 10 des influenceurs SharePoint francophones ! Il est organisé par harmon.ie et accessible ici : http://harmon.ie/top-...
Cliquez pour lire la suite de l'article par Patrick Guimonet [CONF'SHAREPOINT] DERNIER RAPPEL ! :-)[CONF'SHAREPOINT] DERNIER RAPPEL ! :-) par Patrick Guimonet
La Conf'SharePoint en chiffres c'est : 3 jours de SharePoint ! 4 parcours et 60 sessions 17 partenaires représentant toutes les fac...
Cliquez pour lire la suite de l'article par Patrick Guimonet [ #SHAREPOINT 2013 ] LES MODèLES DE SITES STANDARDS.[ #SHAREPOINT 2013 ] LES MODèLES DE SITES STANDARDS. par Patrick Guimonet
C'est un point peu mis en avant mais SharePoint 2013 a été l'occasion de remettre de l'ordre dans les modèles de sites. Tout d'abord, un certain nombre de modèles ont été tout simplement rendus obsolètes (cf. Fonctionnalités déco...
Cliquez pour lire la suite de l'article par Patrick Guimonet 10 ERREURS DE COMPRéHENSION CONCERNANT SHAREPOINT.10 ERREURS DE COMPRéHENSION CONCERNANT SHAREPOINT. par Patrick Guimonet
Une excellente infographie (qui a sa source ici :http://www.evokeit.com/sharepoint-blog/misconceptions-of-microsoft-sharepoint) que j'ai traduite et commentée sur le blog d'Abalon : http://abalon.fr/blog/10-erreurs-de-comprhension-...
Cliquez pour lire la suite de l'article par Patrick Guimonet
Forum
BASE DE DONNéESBASE DE DONNéES par oumessad
Cliquez pour lire la suite par oumessad
Logiciels
Nego Facturation (1.84)NEGO FACTURATION (1.84)Nego Facturation est un logiciel complet qui permet de gérer vos factures et devis très simplemen... Cliquez pour télécharger Nego Facturation Revealer Keylogger Free (2.07)REVEALER KEYLOGGER FREE (2.07)Keylogger invisible et gratuit pour Windows 8, 7, Vista ou XP. Revealer Keylogger Free vous perme... Cliquez pour télécharger Revealer Keylogger Free Devis-Factures PHMSD (2.1.0.1)DEVIS-FACTURES PHMSD (2.1.0.1)Configuration minimale
Nécessite Windows™ 2000, XP, Windows 7, 8, Vista (Service Pack à... Cliquez pour télécharger Devis-Factures PHMSD Ludoprêt (3.2)LUDOPRêT (3.2)Logiciel gratuit de gestion de ludothèque.
Gestion des jeux et des adhérents.
Gestion des for... Cliquez pour télécharger Ludoprêt 974 Application Server (13.2.1.3)974 APPLICATION SERVER (13.2.1.3)Ecommerce, Blogueur, Vitrine, Newsletter, Java IDE, ..., in the cloud et sous haute dispo. Facile... Cliquez pour télécharger 974 Application Server
|