per prima cosa salve a tutti.
sono nuovo di questo forum ma è un pezzo che mi dedico ai siti e al javascript in particolare.
ultimamente mi sono imbattuto in questo lungo codice dui cui però non riesco bene a comprendere una funzione.
CODICE
<script language="vbscript"><!--
dim tent(4)
dim tokens
dim pippo
dim pappo
dim parte
dim arriva
dim Asso
Dim provv
Dim pravv
Dim Segreto
Dim Sugger
Dim Bonus
Dim posto
Dim Mancano
Dim Sottra1
Dim Sottra2
Dim Sottra3
Sottra1=0
Sottra2=0
Sottra3=1
Bonus=84
Mancano=5
For k =Lbound(tent) to Ubound(tent)
tent(k)=0
Next
Dim Tid
Dim Massimo
Sub Tokei()
Tid=setTimeout("Tokei()",1000)
Testa.Tempotext3.value=Testa.Tempotext3.value+1
If Testa.Tempotext3.value=60 then
Testa.Tempotext2.style.background="orange"
Testa.Tempotext3.value=0
Testa.Tempotext2.value=Testa.Tempotext2.value+1
End If
If Testa.Tempotext2.value=Massimo then
Testa.Tempotext2.style.background="red"
Testa.Tempotext3.style.background="red"
Testa.TempMax.style.background="#717F88"
Tid=Window.ClearTimeout(Tid)
Call Punteggio
End if
End sub
Sub avvia_OnClick
PartiTempo
End Sub
Sub PartiTempo
Massimo=Testa.TempMax.value
Testa.Tempotext2.value=0
Testa.Tempotext3.value=0
If Massimo="" then Massimo=0
If isnumeric(Testa.TempMax.value)=false then
msgbox "Tentare di fare un esercizio al computer per uno che non sa nemmeno inserire un numero correttamente a me sembra un azzardo"
Testa.TempMax.value=""
Exit sub
End if
If Massimo < 1 then
msgbox "Se propio non ce la fai a inserire un numero giusto puoi fare l'esercizio anche senza il tempo."
formEse.Casella0.focus
Elseif Massimo > 0 then
Tokei()
Testa.avvia.style.visibility="hidden"
Testa.TempMax.style.background="orange"
Testa.TempMax.style.border="thin"
Testa.TempMax.style.textAlign="center"
Testa.Tempotext2.style.textAlign="center"
Testa.Tempotext3.style.textAlign="center"
Testa.Tempotext3.style.background="orange"
Testa.TempMax.style.color="white"
Testa.TempMax.ReadOnly=true
Testa.Tempotext2.ReadOnly=True
Testa.Tempotext3.ReadOnly=True
Testa.Tempotext3.style.color=orange
formEse.Casella0.focus
End if
End Sub
Sub Window_OnLoad
Massimo=Testa.TempMax.value
For each element in document.Testa.all.tags("input")
element.value=0
Next
Testa.TempMax.value=Massimo
Testa.nometxt.value=vbnullstring
Testa.avvia.value=" Via "
For each element in document.formEse.all.tags("input")
element.value=vbnullstring
Next
formEse.Casella0.focus
Testa.Punti1.ReadOnly = True
Testa.Error1.ReadOnly = True
Testa.Tenta1.ReadOnly= True
Testa.Percent1.ReadOnly = True
Testa.Tempotext2.ReadOnly = True
Testa.Tempotext3.ReadOnly = True
PartiTempo
End Sub
Sub Bottone_OnClick
msgbox "Il lavoro è finito, " & Testa.nometxt.value & vbCrLf & "Ora i tuoi dati saranno salvati in un file"
mettiNome
NormaDati
Dim oFile, XFile
Set oFile = CreateObject("Scripting.FileSystemObject")
If not oFile.FileExists("C:\Prova.txt") then
Set XFile = oFile.OpenTextFile("C:\Prova.txt", 8, True)
XFile.write "nome|data|classe|tipo|tempo|punti|penalità|percentuale|testo" & vbcrlf
Set oFile=nothing
Set XFile=nothing
End if
Set oFile = CreateObject("Scripting.FileSystemObject")
Set XFile = oFile.OpenTextFile("C:\Prova.txt", 8, True)
XFile.write vbcrlf & "~" & Testa.nometxt.value & "~|~" & Now & "~|~nn~|~" &"Cloze (Fill in Blank)"&"~|~" & Testa.tempotext2.value & "' " & Testa.tempotext3.Value & "'' su " & Testa.tempmax.value & "'~|~" & Testa.Punti1.value & "~|~" & Testa.error1.value & "~|~" & Testa.percent1.value & "~" & vbcrlf
Bottone.style.background="#336699"
Bottone.value="Esercizio salvato"
Bottone.disabled=true
End Sub
Sub FormEse_onKeyPress()
If (window.event.keycode= 13) then
Asso= 1
Set pippo=formEse.casella0
Set pappo=formEse.casella1
Provv=pippo.Value
posto=Asso-1
tokens=Array("Domanda 1")
parte=Lbound(tokens)
arriva=Ubound(tokens)
Call Procedi
Asso= 2
Set pippo=formEse.casella1
Set pappo=formEse.casella2
Provv=pippo.Value
posto=Asso-1
tokens=Array("2")
parte=Lbound(tokens)
arriva=Ubound(tokens)
Call Procedi
Asso= 3
Set pippo=formEse.casella2
Set pappo=formEse.casella3
Provv=pippo.Value
posto=Asso-1
tokens=Array("3")
parte=Lbound(tokens)
arriva=Ubound(tokens)
Call Procedi
Asso= 4
Set pippo=formEse.casella3
Set pappo=formEse.casella4
Provv=pippo.Value
posto=Asso-1
tokens=Array("4")
parte=Lbound(tokens)
arriva=Ubound(tokens)
Call Procedi
Asso= 5
Set pippo=formEse.casella4
Set pappo=formEse.casella0
Provv=pippo.Value
posto=Asso-1
tokens=Array("5")
parte=Lbound(tokens)
arriva=Ubound(tokens)
Call Procedi
End if
End sub
Sub Casella0_onFocus
Testa.tenta1.value=tent(0) + 1
if instr(formEse.Casella0.value,":-") > 0 then
formEse.Casella1.focus
End if
End sub
Sub Casella1_onFocus
Testa.tenta1.value=tent(1) + 1
if instr(formEse.Casella1.value,":-") > 0 then
formEse.Casella2.focus
End if
End sub
Sub Casella2_onFocus
Testa.tenta1.value=tent(2) + 1
if instr(formEse.Casella2.value,":-") > 0 then
formEse.Casella3.focus
End if
End sub
Sub Casella3_onFocus
Testa.tenta1.value=tent(3) + 1
if instr(formEse.Casella3.value,":-") > 0 then
formEse.Casella4.focus
End if
End sub
Sub TempMax_OnClick
If not Testa.avvia.style.visibility="hidden" then
Testa.TempMax.value=""
End if
End sub
Sub Casella4_onFocus
Testa.tenta1.value=tent(4) + 1
End sub
Function SuperTrim(TheString)
DoubleSpaces = Chr(32) & Chr(32)
temp = Trim(TheString)
temp = Replace(temp, DoubleSpaces, Chr(32))
Do Until InStr(temp, DoubleSpaces) = 0
temp = Replace(temp, DoubleSpaces, Chr(32))
Loop
SuperTrim = temp
End function
Sub procedi
If InStr(provv,":-") = 0 And provv > vbNullString and instr(provv,"-XXX-")=0 Then
For i = LBound(tokens) To UBound(tokens)
pravv=xorc(tokens(i),false)
If StrComp(SuperTrim(viapunti(provv)) ,SuperTrim(viapunti(pravv)),1)<> 0 Then
If i = UBound(tokens) Then
If Testa.tenta1.Value = 1 Then
Testa.error1.Value = Testa.error1.Value + 1
If Testa.punti1.value > 0 then
Testa.punti1.value=Testa.punti1.value-sottra1
End if
pippo.Style.backgroundcolor = "#FF9966"
ElseIf Testa.tenta1.Value = 2 Then
Testa.error1.Value = Testa.error1.Value + 1
If Testa.punti1.value > 0 then
Testa.punti1.value=Testa.punti1.value-sottra2
End if
End If
tent(posto) = tent(posto) + 1
Testa.tenta1.Value = tent(posto)
Call Sbaglio
If tent(posto) >= 2 Then
tent(posto) = 1
Testa.tenta1.Value = tent(posto)
pippo.Style.backgroundcolor = "red"
pippo.Style.Color = "white"
pippo.Value =":-( "&xorc(tokens(0),false)
pippo.ReadOnly = True
Mancano=Mancano-1
pappo.focus
Else
pippo.Value = vbNullString
End If
End If
ElseIf StrComp(SuperTrim(viapunti(provv)) ,SuperTrim(viapunti(pravv)),1)= 0 Then
If Testa.tenta1.value =1 then
pippo.Style.backgroundcolor = "green"
Elseif Testa.tenta1.value =2 then
pippo.Style.backgroundcolor = "#99CC99"
End if
pippo.Style.Color = "white"
pippo.Value ="
" & SuperTrim(pravv)
Call CalcPunti
pippo.ReadOnly = True
Mancano=Mancano-1
pappo.focus
Exit For
End If
Next
Call Traguardo
Set pippo = Nothing
Set pappo = Nothing
End If
End Sub
Function ViaPunti(TheString)
temp=trim(theString)
temp=replace(temp,".","")
temp=replace(temp,",","")
temp=replace(temp,":","")
temp=replace(temp,";","")
temp=replace(temp,"?","")
temp=replace(temp,"!","")
temp=replace(temp,"'","' ")
temp=replace(temp,"e'","è")
temp=replace(temp,"é","è")
temp=replace(temp,"hè","hé")
temp=replace(temp,"a'","à")
temp=replace(temp,"o'","ò")
temp=replace(temp,"i'","ì")
temp=replace(temp,"u'","ù")
temp=replace(temp,"E'","È")
temp=replace(temp,"E'","É")
temp=replace(temp,"HÈ","HÉ")
temp=replace(temp,"A'","À")
temp=replace(temp,"O'","Ò")
temp=replace(temp,"I'","Ì")
temp=replace(temp,"U'","Ù")
ViaPunti=temp
End Function
Function xorc(intx,acto)
Dim X
Dim outString
Dim iLen
Dim sFirstSeed
Dim sSecondSeed
Dim iSeed
If acto Then
sFirstSeed = Left(intx, 1)
If Len(intx) > 1 Then
sSecondSeed = Mid(intx, 2, 1)
Else
sSecondSeed = Left(intx, 1)
End If
iSeed = (Asc(sFirstSeed) + Asc(sSecondSeed)) Mod 2
iLen = Len(intx)
For X = 1 To iLen
outString = Chr((Asc(Mid(intx, X, 1)) Xor iSeed) + 2) & outString
Next
outString = Chr(Asc(sFirstSeed) * 2 + 3) & outString
outString = outString & Chr(Asc(sSecondSeed) * 2 - 3)
outString = Replace(outString, Chr(34), "()")
Else
sFirstSeed = Chr((Asc(Left(intx, 1)) - 3) \ 2)
sSecondSeed = Chr((Asc(Right(intx, 1)) + 3) \ 2)
iSeed = (Asc(sFirstSeed) + Asc(sSecondSeed)) Mod 2
iLen = Len(intx) - 1
outString = Replace(outString, "()", Chr(34))
For X = 2 To iLen
outString = Chr((Asc(Mid(intx, X, 1)) Xor iSeed) - 2) & outString
Next
outString = Replace(outString, "'&", space(1))
outString = Replace(outString,"e(grv","è")
outString = Replace(outString,"e(ac","é")
outString = Replace(outString,"o(grv","ò")
outString = Replace(outString,"i(grv","ì")
outString = Replace(outString,"a(grv","à")
outString = Replace(outString,"u(grv","ù")
outString = Replace(outString,"E(grv",Chr(200))
outString = Replace(outString,"E(ac",Chr(201))
outString = Replace(outString,"I(grv",Chr(204))
outString = Replace(outString,"O(grv",Chr(210))
outString = Replace(outString,"U(grv",Chr(217))
outString = Replace(outString,"A(grv",Chr(192))
End If
xorc = outString
End Function
Sub Traguardo
percen = (Testa.punti1.Value * 100) / bonus
Window.status=Testa.punti1.value &" su " & bonus & ": " & left(percen,4) & "%"
If percen >= 0 Then
Testa.percent1.value = Left(percen, 6) & "%"
Else: Testa.percent1.Value = 0 & "%"
End If
If Mancano=0 Then
Punteggio
End If
End Sub
sub CalcPunti
If Testa.tenta1.Value = 1 Then
Testa.punti1.Value = Testa.punti1.Value + 4
tent(asso - 1) = 1
Testa.tenta1.Value = tent(asso - 1)
ElseIf Testa.tenta1.Value = 2 Then
Testa.punti1.Value = Testa.punti1.Value + 2
tent(asso - 1) = 1
Testa.tenta1.Value = tent(asso - 1)
End If
End Sub
Sub mettiNome
If Trim(Testa.nometxt.Value) = vbnullstring Then
Dim inser
inser = InputBox("Non hai indicato il tuo cognome e nome. Per comodità di registrazione, metti prima il cognome")
Testa.nometxt.Value = inser
End If
End Sub
Sub NormaDati
Dim ident
Dim pezzi
ident = Trim(testa.nomeTxt.Value)
pezzi = Split(ident)
ident = vbnullstring
For i = 0 To UBound(pezzi)
If Len(Trim(pezzi(i))) > 0 Then
pezzi(i) = LCase(pezzi(i))
pezzi(i) = UCase(Left(pezzi(i), 1)) & Right(pezzi(i), Len(pezzi(i)) - 1)
ident = ident & pezzi(i) & space(1)
End If
Next
testa.nomeTxt.Value = Trim(ident)
End Sub
Sub occulta(oggetto)
massa=massa & chr(keycode)
If Len(massa) > 1 Then
oggetto.Style.display = "none"
End if
End sub
Sub Sbaglio
segreto=vbnullstring
if tent(Asso-1)=2 then
For k = 0 To UBound(tokens)
segreto = segreto & space(1)& xorc(tokens(k), False) &","
Next
sugger = vbCrLf & "le risposte accettabili erano:" & chr(34) & Left(Ltrim(segreto), Len(segreto) - 2) & Chr(34) & vbCrLf
Else
sugger = VBNullstring
End If
msgbox ("La risposta che leggo nella casella " & Asso & " , cioè " & "'" & Provv & "'" & " non è esatta" & vbcrlf & "e verrà cancellata:" & " Hai fallito il tentativo " & Testa.tenta1.value & " su 2" & vbcrlf & sugger),48, ("Errore" & " n." & tent(Asso-1)&" nella casella " & Asso )
End sub
Sub Punteggio
For each element in document.formEse.all.tags("input")
element.blur
element.readonly=true
next
If Testa.punti1.Value = 1 Then
des = "o"
Else
des = "i"
End if
msgbox "L'esercizio è finito, " & Testa.nometxt.value & "; hai fatto " & Testa.punti1.value & " punt" & des & " su " & bonus & " disponibili, " & "con " & Testa.error1.value & " penalità " & vbcrlf & "Tutto considerato, la tua percentuale è: " & Testa.percent1.value & vbcrlf & vbcrlf & "",64, " Risultato finale"
Tid=Window.ClearTimeout(Tid)
Testa.avvia.disabled=true
Bottone.click
End sub
--></SCRIPT>
FINE CODICE.
la funzione che non capisco è Funciotn xorc.
CODICE
Function xorc(intx,acto)
Dim X
Dim outString
Dim iLen
Dim sFirstSeed
Dim sSecondSeed
Dim iSeed
If acto Then
sFirstSeed = Left(intx, 1)
If Len(intx) > 1 Then
sSecondSeed = Mid(intx, 2, 1)
Else
sSecondSeed = Left(intx, 1)
End If
iSeed = (Asc(sFirstSeed) + Asc(sSecondSeed)) Mod 2
iLen = Len(intx)
For X = 1 To iLen
outString = Chr((Asc(Mid(intx, X, 1)) Xor iSeed) + 2) & outString
FINE CODICE.
se qualcuno mi sapesse spiegare cosa accade gliene sarei gratissimo.
saluti,
Ldn
sono nuovo di questo forum ma è un pezzo che mi dedico ai siti e al javascript in particolare.
ultimamente mi sono imbattuto in questo lungo codice dui cui però non riesco bene a comprendere una funzione.
CODICE
<script language="vbscript"><!--
dim tent(4)
dim tokens
dim pippo
dim pappo
dim parte
dim arriva
dim Asso
Dim provv
Dim pravv
Dim Segreto
Dim Sugger
Dim Bonus
Dim posto
Dim Mancano
Dim Sottra1
Dim Sottra2
Dim Sottra3
Sottra1=0
Sottra2=0
Sottra3=1
Bonus=84
Mancano=5
For k =Lbound(tent) to Ubound(tent)
tent(k)=0
Next
Dim Tid
Dim Massimo
Sub Tokei()
Tid=setTimeout("Tokei()",1000)
Testa.Tempotext3.value=Testa.Tempotext3.value+1
If Testa.Tempotext3.value=60 then
Testa.Tempotext2.style.background="orange"
Testa.Tempotext3.value=0
Testa.Tempotext2.value=Testa.Tempotext2.value+1
End If
If Testa.Tempotext2.value=Massimo then
Testa.Tempotext2.style.background="red"
Testa.Tempotext3.style.background="red"
Testa.TempMax.style.background="#717F88"
Tid=Window.ClearTimeout(Tid)
Call Punteggio
End if
End sub
Sub avvia_OnClick
PartiTempo
End Sub
Sub PartiTempo
Massimo=Testa.TempMax.value
Testa.Tempotext2.value=0
Testa.Tempotext3.value=0
If Massimo="" then Massimo=0
If isnumeric(Testa.TempMax.value)=false then
msgbox "Tentare di fare un esercizio al computer per uno che non sa nemmeno inserire un numero correttamente a me sembra un azzardo"
Testa.TempMax.value=""
Exit sub
End if
If Massimo < 1 then
msgbox "Se propio non ce la fai a inserire un numero giusto puoi fare l'esercizio anche senza il tempo."
formEse.Casella0.focus
Elseif Massimo > 0 then
Tokei()
Testa.avvia.style.visibility="hidden"
Testa.TempMax.style.background="orange"
Testa.TempMax.style.border="thin"
Testa.TempMax.style.textAlign="center"
Testa.Tempotext2.style.textAlign="center"
Testa.Tempotext3.style.textAlign="center"
Testa.Tempotext3.style.background="orange"
Testa.TempMax.style.color="white"
Testa.TempMax.ReadOnly=true
Testa.Tempotext2.ReadOnly=True
Testa.Tempotext3.ReadOnly=True
Testa.Tempotext3.style.color=orange
formEse.Casella0.focus
End if
End Sub
Sub Window_OnLoad
Massimo=Testa.TempMax.value
For each element in document.Testa.all.tags("input")
element.value=0
Next
Testa.TempMax.value=Massimo
Testa.nometxt.value=vbnullstring
Testa.avvia.value=" Via "
For each element in document.formEse.all.tags("input")
element.value=vbnullstring
Next
formEse.Casella0.focus
Testa.Punti1.ReadOnly = True
Testa.Error1.ReadOnly = True
Testa.Tenta1.ReadOnly= True
Testa.Percent1.ReadOnly = True
Testa.Tempotext2.ReadOnly = True
Testa.Tempotext3.ReadOnly = True
PartiTempo
End Sub
Sub Bottone_OnClick
msgbox "Il lavoro è finito, " & Testa.nometxt.value & vbCrLf & "Ora i tuoi dati saranno salvati in un file"
mettiNome
NormaDati
Dim oFile, XFile
Set oFile = CreateObject("Scripting.FileSystemObject")
If not oFile.FileExists("C:\Prova.txt") then
Set XFile = oFile.OpenTextFile("C:\Prova.txt", 8, True)
XFile.write "nome|data|classe|tipo|tempo|punti|penalità|percentuale|testo" & vbcrlf
Set oFile=nothing
Set XFile=nothing
End if
Set oFile = CreateObject("Scripting.FileSystemObject")
Set XFile = oFile.OpenTextFile("C:\Prova.txt", 8, True)
XFile.write vbcrlf & "~" & Testa.nometxt.value & "~|~" & Now & "~|~nn~|~" &"Cloze (Fill in Blank)"&"~|~" & Testa.tempotext2.value & "' " & Testa.tempotext3.Value & "'' su " & Testa.tempmax.value & "'~|~" & Testa.Punti1.value & "~|~" & Testa.error1.value & "~|~" & Testa.percent1.value & "~" & vbcrlf
Bottone.style.background="#336699"
Bottone.value="Esercizio salvato"
Bottone.disabled=true
End Sub
Sub FormEse_onKeyPress()
If (window.event.keycode= 13) then
Asso= 1
Set pippo=formEse.casella0
Set pappo=formEse.casella1
Provv=pippo.Value
posto=Asso-1
tokens=Array("Domanda 1")
parte=Lbound(tokens)
arriva=Ubound(tokens)
Call Procedi
Asso= 2
Set pippo=formEse.casella1
Set pappo=formEse.casella2
Provv=pippo.Value
posto=Asso-1
tokens=Array("2")
parte=Lbound(tokens)
arriva=Ubound(tokens)
Call Procedi
Asso= 3
Set pippo=formEse.casella2
Set pappo=formEse.casella3
Provv=pippo.Value
posto=Asso-1
tokens=Array("3")
parte=Lbound(tokens)
arriva=Ubound(tokens)
Call Procedi
Asso= 4
Set pippo=formEse.casella3
Set pappo=formEse.casella4
Provv=pippo.Value
posto=Asso-1
tokens=Array("4")
parte=Lbound(tokens)
arriva=Ubound(tokens)
Call Procedi
Asso= 5
Set pippo=formEse.casella4
Set pappo=formEse.casella0
Provv=pippo.Value
posto=Asso-1
tokens=Array("5")
parte=Lbound(tokens)
arriva=Ubound(tokens)
Call Procedi
End if
End sub
Sub Casella0_onFocus
Testa.tenta1.value=tent(0) + 1
if instr(formEse.Casella0.value,":-") > 0 then
formEse.Casella1.focus
End if
End sub
Sub Casella1_onFocus
Testa.tenta1.value=tent(1) + 1
if instr(formEse.Casella1.value,":-") > 0 then
formEse.Casella2.focus
End if
End sub
Sub Casella2_onFocus
Testa.tenta1.value=tent(2) + 1
if instr(formEse.Casella2.value,":-") > 0 then
formEse.Casella3.focus
End if
End sub
Sub Casella3_onFocus
Testa.tenta1.value=tent(3) + 1
if instr(formEse.Casella3.value,":-") > 0 then
formEse.Casella4.focus
End if
End sub
Sub TempMax_OnClick
If not Testa.avvia.style.visibility="hidden" then
Testa.TempMax.value=""
End if
End sub
Sub Casella4_onFocus
Testa.tenta1.value=tent(4) + 1
End sub
Function SuperTrim(TheString)
DoubleSpaces = Chr(32) & Chr(32)
temp = Trim(TheString)
temp = Replace(temp, DoubleSpaces, Chr(32))
Do Until InStr(temp, DoubleSpaces) = 0
temp = Replace(temp, DoubleSpaces, Chr(32))
Loop
SuperTrim = temp
End function
Sub procedi
If InStr(provv,":-") = 0 And provv > vbNullString and instr(provv,"-XXX-")=0 Then
For i = LBound(tokens) To UBound(tokens)
pravv=xorc(tokens(i),false)
If StrComp(SuperTrim(viapunti(provv)) ,SuperTrim(viapunti(pravv)),1)<> 0 Then
If i = UBound(tokens) Then
If Testa.tenta1.Value = 1 Then
Testa.error1.Value = Testa.error1.Value + 1
If Testa.punti1.value > 0 then
Testa.punti1.value=Testa.punti1.value-sottra1
End if
pippo.Style.backgroundcolor = "#FF9966"
ElseIf Testa.tenta1.Value = 2 Then
Testa.error1.Value = Testa.error1.Value + 1
If Testa.punti1.value > 0 then
Testa.punti1.value=Testa.punti1.value-sottra2
End if
End If
tent(posto) = tent(posto) + 1
Testa.tenta1.Value = tent(posto)
Call Sbaglio
If tent(posto) >= 2 Then
tent(posto) = 1
Testa.tenta1.Value = tent(posto)
pippo.Style.backgroundcolor = "red"
pippo.Style.Color = "white"
pippo.Value =":-( "&xorc(tokens(0),false)
pippo.ReadOnly = True
Mancano=Mancano-1
pappo.focus
Else
pippo.Value = vbNullString
End If
End If
ElseIf StrComp(SuperTrim(viapunti(provv)) ,SuperTrim(viapunti(pravv)),1)= 0 Then
If Testa.tenta1.value =1 then
pippo.Style.backgroundcolor = "green"
Elseif Testa.tenta1.value =2 then
pippo.Style.backgroundcolor = "#99CC99"
End if
pippo.Style.Color = "white"
pippo.Value ="
" & SuperTrim(pravv)Call CalcPunti
pippo.ReadOnly = True
Mancano=Mancano-1
pappo.focus
Exit For
End If
Next
Call Traguardo
Set pippo = Nothing
Set pappo = Nothing
End If
End Sub
Function ViaPunti(TheString)
temp=trim(theString)
temp=replace(temp,".","")
temp=replace(temp,",","")
temp=replace(temp,":","")
temp=replace(temp,";","")
temp=replace(temp,"?","")
temp=replace(temp,"!","")
temp=replace(temp,"'","' ")
temp=replace(temp,"e'","è")
temp=replace(temp,"é","è")
temp=replace(temp,"hè","hé")
temp=replace(temp,"a'","à")
temp=replace(temp,"o'","ò")
temp=replace(temp,"i'","ì")
temp=replace(temp,"u'","ù")
temp=replace(temp,"E'","È")
temp=replace(temp,"E'","É")
temp=replace(temp,"HÈ","HÉ")
temp=replace(temp,"A'","À")
temp=replace(temp,"O'","Ò")
temp=replace(temp,"I'","Ì")
temp=replace(temp,"U'","Ù")
ViaPunti=temp
End Function
Function xorc(intx,acto)
Dim X
Dim outString
Dim iLen
Dim sFirstSeed
Dim sSecondSeed
Dim iSeed
If acto Then
sFirstSeed = Left(intx, 1)
If Len(intx) > 1 Then
sSecondSeed = Mid(intx, 2, 1)
Else
sSecondSeed = Left(intx, 1)
End If
iSeed = (Asc(sFirstSeed) + Asc(sSecondSeed)) Mod 2
iLen = Len(intx)
For X = 1 To iLen
outString = Chr((Asc(Mid(intx, X, 1)) Xor iSeed) + 2) & outString
Next
outString = Chr(Asc(sFirstSeed) * 2 + 3) & outString
outString = outString & Chr(Asc(sSecondSeed) * 2 - 3)
outString = Replace(outString, Chr(34), "()")
Else
sFirstSeed = Chr((Asc(Left(intx, 1)) - 3) \ 2)
sSecondSeed = Chr((Asc(Right(intx, 1)) + 3) \ 2)
iSeed = (Asc(sFirstSeed) + Asc(sSecondSeed)) Mod 2
iLen = Len(intx) - 1
outString = Replace(outString, "()", Chr(34))
For X = 2 To iLen
outString = Chr((Asc(Mid(intx, X, 1)) Xor iSeed) - 2) & outString
Next
outString = Replace(outString, "'&", space(1))
outString = Replace(outString,"e(grv","è")
outString = Replace(outString,"e(ac","é")
outString = Replace(outString,"o(grv","ò")
outString = Replace(outString,"i(grv","ì")
outString = Replace(outString,"a(grv","à")
outString = Replace(outString,"u(grv","ù")
outString = Replace(outString,"E(grv",Chr(200))
outString = Replace(outString,"E(ac",Chr(201))
outString = Replace(outString,"I(grv",Chr(204))
outString = Replace(outString,"O(grv",Chr(210))
outString = Replace(outString,"U(grv",Chr(217))
outString = Replace(outString,"A(grv",Chr(192))
End If
xorc = outString
End Function
Sub Traguardo
percen = (Testa.punti1.Value * 100) / bonus
Window.status=Testa.punti1.value &" su " & bonus & ": " & left(percen,4) & "%"
If percen >= 0 Then
Testa.percent1.value = Left(percen, 6) & "%"
Else: Testa.percent1.Value = 0 & "%"
End If
If Mancano=0 Then
Punteggio
End If
End Sub
sub CalcPunti
If Testa.tenta1.Value = 1 Then
Testa.punti1.Value = Testa.punti1.Value + 4
tent(asso - 1) = 1
Testa.tenta1.Value = tent(asso - 1)
ElseIf Testa.tenta1.Value = 2 Then
Testa.punti1.Value = Testa.punti1.Value + 2
tent(asso - 1) = 1
Testa.tenta1.Value = tent(asso - 1)
End If
End Sub
Sub mettiNome
If Trim(Testa.nometxt.Value) = vbnullstring Then
Dim inser
inser = InputBox("Non hai indicato il tuo cognome e nome. Per comodità di registrazione, metti prima il cognome")
Testa.nometxt.Value = inser
End If
End Sub
Sub NormaDati
Dim ident
Dim pezzi
ident = Trim(testa.nomeTxt.Value)
pezzi = Split(ident)
ident = vbnullstring
For i = 0 To UBound(pezzi)
If Len(Trim(pezzi(i))) > 0 Then
pezzi(i) = LCase(pezzi(i))
pezzi(i) = UCase(Left(pezzi(i), 1)) & Right(pezzi(i), Len(pezzi(i)) - 1)
ident = ident & pezzi(i) & space(1)
End If
Next
testa.nomeTxt.Value = Trim(ident)
End Sub
Sub occulta(oggetto)
massa=massa & chr(keycode)
If Len(massa) > 1 Then
oggetto.Style.display = "none"
End if
End sub
Sub Sbaglio
segreto=vbnullstring
if tent(Asso-1)=2 then
For k = 0 To UBound(tokens)
segreto = segreto & space(1)& xorc(tokens(k), False) &","
Next
sugger = vbCrLf & "le risposte accettabili erano:" & chr(34) & Left(Ltrim(segreto), Len(segreto) - 2) & Chr(34) & vbCrLf
Else
sugger = VBNullstring
End If
msgbox ("La risposta che leggo nella casella " & Asso & " , cioè " & "'" & Provv & "'" & " non è esatta" & vbcrlf & "e verrà cancellata:" & " Hai fallito il tentativo " & Testa.tenta1.value & " su 2" & vbcrlf & sugger),48, ("Errore" & " n." & tent(Asso-1)&" nella casella " & Asso )
End sub
Sub Punteggio
For each element in document.formEse.all.tags("input")
element.blur
element.readonly=true
next
If Testa.punti1.Value = 1 Then
des = "o"
Else
des = "i"
End if
msgbox "L'esercizio è finito, " & Testa.nometxt.value & "; hai fatto " & Testa.punti1.value & " punt" & des & " su " & bonus & " disponibili, " & "con " & Testa.error1.value & " penalità " & vbcrlf & "Tutto considerato, la tua percentuale è: " & Testa.percent1.value & vbcrlf & vbcrlf & "",64, " Risultato finale"
Tid=Window.ClearTimeout(Tid)
Testa.avvia.disabled=true
Bottone.click
End sub
--></SCRIPT>
FINE CODICE.
la funzione che non capisco è Funciotn xorc.
CODICE
Function xorc(intx,acto)
Dim X
Dim outString
Dim iLen
Dim sFirstSeed
Dim sSecondSeed
Dim iSeed
If acto Then
sFirstSeed = Left(intx, 1)
If Len(intx) > 1 Then
sSecondSeed = Mid(intx, 2, 1)
Else
sSecondSeed = Left(intx, 1)
End If
iSeed = (Asc(sFirstSeed) + Asc(sSecondSeed)) Mod 2
iLen = Len(intx)
For X = 1 To iLen
outString = Chr((Asc(Mid(intx, X, 1)) Xor iSeed) + 2) & outString
FINE CODICE.
se qualcuno mi sapesse spiegare cosa accade gliene sarei gratissimo.
saluti,
Ldn