HashTable in vbs

[Baol74]

Una funzione comoda per creare oggetti in vbscript in modo simile a javascript.

Esempio :

Set Obj = HashTable("Nome:'Lorenzo',Email:'loren@boh.it',Info:CreateObject('Scripting.Dictionary')")

Response.Write Obj.Name & "
"
Response.Write Obj.Email & "
"
Obj.Info("Via") = "Mazzini"
Set Obj = Nothing

Insomma in una riga si crea un oggetto...

Spero vi sia utile..

<%
Function HashTable(List)
	Dim i,Dic,tName,Out,Init,Vars,Close,Elm
	Dim Ch,Value,Key,InString,IsValue
	List = Replace(List,"'",chr(34))
	Set Dic = Server.CreateObject ("Scripting.Dictionary")
	Dic.CompareMode=1
	InString 	= False
	IsValue 	= False
	Value 		= ""
	Key 		= ""

	For i=1 to len(List)
		Ch = Mid(List,i,1)
		if InString then
			Value = Value & Ch
			If ch=chr(34) then InString = False
		elseif ch=chr(34) then
			Value = Value & Ch
			InString=True
		elseif ch=":" then
			IsValue=True
		elseif ch="," then
			Dic(Key)=Value:Value = "":Key = "":IsValue=False
		else
			if IsValue then	Value = Value & Ch:else:Key = Key & Ch:End If
		end if
	Next
	Dic(Key)=Value
	Init = "":Vars = "":Close=""
	for each elm in Dic.Keys
		Value = Dic(Elm)
		Vars = Vars & "Public " & elm & vbCrLf
		if Mid(Value,1,1)<>Chr(34) then
			If InStr(1,Value,"CreateObject",1)>0 or InStr(1,Value,"new ",1)>0 then 
				Close = Close & Elm & ".close()" & VbCrLF & "Set " & Elm &"=nothing" & VbCrLF
				elm = "Set " & Elm
			end if
		end if
		Init = Init & elm & "="& Value & vbCrLf
	next
	Out	=	"Class cHashTable" & VbCrLf & Vars & "Private Sub Class_Initialize()" & VbCrLf & Init & "End Sub" & VbCrLf &_
			"Private Sub Class_Terminate()" & VbCrLf & "On Error resume next" & VbCrLf & Close & "On Error goto 0" & VbCrLf & "End Sub" & VbCrLf & "End Class" & VbCrLf &_
			"Set HashTable = new cHashTable"
	Execute Out
	Set Dic = Nothing
End Function
%>

Ciao

[Baol74]

Nuova Versione: supporta la creazione di array con [] e sotto HashTable con {}

Esempio

Dim Obj
Set Obj=HashTable("a:'1',b:'2',ar:[1,2,{a:'b'},3]")
Response.Write Obj.ar(2).a & "
"
Response.Write Obj.a & "
"
Response.Write Obj("a") & "
"
Set Obj = Nothing

Function HashTable(List)
	Dim i,Dic,tName,Out,Init,Vars,Close,Elm
	Dim Ch,strEnd,Value,Key,InString,IsValue,pOpen,SubHash
	Set Dic = Server.CreateObject ("Scripting.Dictionary")
	Dic.CompareMode=1
	InString 	= False
	IsValue 	= False
	pOpen		= 0
	Value 		= ""
	Key 		= ""
	SubHash		= 0

	For i=1 to len(List)
		Ch = Mid(List,i,1)
		if InString then
			If ch=StrEnd then InString = False:If(SubHash=0) then Ch=Chr(34):else:Ch="'":End If:End IF
			Value = Value & Ch
		elseif IsValue then	
			if ch="'" or ch=chr(34) then
				InString=True:StrEnd = Ch 
				If SubHash = 0 then Ch = chr(34):Else:Ch = "'":end if
				Value = Value & Ch
			elseif ch="," and pOpen=0 then
				Dic(Key)=Value:Value = "":Key = "":IsValue=False
			elseif ch="[" then
				Value = Value & "Array(":pOpen = pOpen + 1
			elseif ch="{" then
				SubHash = SubHash + 1
				Value = Value & "HashTable(" & Chr(34) :pOpen = pOpen + 1			
			elseif ch="(" then
				pOpen = pOpen + 1:Value = Value & Ch
			elseif ch=")" or ch="]" then
				pOpen = pOpen - 1:Value = Value & ")"
			elseif ch="}" then
				SubHash = SubHash - 1
				pOpen = pOpen - 1:Value = Value & Chr(34) & ")"
			else
				Value = Value & Ch
			End if
		elseif ch=":" then
			IsValue=True
		elseif Not IsValue then
			Key = Key & Ch
		end if
	Next
	Key = Trim(Key)
	Value = Trim(Value)
	if Key<>"" then Dic(Key)=Value
	Init = "":Vars = "":Close=""
	for each elm in Dic.Keys
		Value = Dic(Elm)
		Vars = Vars & "Public " & elm & vbCrLf
		if Mid(Value,1,1)<>Chr(34) then
			If InStr(1,Value,"CreateObject",1)>0 or InStr(1,Value,"new ",1)>0 then 
				Close = Close & Elm & ".close()" & VbCrLF & "Set " & Elm &"=nothing" & VbCrLF
				elm = "Set " & Elm
			end if
		end if
		Init = Init & elm & "="& Value & vbCrLf
	next
	Out	=	"Class cHashTable" & VbCrLf & Vars & "Private Sub Class_Initialize()" & VbCrLf & Init & "End Sub" & VbCrLf
	If Close<>"" then Out=Out & "Private Sub Class_Terminate()" & VbCrLf & "On Error resume next" & VbCrLf & Close & "On Error goto 0" & VbCrLf & "End Sub" & VbCrLf 
	Out=Out & "Public Default Property Get Item(key)" & VbCrLF & "On Error resume next:Item= Eval(Key):On Error goto 0"& VbCrLF & "End Property" & VbCrLf
	Out=Out & "Public Property Let Item(key,byRef Value)" & VbCrLF & "On Error resume next:Execute Key & ""="" & Value:On Error goto 0"& VbCrLF & "End Property" & VbCrLf
	Out=Out & "End Class" & VbCrLf & "Set HashTable = new cHashTable"
	Execute Out
	Set Dic = Nothing
End Function