| "&item & " | " & Request.ServerVariables(item) & " |
| Request.Cookies | ||
| <% =x %> | <% =y %> | <% =Request.Cookies(x)(y) %> |
| <% =x %> | <% =Request.Cookies(x) %> | |
| Session.Contents | ||
| <% =Session.Contents(x) %> | ||
Table:<% =fTableName %>
<% if rss.EOF or rss.BOF then Response.Write "Nessun elemento trovato" & vbCrLf else %> <% do until rss.EOF %>| <%=rss.fields(rip).name%> | <%=rss.fields(rip).value%> |
| <%=rss.fields(rip).name%> | <%next%>
| <%=rss.fields(rip).value%> | <%next%>
'non funziona se il nome inizia con HTTP:// or http://www. chiama LS_FilePath
immagine = Server.MapPath(Immagine)
LS_ImgSize = LS_IMGSIZE2(Immagine)
END FUNCTION ' LS_ImgSize
'-----------------------------------------------------------------------------
FUNCTION LS_IMGSIZE2 (byval Immagine)
' Come LS_ImgSize ma vuole in input un nome di file fisico completo
'Ottiene la dimensione in #pixel di una immagine .jpg .gif .bmp
' uso Immagine = "tuaimmagine.jpg" 'nome file completo
' Dimensione = LS_ImgSize(Immagine)
' Response.Write "Larghezza: " & Dimensione(0) & " pixel" & "
Dim Dimensione,Formato,start,max,xs,xe,ys,ye,fso,ts,s
Dimensione = Array("","")
Formato = Right(UCase(Immagine),3)
Select Case Formato
Case "JPG"
start = 167 : max = 4 : xs=3 : xe=4 : ys=1 : ye=2
Case"GIF"
start=10 : max=4 : xs=2 : xe=1 : ys=4 : ye=3
Case "BMP"
start = 24: max = 8 : xs = 4 : xe=3 : ys=8 : ye=7
End Select
IF LS_FILEEXISTS(Immagine) THEN
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(Immagine,1)
s = Right(ts.Read(start), max)
Dimensione(0) = LS_HEXTODEC(LS_HEXAT(s,xs) & LS_HEXAT(s,xe))
Dimensione(1) = LS_HEXTODEC(LS_HEXAT(s,ys) & LS_HEXAT(s,ye))
ts.Close
ELSE
Dimensione(0) = 0
Dimensione(1) = 0
END IF
LS_ImgSize2 = Dimensione
END FUNCTION ' LS_ImgSize2
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - -
FUNCTION LS_HEXAT(s, n)
LS_HEXAT = hex(asc(mid(s, n, 1)))
If len(LS_HEXAT) = 1 then LS_HEXAT = "0" & LS_HEXAT
END FUNCTION
'- - - - - - - - - - - - - - -- - - - - - - - - - - - -- - - - - - - - - - - - -
FUNCTION LS_HEXTODEC(cadhex)
Dim n, i, ch, decimal
decimal = 0
n = Len(cadhex)
For i = 1 to n
decimal = decimal * 16
ch = Mid(cadhex, i, 1)
decimal = decimal + inStr("0123456789ABCDEFabcdef", ch) - 1
Next
LS_HEXTODEC = decimal
END FUNCTION 'LS_HEXTODEC
'________________________________________________________________
SUB LS_LOG_APPEND(byval stringa)
dim strUrl, FS, F, testo, modulo
strUrl = Request.ServerVariables("URL")
modulo = Right(strUrl, (Len(strUrl) - InStrRev(strUrl, "/")))
IF trim(stringa) <> "" then
Set fs=Server.CreateObject("Scripting.FileSystemObject")
Set f=fs.OpenTextFile(Server.MapPath("public\trxlog.log"), 8,true, -2)
'8=xappend, true=crea se non esiste -2=system default format
testo = now() & " " & modulo & " | " & stringa & vbCrLf
f.write(testo)
f.close
set f=nothing
set fs=nothing
END IF
END SUB 'LS_LOG_APPEND
'--------------------------------------------------------------------------------------------------
FUNCTION LS_Last_Upd_Web()
' Fornisce la data di ultimo aggiornamento della pagina
' Da usare con LS_Stampa_NomePagina che fornisce il nome della pagina
dim original_lcid
original_lcid = Session.LCID
Session.LCID=1040 'Imposto il formato italiano per la Sessione corrente
Dim file, fs, f, LastModified
file = Request.ServerVariables("PATH_TRANSLATED")
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(file)
LastModified = f.datelastmodified
Response.Write (FormatDateTime(LastModified, 0))
Set f = Nothing
Set fs = Nothing
Session.LCID = original_lcid
END FUNCTION 'LS_Last_Upd_Web
'____________________________________________________________________
FUNCTION LS_LireInEuro (ByVal lire)
'Restituisce il valore in euro. FUNCTION sorella di LS_EuroInLire
Const Euro = 1936.27
Dim e
e = FormatCurrency((lire/Euro), 2)
LS_LireInEuro = e
END FUNCTION 'LS_LireInEuro
'________________________________________________________________________
FUNCTION LS_MESE_IT(byval mmm)
dim strout
Select case mmm
case 1: strout="Gennaio"
case 2: strout="Febbraio"
case 3: strout="Marzo"
case 4: strout="Aprile"
case 5: strout="Maggio"
case 6: strout="Giugno"
case 7: strout="Luglio"
case 8: strout="Agosto"
case 9: strout="Settembre"
case 10: strout="Ottobre"
case 11: strout="Novembre"
case 12: strout="Dicembre"
end select
LS_MESE_IT = strout
END FUNCTION
'_________________________________________________
FUNCTION LS_MESE3_IT(byval mmm)
dim strout
strout = left(LS_MESE_IT(mmm),3)
LS_MESE3_IT = strout
END FUNCTION
'__________________________________________________________________________
SUB LS_NoClick() %>
<%
END SUB
'____________________________________________________________________
FUNCTION LS_NomeFile() 'Test=ok
dim strUrl, strPath
strUrl = Request.ServerVariables("URL")
strPath = Right(strUrl, (Len(strUrl) - InStrRev(strUrl, "/")))
LS_NomeFile = strPath
END FUNCTION
'__________________________________________________________________________
SUB LS_NO_CACHE_PAGE() 'Test da fare
response.expires = -1500
response.AddHeader "PRAGMA", "NO-CACHE"
response.CacheControl = "PRIVATE"
END SUB 'LS_NO_CACHE_PAGE
'____________________________________________________________________
FUNCTION LS_PRINDATA (byval ctrin)
' Gira una data AAAAMMGG ed aggiunge le barre
' esempio LS_PRINDATA("20051131") restituisce "31/11/2005"
dim ctrot
ctrot= right(ctrin,2)
ctrot= ctrot & "/"
ctrot= ctrot & mid(ctrin,5,2)
ctrot= ctrot & "/"
ctrot= ctrot & left(ctrin,4)
LS_PRINDATA = ctrot
END FUNCTION 'LS_PRINDATA
'____________________________________________________________________
FUNCTION LS_PRsoloDATA (byval datain)
' DEVE ESSERE UNA DATA o null
DIM ctrot
if isnull(datain) then
ctrot =""
else
ctrot = FormatDateTime(datain,2)
end if
LS_PRsoloDATA = ctrot
END FUNCTION 'PRsoloDATA
'____________________________________________________________________
FUNCTION LS_QUARTI (byval stringa)
' Cambia .25 .50 .75 in ¼ ½ ¾ 'da finire e da testare
Dim xxx, yyy
xxx = "" & stringa
yyy = ""
'yyy=L_REPSTRING('.25','¼',xxx);
' xxx=L_REPSTRING('.50','½',yyy);
' yyy=L_REPSTRING('.75','¾',xxx);
LS_QUARTI = yyy
END FUNCTION ' LS_QUARTI
'____________________________________________________________________
FUNCTION LS_RANDOM(max)
Randomize
LS_RANDOM = Int(Rnd * max) + 1
END FUNCTION
'____________________________________________________________________
FUNCTION LS_Refresh (byval nsec) 'ricaricare la pagina ogni n secondi Test= NON ESEGUITO
' aggiunge un HTTP , non più removibile
' nella pagina é 5= 5 secondi
Response.AddHeader "Refresh", nsec
END FUNCTION
'____________________________________________________________________
SUB LS_Stampa_NomePagina() 'Test=ok
Response.Write(UCase(LS_NomeFile))
END SUB
'_____________________________________________________________
FUNCTION LS_STRING_CHG(byval stringa, byval oldcrt, byval newcrt)
'NOTA: oldcrt e newcrt lunghi 1
DIM strot, ind
if isnull(stringa) or isEmpty(stringa) then
strot = ""
else
For ind = 1 to len(stringa)
if mid(stringa,ind,1) = oldcrt then
strot = strot & newcrt
else
strot = strot & mid(stringa,ind,1)
end if
Next
end if
LS_STRING_CHG = strot
END FUNCTION 'LS_STRING_CHG
'-------------------------------------------------------------------------------------------
FUNCTION LS_STRING_VP (byval stringa)
' la virgola diventa punto
LS_STRING_VP = LS_STRING_CHG(stringa,",",".")
END FUNCTION 'S_STRING_VP
'___________________________________________________________________________
SUB LS_SW_ET_NOW()
'
' Stampa Identificazione transazione, la data di aggiornamento e adesso
'
Response.Write("Trx ")
Response.Write(UCase(LS_NomeFile))
Response.Write(" <|> ")
Response.Write("Sw upd at ")
Response.Write(LS_Last_Upd_Web)
Response.Write(" <|> ")
Response.Write("Now ")
Response.Write(LS_DT(Now,"dmy"))
END SUB 'LS_SW_ET_NOW
'---------------------------------------------------------------------------------
FUNCTION LS_WEEKNBR (vDate,sWeekType)
' DatePart(intervallo, data, primogiornosettimana, primasettimanaanno)
' intervallo s=secondi n=minuti h=ore d=giorni, y=giorno dell anno w=giorno della settimana ww=settimana dell anno
' m=mese q=trimestre yyyy=anno
' data (obbligatorio)
' primogiornosettimana vbUseSystem 0 Usa impostaz API NLS
' vbSunday 1 Domenica impostaz predefinita
' vbMonday 2 Lun, vbTuesday 3 Mar, vbWednesday 4 Mercoledi, vbThursday 5 Giovedi
' vbFriday 6 ven, vbSaturday 7 Sabato
' primasettimanaanno vbUseSystem 0 Usa impostaz API NLS
' vbFirstJan1 1 ssettim del 1° gennaio (impostaz predefinita
' vbFirstFourdays 2, vbFirstFullWeek 3
Dim intWeek
intWeek = DatePart("ww", DateValue(vDate), 0, sWeekType)
LS_WEEKNBR = intWeek
END FUNCTION '--- LS_WEEKNBR
'-------------------------------------------------------------------------------------------------------------------
'___________________________ FINE VBS_FMLIB.asp __________________
%>