Forum programmazione

Born in 06/06/06

Skip to content

Problema vbscript

Qualsiasi altro linguaggio non citato nelle altre sezioni.

Moderator: Falcon

Post a reply

Problema vbscript

Postby Ldn on Fri Mar 02, 2007 4:51 pm

da qualche tempo a scuola mia sono saltati fuori delgi esercizi al computer eseguibili con ie simili a questo :
Code: Select all
<HTML><HEAD>
<META NAME="Author" CONTENT="Prodotto con HtmlCompiler, un programma sviluppato da Lorenzo De Nobili, per creare esercizi interattivi.">
<TITLE>Fly</TITLE>

<SCRIPT LANGUAGE="JavaScript1.2">
if (navigator.appName == "Netscape" ) {alert("Questo esercizio non può essere eseguito in Netscape. Ci vuole Internet Explorer");}
</SCRIPT>

<style type="text/css"><!--
body {scrollbar-face-color:000040;
scrollbar-arrow-color:F8FCFC;
scrollbar-track-color:B0D8FF;}
scrollbar-shadow-color:000040;}
A:link{text-decoration:none;color:"0000FF"}
A:visited{text-decoration:none;color:"0000FF"}
A:hover{text-decoration:none;color:"0000FF"}
--></style>

<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:\Fly.txt") then
Set XFile = oFile.OpenTextFile("C:\Fly.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:\Fly.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("a")
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("a")
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("a")
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("a")
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("a")
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></HEAD>
<BODY style="filter:progid:DXImageTransform.Microsoft.Gradient(endColorstr='#004080', startColorstr='#8AC5FF', gradientType='0');" BGCOLOR="004080" background="" ONLOAD=""> <center><table width="86%" cellpadding="0" cellspacing="0" border="0" height="200" background="">
<tr><td align="center" valign="top">
<table width="100%" cellpadding="0" cellspacing="0" border="0" align="center">
<tr><td align="center" height="20"></td></tr><tr><td align="center" valign="top">
<Form  name="Testa" id ="Testa"><table width="100%" cellpadding="0" cellspacing="0" border="0"><tr>
<td align="center" valign="middle" bgcolor="000040" height="22"><b><font size="3" color="F8FCFC">
Realizzato con  <i>"Html Compiler"</i> un programma di <a href="mailto:elledienne@hotmail.it">Lorenzo De Nobili </font></b></font></td></tr><tr>
<td align="center" valign="middle" bgcolor="B0D8FF">
<table width="100%"><tr align="center" valign="middle"><td>&nbsp;</td>
<td><table width="87%"><tr align="center" valign="middle">
<td><font color="000040">Nome e Cognome:</font></td>
<td><input maxlength=30 name=nometxt></td>
<td></td><td width="100%"><font color="000040">Il tempo massimo è di minuti:</font></td>
<td><input type="text" name=TempMax size="5" value="10"></td><td>
<input style="background:B0D8FF;color;000040" type=button name=avvia value=" Via"  onMouseOver="this.style.color='red';this.style.cursor='hand'" onMouseOut="this.style.color='000040'"></td></tr>
</table></td><td>&nbsp;</td></tr></table></td></tr><tr>
<td align="center" valign="middle" bgcolor="000040"><table width="100%">
<tr align="center" valign="middle"><td>&nbsp;</td><td><table width="87%">
<tr align="center" valign="middle"><td><font color= "FFFFFF"><b> Realizzato in C.</b></font></td>
</tr></table></td><td>&nbsp;</td></tr></table></td></tr><tr>
<td align="center" valign="middle" bgcolor="B0D8FF"><table width="100%">
<tr align="center" valign="middle"><td>&nbsp;</td><td><table width="87%"><tr align="center" valign="middle">
<td><font color= "000040">Punti:</font></td><td><font color="000040">
<input type="text" name="punti1" size="3" value="0"></font> </td>
<td><font color="000040">Penalit&agrave;:</font></td><td><font color="000040">
<input type="text" name="error1" size="3" value="0"></font></td>
<td><font color= "000040">Tentativo:</font> </td><td><input type="text" name="tenta1" size="2" value="1">
</td><td><font color="000040">Percentuale:</font></td><td><font color="000040">
<input type="text" name="percent1" size="6" value="0%"></font></td><td><font color="000040">Tempo:</font></td><td>
<table width="80%"><tr><td><input type="text" name="Tempotext2" size="2" value="0"></td><td><input type="text" name="Tempotext3" size="2" value="0">
</td></tr></table><font color="000040"></font></td></tr></table></Form></td><td>&nbsp;</td></tr></table></td></tr></table></td></tr><tr><td align="center" height="40">&nbsp;</td></tr>
<tr><td align="center"><tr>
<table width="100Ð"><td align=center height=50 valign=middle><font color="000040" size= 6>èsÿÿÿèÞ2</font></td>
<tr><th><table align="center" width="60%" BACKGROUND=""><td align=center width="550" style="word-wrap:break-word;"><strong><font color="FF0000">asdddddddd</font></strong></td></table>
<tr><td><table align="center"><td align=center width="640" colspan=3 style="word-wrap:break-word;font-size:8pt;font-family:MS Sans Serif"></td></table></td><tr><tr><td colspan=2align= bgcolor=""><td><font color="000000" face="MS Sans Serif"><P align= style="font-size:8pt"></p></font></td><tr><tr><td colspan=2 align= bgcolor=""><td><font color="000000" face="MS Sans Serif"><P align=style="font-size:8pt"></p></td><tr><td colspan=2 align= bgcolor=><td><font color="000000" face="MS Sans Serif"><P align=style="font-size:8pt"></p><tr><td></td><tr><td><Form name="formEse"><table width="100%" cellpadding="10" id= "corpo" style="visibility:visible" >
  <td align="right" bgcolor=""><font face="MS Sans Serif"><font size="3"><font color=#000000>
    <div align="left">sadagsdhgjhasdjhfasgdfaksgdkfajhsgdfkasjhdgfkashdgfka &nbsp;
        <input style="font-family:MS Sans Serif;background:BBDDFF;color:000000;font-size:10pt" type="text" name="Casella0" size=15>
      <br>
      <br>
      asrgaqliwshgahsfhgkjahsfdhgahsfghasfdhghas &nbsp;
        <input style="font-family:MS Sans Serif;background:BBDDFF;color:000000;font-size:10pt" type="text" name="Casella1" size=15>
      <br>
      <br>
      asfdgasgjashgasdhfkasjhdgfkhasgdasgfdsdfhwdhgfwsghwsf &nbsp;
        <input style="font-family:MS Sans Serif;background:BBDDFF;color:000000;font-size:10pt" type="text" name="Casella2" size=15>
      <br>
      <br>
      asfdgasgjashgasdhfkasjhdgfkhasgdf &nbsp;
        <input style="font-family:MS Sans Serif;background:BBDDFF;color:000000;font-size:10pt" type="text" name="Casella3" size=15>
      <br>
      <br>
      asfdgasgjashgasdhfkasjhdgfkhasgdf &nbsp;
        <input style="font-family:MS Sans Serif;background:BBDDFF;color:000000;font-size:10pt" type="text" name="Casella4" size=15>
      <br>
      <br>
    </div></td></table></Form></td><tr><td colspan=2 align= bgcolor=""><td><font color="000000" face="MS Sans Serif"><P align= style="font-size:8pt"></p></font></td><tr><tr><td colspan=2 align= bgcolor=""><td><font color="000000" face="MS Sans Serif"><P align=style="font-size:8pt"></p></td><tr><td colspan=2 align= bgcolor=""><td><font color="000000" face="MS Sans Serif"><P align=style="font-size:8pt"></p><tr><td></td><tr><br><br><td align=center><table align="center" width="120" cellpadding="6"><td align="center" bgcolor="B0D8FF" width="100" height="35"><input type="button" name="Bottone" style="background:RGB(0,128,192);color:white" value=" Salva i risultati "></td></table>
        <p>&nbsp;</p></td></tr>
<table border="0" width="92%" bgcolor="000040">
<td align= "center"><font color="FFFFFF"size=1> Realizzato da: </font><font color="FF0000" size=2> Ldn</font></td></table>
</BODY></HTML>


se provate a creare la pèagina html e provate a fare l'esercizio vi accorgerete che le risposte contenute nel codice (nelle rispettive asso1,2,3 ecc) non sono le stesse che il browser richiede.
analizzando il codice vbscript mi è saltata all'occhio la funzione Function xorc(intx,acto) che credo adoperi una specie di criptaggio delle informazioni ma che però non sono riuscito a decifrare non essendo bravo con vbscript.
se qualcuno sapesse "tradurmi il codice in linguaggio umano" gliene sarei grato.
(spero di essermi spiegato)
saluti
che sboro !!
Ldn
Newbies
 
Posts: 97
Joined: Tue Sep 12, 2006 5:09 pm
Top

Problema vbscript

Sponsor

Sponsor

Top
Post a reply

Return to Altri

Who is online

Users browsing this forum: No registered users and 1 guest

Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group

phpBB SEO
cron