Sérialiser / désérialiser des variables en asp

Télécharger le projet
Commenter

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 / Exemple : 


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.Add "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:Dictionary:2:s:3:IDA;i:10;s:3:IDB;l:150000
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.