<%@ Language=VBScript %>
<% Option Explicit %>
Hotel Elvezia - listino prezzi
<%
public Var(50), Chiave(4), ciclo, RS, prod, sel, conf, coll, collweb, MyConn, SRS, DRS, prs
Chiave(1) = "$loopstart"
Chiave(2) = "$MyVar"
Chiave(3) = "$loopend"
Chiave(4) = ")"
sel = 0
%>
<%
dim file, strDirectory, FSO, s
strDirectory = Server.MapPath(".")
file = strDirectory & "\periodi.htm"
Set FSO = CreateObject("Scripting.FileSystemObject")
s = ApriFile(FSO, file)
%>
<%
Function ApriFile(FSO, file)
Dim TextStream, S, t, ct, i, mem, linea(500)
Const OpenFileForReading = 1
Const OpenFileForWriting = 2
Const OpenFileForAppending = 8
ciclo = 1
mem = 0
Set File = FSO.GetFile(file)
Set TextStream = File.OpenAsTextStream(OpenFileForReading)
Do While Not TextStream.AtEndOfStream
t = TextStream.ReadLine
for i = 1 to 3
ct = instr (1, t, Chiave(i))
if ct > 0 then
t = database (t, i)
end if
next
select case ciclo
case 1
response.write t & vbNewLine
case 2
mem = mem + 1
linea(mem) = t
case 3
ciclo = sviluppa(linea, mem)
end select
loop
TextStream.Close
End Function
%>
<%
Function database (t, i)
select case i
case 1
t = "" & vbNewLine
ciclo = 2
case 2
case 3
t = "" & vbNewLine
ciclo = 3
end select
database = t
End Function
%>
<%
Function sviluppa (righe(), m)
dim i, a, h, r, t, l, s, Tav
OpenDataBase
access
for i=14 to 15
Punto(i)
next
i = 2
while i <= m
t = righe(i)
a = instr(1, t, Chiave(2))
Do while a > 0
r = instr(a, t, Chiave(4))
if r = 0 then errore
l = mid(t, a + 7, r - a - 7)
t = mid(t, 1, a - 1) & Var(l) & mid(t, r + 1)
a = instr(a, t, Chiave(2))
Loop
response.write t & vbNewLine
i = i + 1
wend
RS.Close
srs.close
prs.close
MyConn.Close
sviluppa = 1
End Function
%>
<%
sub OpenDataBase()
Set MyConn = Server.CreateObject("ADODB.Connection")
MyConn.Open "elvezia"
set RS = MyConn.Execute("SELECT * FROM Datario")
rs.movefirst
If RS.BOF AND RS.EOF Then
errore
end if
set SRS = MyConn.Execute("SELECT * FROM supplemento")
srs.movefirst
If SRS.BOF AND SRS.EOF Then
errore
end if
set PRS = MyConn.Execute("SELECT * FROM Periodi")
rs.movefirst
If PRS.BOF AND PRS.EOF Then
errore
end if
end sub
%>
<%
sub access()
dim k, temp
rs.movefirst
for k = 1 to 8
if RS(1) <> " " then Var(k) = RS(1) & " - " & RS(2)
rs.movenext
next
srs.movefirst
for k = 9 to 15
Var(k) = SRS(2)
srs.movenext
next
prs.movefirst
for k = 16 to 19
Var(k) = PRS(1)
prs.movenext
next
End sub
%>
<%
sub punto (y)
dim i, x, a
a = Var(y)
do
i = instr(a, ".")
if i > 0 then
a = mid(a, 1, i - 1) & mid(a, i + 1)
end if
loop until i = 0
x = instr(a, ",")
if x=0 then
x = len(a)
else
a = mid(a, 1, x + 2)
x = x - 1
end if
do
if x > 3 then
a = mid(a, 1, x - 3) & "." & mid(a, x - 2)
end if
x = x - 3
loop until x <= 0
var(y)=a
end sub
%>
<%
sub errore
%>
<%
end sub
%>