" & vbcrlf
Response.End
End If
next
conn.errors.Clear
End If
'Se le righe qui sopra vengono lasciate commentate, tutti gli errori vengono bypassati fino a raggiungere una riga simile
'alla successiva.
'On Error Goto 0
End If
if len(request("LANG")) > 1 then
Set lng = Server.CreateObject("ADODB.Recordset")
SQL = "SELECT * FROM " & application("prefix") & "configurazione_lingue where codice='" & request("lang") & "'"
lng.open sql, conn, adOpenStatic, adLockOptimistic
if lng.EOF AND lng.BOF Then
Session("LANGUAGE") = lcase(Application("LANGUAGE"))
else
Session("language") = lcase(lng("codice"))
end if
lng.close
set lng = nothing
end if
if len(session("LANGUAGE")) > 0 then
Set lng = Server.CreateObject("ADODB.Recordset")
SQL = "SELECT * FROM " & application("prefix") & "configurazione_lingue where codice='" & Session("language") & "'"
SET lng = conn.execute(sql)
session.lcid = lng("lcidstring")
Session("langdir") = lng("langdir")
Session("backofficelanguage") = Session("language")
Session("encoding") = lng("charset")
response.Charset= Session("encoding")
if int(lng("visibile")) = 0 then
Session("language") = Application("language")
end if
set lng = nothing
else
Set lng = Server.CreateObject("ADODB.Recordset")
SQL = "SELECT * FROM " & application("prefix") & "configurazione_lingue where codice='" & Application("language") & "'"
SET lng = conn.execute(sql)
session.lcid = lng("lcidstring")
Session("langdir") = lng("langdir")
Session("backofficelanguage") = Session("language")
Session("encoding") = lng("charset")
response.Charset= Session("encoding")
if int(lng("visibile")) = 0 then
Session("language") = Application("language")
end if
set lng = nothing
end if
Set xs = Server.CreateObject("ADODB.Recordset")
sql = "SELECT * FROM " & application("prefix") & "configurazione where elemento='xstandard_Autoinstall' or elemento='xstandard_Version'"
SET xs = conn.execute(sql)
do until xs.eof
if xs("elemento") = "xstandard_Autoinstall" then
Session("xstandard_Autoinstall") = xs("valore")
end if
if xs("elemento") = "xstandard_Version" then
Session("xstandard_Version") = xs("valore")
end if
xs.movenext
Loop
set xs = nothing
'========================================================================
' Definizione standard delle costanti del Database (da adovbs.inc)
' Rimuovere se si include il file adovbs.inc
'---- CursorTypeEnum Values ----
Const adOpenForwardOnly = 0
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Const adOpenStatic = 3
'---- LockTypeEnum Values ----
Const adLockReadOnly = 1
Const adLockPessimistic = 2
Const adLockOptimistic = 3
Const adLockBatchOptimistic = 4
'---- CursorLocationEnum Values ----
Const adUseServer = 2
Const adUseClient = 3
'========================================================================
' Caricamento stringhe
'CARICAMENTO BACKOFFICE_XX.XML
dim DICLanguage (450)
Set objDoc = Server.CreateObject("MSXML2.DOMDocument.4.0")
objDoc.async = False
descpath = Server.mapPath("\files\xml\backoffice_" & Session("backofficelanguage") & ".xml")
set fs=Server.CreateObject("Scripting.FileSystemObject")
if fs.FileExists(descpath)=true then
else
descpath = Server.mapPath("\files\xml\backoffice_" & Application("language") & ".xml")
end if
set fs=nothing
If Not objDoc.load(descpath) Then
Response.write "
"
else
For Each objNode In objDoc.selectNodes("/strings/row")
ID_LANG = objNode.selectSingleNode("ref").Text
'ID_STRINGA = objNode.selectSingleNode("content[lang('it')]").Text
ID_STRINGA = objNode.selectSingleNode("content").Text
Set objRE = New RegExp
objRE.Global = True
' Add lang attribute as per Appendix C Compatibility recommendation
objRE.Pattern = "(xml:(lang=""[\S]*""))"
ID_STRINGA = objRE.Replace(ID_STRINGA, "$1 $2")
' Add space for self-closing elements as per Appendix C Compatibility recommendation
objRE.Pattern = "([^\s]+)(/>)"
ID_STRINGA = objRE.Replace(ID_STRINGA, "$1 $2")
' Release memory
Set objRE = Nothing
DICLanguage(ID_LANG) = ID_STRINGA
Next
End If
Set objDoc = Nothing
Set objNode = Nothing
'CARICAMENTO BACKOFFICE_MNU_XX.XML
dim MNULanguage (450)
Set objDoc = Server.CreateObject("MSXML2.DOMDocument.4.0")
objDoc.async = False
descpath = Server.mapPath("\files\xml\backoffice_mnu_" & Session("backofficelanguage") & ".xml")
set fs=Server.CreateObject("Scripting.FileSystemObject")
if fs.FileExists(descpath)=true then
else
descpath = Server.mapPath("\files\xml\backoffice_mnu_" & Application("language") & ".xml")
end if
set fs=nothing
If Not objDoc.load(descpath) Then
Response.write "
<%end sub
if Session("supervisor") = true then
aggiunta_sql = ""
aggiunta_where_sql = ""
else
aggiunta_sql = " and office_id=" & Session("Office_ID")
aggiunta_where_sql = " where office_id=" & Session("Office_ID")
end if
Dim strCat
If request("cat") = "" then
if session("supervisor") = true then
strCat = 0
else
strCat = Session("ArgoID")
end if
else
strCat = request("cat")
end if
Function IIf(a,b,c)
if a then
IIf = b
else
IIf = c
end if
End Function
Function getParentID(intCatID)
sql = "SELECT parentid FROM " & application("prefix") & "documenti WHERE id=" & intCatID & " and argomento=1 and visibile_" & Session("Language") & "=1" & aggiunta_sql & " order by title_" & Session("Language")
Set objRS = conn.execute(sql)
if not objRS.eof then
getParentID = objRS("parentid")
else
if session("supervisor") = true then
getParentID = 0
else
getParentID = Session("ArgoID")
end if
end if
Set objRS = nothing
End Function
Function GetCategoryList(intCatID)
Dim strHTML, intParentID
if cInt(intCatID) = 0 then
if session("supervisor") = true then
intParentID = 0
else
intParentID = cint(session("ArgoID"))
end if
else
intParentID = cInt(intCatID)
end if
if intparentid = 0 then
sql = "Select * from " & application("prefix") & "documenti where visibile_" & Session("Language")& "=1 " & aggiunta_sql & " and argomento=2 order by posizione"
Set MapRS = conn.execute(sql)
if not MapRS.eof and not Maprs.bof then
while not MapRS.eof
sql = "SELECT * FROM " & application("prefix") & "documenti WHERE areaid=" & maprs("id") & " and parentid=" & intParentID & " and argomento=1" & aggiunta_sql & " order by posizione"
Set objRS = conn.execute(sql)
strHTML = strHTML & "
" & vbcrlf
end if
end if
objRS.movenext
loop
set objRS = nothing
strHTML = strHTML & "
" & vbcrlf
MapRS.movenext
Wend
end if
MapRS.close
set MapRS = nothing
else
sql = "SELECT * FROM " & application("prefix") & "documenti WHERE parentid=" & intParentID & " and argomento=1" & aggiunta_sql & " order by posizione"
Set objRS = conn.execute(sql)
strHTML = "
" & vbcrlf
if objRS.eof then
strHTML = strHTML & "
(" & DICLanguage(260) & ") |
" & vbcrlf & "
" & vbcrlf
end if
do while not objRS.eof
if objRS("id") <> 0 then
if int(objRS("visibile_" & Session("Language"))) = 1 then
strHTML = strHTML & "
" & vbcrlf
end if
end if
GetCategoryList = strHTML
End Function
Class Category
Public id, parentid, category
End Class
Function getParent(intID)
strSQL = "SELECT * FROM " & application("prefix") & "documenti WHERE id = " & intID & " and argomento=1 and visibile_" & Session("Language")& "=1" & aggiunta_sql
Set objRS1 = conn.execute(strSQL)
Set objTemp = new Category
If objRS1.EOF AND objRS1.BOF then
objTemp.id = 0
objTemp.parentid = 0
objTemp.category = 0
set getParent = objTemp
else
Set objTemp = new Category
objTemp.id = objRS1("id")
objTemp.parentid = objRS1("parentid")
objTemp.category =FixString(objRS1("title_" & Session("Language")),"d")
end if
set getParent = objTemp
objRS1.close
set objRS1 = nothing
End Function
Function constructCategory(objCategory)
strParent = objCategory.parentid
strCategory = objCategory.category
do while strParent <> 0
strCategory = getParent(strParent).category & "\" & strCategory
strParent = getParent(strParent).parentid
loop
constructCategory = strCategory
End Function
Function getCategoryName(intCatID)
if cInt(intCatID) = 0 then
if session("supervisor") = true then
intParentID = 0
else
intParentID = Session("ArgoID")
end if
else
intParentID = cInt(intCatID)
end if
sql = "SELECT * FROM " & application("prefix") & "documenti WHERE id=" & intCatID & " and argomento=1" & aggiunta_sql & " order by posizione"
Set objRS = conn.execute(sql)
if objRS.eof and objrs.bof then
getCategoryName = "\"
else
Set objTemp = new Category
objTemp.id = objRS("id")
objTemp.parentid = objRS("parentid")
if int(objRS("visibile_" & Session("Language"))) = 1 then
objTemp.category = FixString(objRS("title_" & Session("Language")),"d")
else
objTemp.category = "* " & FixString(objRS("title_" & Session("Language")),"d")
end if
strCategory = constructCategory(objTemp)
Set objRS = nothing
getCategoryName = strCategory
end if
End Function
Function GetDocumentList(intCatID)
Dim strHTML
if cInt(intCatID) = 0 then
if session("supervisor") = true then
intParentID = 0
else
intParentID = Session("ArgoID")
end if
else
intParentID = cInt(intCatID)
end if
if CMS_DB = "MYSQL" Then
strSQL = "SELECT Count(*) AS records FROM " & application("prefix") & "documenti WHERE catid=" & cInt(intCatID) & " and argomento=0" & aggiunta_sql & " order by posizione"
Set objRS3 = Conn.execute(strSQL)
intrecords = cint(objRS3("records"))
objRS3.close
set objrs3 = nothing
'intPageSize = int(maxitems)
'intStart = currentPage*intPageSize
'intStart = intStart-intPageSize
'intPages = int(intRecords/intPageSize) +1
SQL = "SELECT * FROM " & application("prefix") & "documenti WHERE catid=" & cInt(intCatID) & " and argomento=0" & aggiunta_sql & " order by posizione" & " LIMIT " & intStart & ", " & intPageSize
else
strSQL = "SELECT * FROM " & application("prefix") & "documenti WHERE catid=" & cInt(intCatID) & " and argomento=0" & aggiunta_sql & " order by posizione"
end if
Set objRS2 = Server.CreateObject("ADODB.RecordSet")
'Paginazione -----------------------------------------------
'NUMERO MASSIMO DI RECORD PER PAGINA
maxitems = cint(Application("maxitems"))
'RECUPERA NUMERO PAGINA ATTUALE
If Not IsEmpty(Request("sp")) then
currentPage = Request("sp")
End If
'IN CASO DI PROBLEMI ASSEGNA LA PAGINA 1
if currentPage = "" OR not isNumeric(currentPage) then
currentPage = int(1)
else
currentPage = int(currentPage)
end if
if request("st") <> "" and request("fn") <> "" then
ordinamento = request("fn") & " " & request("st")
else
ordinamento = "posizione"
end if
if CMS_DB = "MYSQL" Then
intPageSize = int(maxitems)
intStart = currentPage*intPageSize
intStart = intStart-intPageSize
intPages = int(intRecords/intPageSize)' +1
sql = "SELECT * FROM " & application("prefix") & "documenti WHERE catid=" & cInt(intCatID) & " and argomento=0" & aggiunta_sql & " order by " & ordinamento & " LIMIT " & intStart & ", " & intPageSize
else
sql = "SELECT * FROM " & application("prefix") & "documenti WHERE catid=" & cInt(intCatID) & " and argomento=0" & aggiunta_sql & " order by " & ordinamento
end if
If CMS_DB = "SQL" or CMS_DB = "MYSQL" Then
objrs2.CursorLocation = adUseClient
End If
objRS2.open sql, conn, adOpenStatic, adLockOptimistic
'Nessun documento trovato
If objRS2.EOF AND objRS2.BOF then
strHTML = strHTML & "
" & vbcrlf
objRS2.Close
set objRS2 = nothing
GetDocumentList = strHTML
exit function
End If
if CMS_DB = "ACCESS" or CMS_DB = "SQL" then
objrs2.Pagesize= MaxItems
objrs2.AbsolutePage = CurrentPage
intPages = objRS2.PageCount
intrecords = objrs2.recordcount
end if
if intpages = 0 then intpages = 1
if CMS_DB = "MYSQL" then
intpages = intpages -1
end if
strHTML = "" & vbcrlf
objrs2.close
set objRS2 = nothing
GetDocumentList = strHTML
End Function
'DATA IN FORMATO ISO
Function return_RFC822_Date(myDate, offset)
Dim myDay, myDays, myMonth, myYear
Dim myHours, myMonths, mySeconds
myDate = CDate(myDate)
myDay = WeekdayName(Weekday(myDate),true)
myDays = Day(myDate)
myMonth = MonthName(Month(myDate), true)
myYear = Year(myDate)
myHours = zeroPad(Hour(myDate), 2)
myMinutes = zeroPad(Minute(myDate), 2)
mySeconds = zeroPad(Second(myDate), 2)
return_RFC822_Date = myDay&", "& _
myDays&" "& _
myMonth&" "& _
myYear&" "& _
myHours&":"& _
myMinutes&":"& _
mySeconds&" "& _
offset
End Function
Function zeroPad(m, t)
zeroPad = String(t-Len(m),"0")&m
End Function
Function GetW3DTF(dtmDate,offset)
Dim strDate
strDate = DatePart("yyyy", dtmDate) & "-" & zeropad(DatePart("m", dtmDate),2) & "-" & zeropad(DatePart("d", dtmDate),2) & "T" &_
zeropad(DatePart("h", dtmDate),2) & ":" & zeropad(DatePart("n", dtmDate),2) & ":" & zeropad(DatePart("s", dtmDate),2) & offset
GetW3DTF = strDate
End Function
ENCKEY = cstr(Application("ENCKEY"))
Function Encrypt(Stringa)
Encrypt = Binary2StringaHex(EncryptStringa(Stringa, ENCKEY))
End Function
Function Decrypt(Stringa)
Decrypt = Trim(EncryptStringa(StringaHex2Binary(Stringa), ENCKEY))
End Function
Function EncryptStringa(Stringa, Chiave)
lChiave = 0
For p = 1 to Len(Chiave)
lChiave = lChiave + Asc(Mid(Chiave,p,1))
Next
Rnd (-1 * lChiave)
Buffer = ""
For p = 1 To Len(Stringa)
c = Asc(Mid(Stringa, p, 1)) - 32
c1 = (c Xor (Int(Rnd() * 64))) + 32
Buffer = Buffer & Chr(c1)
Next
EncryptStringa = Buffer
End Function
Function Binary2StringaHex(Stringa)
Buffer = ""
For k = 1 To Len(Stringa)
Buffer = Buffer + HexValue(Asc(Mid(Stringa, k, 1)), 2)
Next
Binary2StringaHex = Buffer
End Function
Function HexValue(valore, Cifre)
HexValue = Right(String(Cifre, "0") + Hex(valore), Cifre)
End Function
Function StringaHex2Binary(Stringa)
Buffer = ""
For k = 1 To Len(Stringa) Step 2
HexVal = "&H" + Mid(Stringa, k, 2)
Buffer = Buffer + Chr(cint(HexVal))
Next
StringaHex2Binary = Buffer
End Function
%>