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
XNA IS DEAD!XNA IS DEAD! par richardc
Depuis la semaine dernière (et grâce aux TechDays 2012), je me penche activement sur la nouvelle version de Windows, aka Windows 8. Vous me direz, il était temps puisque la première preview date de Septembre dernier.
OK. Remarquez, on n'en est qu'aux...
Cliquez pour lire la suite de l'article par richardc TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 !TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice
Speakers: Fabrice Meillon et Stanislas Quastana Cette session est basée entièrement sur celle donnée lors de la BUILD cet hiver. Il n'y a pas d'ajout d'information en rapport avec cet évènement passé. Windows 8 Server sera intégralem...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice [HTML5] AUTOUR DU W3C : NOUVEAUX STANDARDS ET WEB MOBILE (LILLE)[HTML5] AUTOUR DU W3C : NOUVEAUX STANDARDS ET WEB MOBILE (LILLE) par Gio
Je m'y prends un peu tard je sais, mais bon je suis développeur web et donc hyper fainéant ! Toujours dans le cadre des technologies émergentes, ici HTML5, parce qu'on aime HTML5 chez Wyg , nous seront présent, le vieux ( Aurélien V.) et moi, pour pr...
Cliquez pour lire la suite de l'article par Gio [WP7] DYNAMICALLY CHANGE STARTUP PAGE[WP7] DYNAMICALLY CHANGE STARTUP PAGE par KooKiz
Let's say that you want to allow the user to customize the startup page of your application. You can easily change the startup page by editing the 'NavigationPage' attribute in the manifest file. But the manifest cannot be modified once the applicatio...
Cliquez pour lire la suite de l'article par KooKiz
Forum
RE : FORMULAIRERE : FORMULAIRE par ap24dp
Cliquez pour lire la suite par ap24dp RE : FORMULAIRERE : FORMULAIRE par jopop
Cliquez pour lire la suite par jopop RE : FORMULAIRERE : FORMULAIRE par ap24dp
Cliquez pour lire la suite par ap24dp RE : FORMULAIRERE : FORMULAIRE par jopop
Cliquez pour lire la suite par jopop
Logiciels
DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|