<%
 ' Fruibile - L'elemento CMS Open Source che mancava
 ' Copyright (C) 2002-2006 Roberto Scano
 ' 
 ' Licensed under the terms of the GNU Lesser General Public License:
 ' 		http://www.opensource.org/licenses/lgpl-license.php
 ' 
 ' For further information visit:
 ' 		http://www.fruibile.it/
 ' 
 ' File Author:
 ' 		Roberto Scano (mail@robertoscano.info)
%>
<%
If IsEmpty(Session("WEBGODLogin")) Or IsNull(Session("WEBGODLogin")) Or Session("WEBGODLogin")="" Then
	response.redirect "/backoffice/default.asp"
	response.end
End If
'Prevent your website from cross website attacks ---------
refererUrl = Cstr(Request.ServerVariables("HTTP_REFERER"))
serverName = Cstr(Request.ServerVariables("SERVER_NAME"))
refererName = mid(refererUrl,8,len(serverName)) 
if refererName <> serverName then
   response.Redirect "/backoffice/noentry.asp"
   response.end
end if
'---------------------------------------------------------

%>
<%
Private Function analyseCSS(ByVal strCSS)
    Dim strCSSResults
    Dim objRE, objMatches, objMatch
    Dim arProperty(100), arValue(100), arCode(100)
    Dim arRows, arCols, iCounter, iProperties, iBackgroundIndex, iForegroundIndex, iSizeIndex
    Dim iStart, iEnd, strStyle, strSelector, strOutputMessage, iLevel, bDisplay
    Dim strTempSelector, strTempContrast, strTempMeasure

    strCSSResults = Trim(ValidateCSS(strCSS))
    If strCSSResults <> "" Then
        analyseCSS = strCSSResults
        Exit Function
    End If

    Set objRE = New RegExp
    objRE.Pattern = "}"
    objRE.Global = True

    ' Get rid of all line feeds
    strCSS = Replace(strCSS, vbCrLf, "")
    strCSS = Replace(strCSS, vbCr, "")
    strCSS = Replace(strCSS, vbLf, "")
    ' Replace tabs with a space
    strCSS = Replace(strCSS, vbTab, " ")

    ' Get each rule by looking for a closing curly brace
    Set objMatches = objRE.Execute(strCSS)

    If objMatches.Count > 0 Then ' Found some rules
        ' Iterate though each CSS rule found
        For Each objMatch In objMatches
            ' Find the start of the rule
            iStart = InStrRev(strCSS, "{", objMatch.FirstIndex)
            strStyle = Mid(strCSS, iStart + 1, objMatch.FirstIndex - iStart)
            
            ' Determine the name provided for the selector
            iEnd = iStart - 1
            iStart = InStrRev(strCSS, "}", iEnd)
            strSelector = Mid(strCSS, iStart + 1, iEnd - iStart)
            ' Remove comments from selector name
            objRE.Pattern = "/\S[^/]*/"
            objRE.Global = True
            strSelector = objRE.Replace(strSelector, "")
            strSelector = Trim(strSelector)

            ' Put the properties along with their values into an array
            arRows = Split(strStyle, ";")
            iProperties = 0

            For iCounter = 0 To UBound(arRows)
                If Trim(arRows(iCounter)) <> "" Then
                    arCols = Split(arRows(iCounter), ":")
                    ' Check the property and value exist, otherwise ignore it
                    If UBound(arCols) > 0 Then
                        ' Property name
                        arProperty(iCounter) = Trim(arCols(0))
                        ' Property value
                        arValue(iCounter) = Trim(arCols(1))
                        ' Colour code if it exists
                        arCode(iCounter) = getCode(arValue(iCounter))
                        iProperties = iProperties + 1
                    End If
                End If
            Next

            iBackgroundIndex = -1
            iForegroundIndex = -1
            iSizeIndex = -1
            iLevel = 0
            
            ' Because of the cascading nature of CSS, locate the final
            ' declaration of a colour code in this rule
            For iCounter = iProperties - 1 To 0 Step -1
                If InStr(1, arProperty(iCounter), "background", vbTextCompare) Then
                    If arCode(iCounter) <> "None" Then
                        iBackgroundIndex = iCounter
                        Exit For
                    End If
                End If
            Next
            
            ' Find foreground colour
            For iCounter = iProperties - 1 To 0 Step -1
                If LCase(arProperty(iCounter)) = "color" Then
                    If arCode(iCounter) <> "None" Then
                        iForegroundIndex = iCounter
                        Exit For
                    End If
                End If
            Next

            ' Find size information
            For iCounter = iProperties - 1 To 0 Step -1
                If InStr(1, arProperty(iCounter), "font:", vbTextCompare) Or _
                   InStr(1, arProperty(iCounter), "font-size", vbTextCompare) Or _
                   InStr(1, arProperty(iCounter), "margin", vbTextCompare) Or _
                   InStr(1, arProperty(iCounter), "padding", vbTextCompare) Or _
                   InStr(1, arProperty(iCounter), "width", vbTextCompare) Then
                    iSizeIndex = iCounter
                    Exit For
                End If
            Next

            ' If we have a foreground or background colour code, or a size, test it
            If iBackgroundIndex <> -1 Or iForegroundIndex <> -1 Or iSizeIndex <> -1 Then
                strTempContrast = ""
                strTempMeasure = ""
                strTempSelector = "<h3>" & DICLanguage(355) & ": " & strSelector & "</h3>" & vbCrLf

                If iBackgroundIndex <> -1 And iForegroundIndex <> -1 Then
                    ' Foreground and background colours specified, so display both
                    strTempContrast = strTempContrast & "<ul>" & vbCrLf
                    strTempContrast = strTempContrast & "<li>" & DIClanguage(339) & ": " & arValue(iForegroundIndex) & "</li>" & vbCrLf
                    strTempContrast = strTempContrast & "<li>" & DIClanguage(340) & ": " & arValue(iBackgroundIndex) & "</li>" & vbCrLf
                    strTempContrast = strTempContrast & "</ul>" & vbCrLf

                    ' If neither are transparent, calculate the contrast,
                    ' otherwise display warning as it requires checking
                    If InStr(LCase(arValue(iForegroundIndex)), "transparent") = 0 And InStr(LCase(arValue(iBackgroundIndex)), "transparent") = 0 Then
                        iLevel = calculateContrast(arCode(iForegroundIndex), arCode(iBackgroundIndex), strTempMeasure)
                    Else
                        iLevel = 0
                    End If
                End If

                If iSizeIndex <> -1 Then
                    strTempMeasure = strTempMeasure & "<dl>" & vbCrLf
                    For iCounter = 0 To iProperties - 1
                        If InStr(1, arProperty(iCounter), "font:", vbTextCompare) Or _
                           InStr(1, arProperty(iCounter), "font-size", vbTextCompare) Or _
                           InStr(1, arProperty(iCounter), "margin", vbTextCompare) Or _
                           InStr(1, arProperty(iCounter), "padding", vbTextCompare) Or _
                           InStr(1, arProperty(iCounter), "width", vbTextCompare) Then
                            strTempMeasure = strTempMeasure & "<dt>" & arProperty(iCounter) & ": " & arValue(iCounter) & "</dt>"
                            ' List of absolute sizes
                            objRE.Pattern = "\dpt|\dpx|\din|\dcm|\dmm|\dpc"
                            If objRE.Test(arValue(iCounter)) = True Then
                                strTempMeasure = strTempMeasure & "<dd>" & DIClanguage(341) & ".</dd>" & vbCrLf
                                iLevel = 2
                            End If
                        End If
                    Next
                    strTempMeasure = strTempMeasure & "</dl>" & vbCrLf
                End If

                ' Determine if this requires reporting
                Select Case iLevel
                    Case 0
                        bDisplay = 0
                    Case 1, 2
                        bDisplay = 1
                End Select

                If bDisplay = 1 Then
                    strOutputMessage = strTempSelector & strTempContrast & strTempMeasure & vbCrLf
                End If
            End If
            analyseCSS = analyseCSS & strOutputMessage
            strOutputMessage = ""
        Next
    End If

    Set objMatches = Nothing
    Set objRE = Nothing
End Function

' function to determine whether a background or foreground colour code has been specified
Private Function getCode(ByVal strProperty)
    Dim iStart, iEnd
    Dim strBackground
    
    ' Get codes beginning with a #
    iStart = InStr(1, strProperty, "#")
    If iStart > 0 Then
        ' Get the background colour
        strBackground = Trim(Mid(strProperty, iStart, Len(strProperty) - iStart + 1))
        ' Trim extra bits
        iEnd = InStr(1, strBackground, " ")
        If iEnd > 0 Then
            strBackground = Left(strBackground, iEnd - 1)
        End If
        getCode = strBackground
    Else ' Get literal colours
        strBackground = findColour(strProperty)
        If strBackground <> "" Then
            getCode = strBackground
        ElseIf InStr(1, strProperty, "transparent", vbTextCompare) Then
            getCode = "transparent"
        ElseIf InStr(1, strProperty, "rgb(", vbTextCompare) Then
            iStart = InStr(1, strProperty, "rgb(", vbTextCompare)
            iEnd = InStr(iStart, strProperty, ")")
            If iEnd > 0 Then
                getCode = Mid(strProperty, iStart, iEnd - iStart)
            End If
        Else
            getCode = "None"
        End If
    End If
End Function

' Function to calculate the contrast. This function will either be passed a 3 or 6 digit hexadecimal code
' for the colour, or an rgb function
' Returns:
' 0 - Everything's fine
' 1 - Warning (fails W3C guidelines, but meets HP's guidelines)
' 2 - Contrast not sufficient
Private Function calculateContrast(ByVal strForeground, ByVal strBackground, ByRef strOutputMessage)
    Dim objRE
    Dim iBackgroundBrightness, iForegroundBrightness, iBrightDifference, iColourDifference
    Dim strBackcolour, strForecolour
    Dim iBackgroundRed, iBackgroundGreen, iBackgroundBlue
    Dim iForegroundRed, iForegroundGreen, iForegroundBlue
    Dim arRGB, bRGBBack, bRGBFore, iLevel

    iLevel = 0

    ' Check if the background has been specified in RGB
    If LCase(Left(strBackground, 4)) = "rgb(" Then
        arRGB = Split(Mid(strBackground, 5, Len(strBackground) - 4), ",")
        ' Get the intensities of red, green, and blue
        iBackgroundRed = CInt(arRGB(0))
        iBackgroundGreen = CInt(arRGB(1))
        iBackgroundBlue = CInt(arRGB(2))
        bRGBBack = True
    End If
    
    ' Check if the foreground has been specified in RGB
    If LCase(Left(strForeground, 4)) = "rgb(" Then
        arRGB = Split(Mid(strForeground, 5, Len(strForeground) - 4), ",")
        ' Get the intensities of red, green, and blue
        iForegroundRed = CInt(arRGB(0))
        iForegroundGreen = CInt(arRGB(1))
        iForegroundBlue = CInt(arRGB(2))
        bRGBFore = True
    End If

    ' If background not specified as rgb, get it as hex
    If bRGBBack = False Then
        If Left(strBackground, 1) = "#" Then
            strBackcolour = Mid(strBackground, 2, Len(strBackground) - 1)
        Else
            strBackcolour = strBackground
            strBackground = "#" & strBackground
        End If
    End If

    ' If foreground not specified as rgb, get it as hex
    If bRGBFore = False Then
        If Left(strForeground, 1) = "#" Then
            strForecolour = Mid(strForeground, 2, Len(strForeground) - 1)
        Else
            strForecolour = strForeground
            strForeground = "#" & strForeground
        End If
    End If

    ' Use a regular expression to break out the colour intensities
    Set objRE = New RegExp

    ' If background not specified as RGB, get the intensities from the hexadecimal string
    If bRGBBack = False And (Len(strBackcolour) = 3 Or Len(strBackcolour) = 6) Then
        objRE.Pattern = "[0-9|a-f]{" & Len(strBackcolour) & "}"
        objRE.Global = False
        objRE.IgnoreCase = True

        ' Get background colours
        If objRE.Test(strBackcolour) = True Then
            If Len(strBackcolour) = 3 Then ' 3 digit version (for example, #39c)
                iBackgroundRed = Mid(strBackcolour, 1, 1) & Mid(strBackcolour, 1, 1)
                iBackgroundRed = CInt("&H" & iBackgroundRed)
                iBackgroundGreen = Mid(strBackcolour, 2, 1) & Mid(strBackcolour, 2, 1)
                iBackgroundGreen = CInt("&H" & iBackgroundGreen)
                iBackgroundBlue = Mid(strBackcolour, 3, 1) & Mid(strBackcolour, 3, 1)
                iBackgroundBlue = CInt("&H" & iBackgroundBlue)
            Else ' 6 digit version (for example, #3399cc)
                iBackgroundRed = Mid(strBackcolour, 1, 2)
                iBackgroundRed = CInt("&H" & iBackgroundRed)
                iBackgroundGreen = Mid(strBackcolour, 3, 2)
                iBackgroundGreen = CInt("&H" & iBackgroundGreen)
                iBackgroundBlue = Mid(strBackcolour, 5, 2)
                iBackgroundBlue = CInt("&H" & iBackgroundBlue)
            End If
        End If
    End If
    
    If bRGBFore = False And (Len(strForecolour) = 3 Or Len(strForecolour) = 6) Then
        ' Get foreground colours
        objRE.Pattern = "[0-9|a-f]{" & Len(strForecolour) & "}"
        objRE.Global = False
        objRE.IgnoreCase = True

        ' Get foreground colours
        If objRE.Test(strForecolour) = True Then
            If Len(strForecolour) = 3 Then ' 3 digit version (for example, #39c)
                iForegroundRed = Mid(strForecolour, 1, 1) & Mid(strForecolour, 1, 1)
                iForegroundRed = CInt("&H" & iForegroundRed)
                iForegroundGreen = Mid(strForecolour, 2, 1) & Mid(strForecolour, 2, 1)
                iForegroundGreen = CInt("&H" & iForegroundGreen)
                iForegroundBlue = Mid(strForecolour, 3, 1) & Mid(strForecolour, 3, 1)
                iForegroundBlue = CInt("&H" & iForegroundBlue)
            Else ' 6 digit version (for example, #3399cc)
                iForegroundRed = Mid(strForecolour, 1, 2)
                iForegroundRed = CInt("&H" & iForegroundRed)
                iForegroundGreen = Mid(strForecolour, 3, 2)
                iForegroundGreen = CInt("&H" & iForegroundGreen)
                iForegroundBlue = Mid(strForecolour, 5, 2)
                iForegroundBlue = CInt("&H" & iForegroundBlue)
            End If
        End If
    End If

    Set objRE = Nothing

    ' Calculate background brightness
    iBackgroundBrightness = ((iBackgroundRed * 299) + (iBackgroundGreen * 587) + (iBackgroundBlue * 114)) / 1000
    ' Calculate foreground brightness
    iForegroundBrightness = ((iForegroundRed * 299) + (iForegroundGreen * 587) + (iForegroundBlue * 114)) / 1000

    ' Calculate difference in brightness between background and foreground
    If iBackgroundBrightness > iForegroundBrightness Then
        iBrightDifference = Int(iBackgroundBrightness - iForegroundBrightness)
    Else
        iBrightDifference = Int(iForegroundBrightness - iBackgroundBrightness)
    End If

    ' Display result of brightness difference
    If iBrightDifference > 125 Then
        strOutputMessage = strOutputMessage & "<p>" & replace(DIClanguage(342),"[VALORE]",iBrightDifference) & ".</p>" & vbCrLf
    Else
        strOutputMessage = strOutputMessage & "<p>" & replace(DIClanguage(343),"[VALORE]",iBrightDifference) & ".</p>" & vbCrLf
        iLevel = 2
    End If

    ' Calculate the colour difference
    iColourDifference = Abs(iBackgroundRed - iForegroundRed) + Abs(iBackgroundGreen - iForegroundGreen) + Abs(iBackgroundBlue - iForegroundBlue)

    ' Display the result of the colour difference
    If iColourDifference > 500 Then
        strOutputMessage = strOutputMessage & "<p>" & replace(DIClanguage(344),"[VALORE]",iColourDifference) & ".</p>" & vbCrLf
    Else
        strOutputMessage = strOutputMessage & "<p>" & replace(DIClanguage(345),"[VALORE]",iColourDifference) & ".</p>" & vbCrLf
        ' Check if adheres to HP guidelines
        If iColourDifference > 400 Then
            strOutputMessage = strOutputMessage & "<p>" & DIClanguage(346) & ".</p>" & vbCrLf
            ' Check the level isn't already 2 (error), as it may have been set in the brightness difference
            If iLevel <> 2 Then
                iLevel = 1 ' Warning as it adheres to HP's guidelines
            End If
        Else
            ' The colour difference isn't adequate
            iLevel = 2
        End If
    End If

    ' Return the result (0=OK, 1=Warning, 2=Error)
    calculateContrast = iLevel
End Function

' Function to return the colour code for literal colours
Public Function findColour(ByVal strProperty)
    Dim arColour, arCode, iCounter

    ' Define literal colours
    arColour = Array("aqua", "black", "blue", "fuchsia", "gray", "green", "lime", "maroon", "navy", "olive", "purple", "red", "silver", "teal", "white", "yellow")
    ' Associated colour code
    arCode = Array("#0ff", "#000", "#00f", "#f0f", "#808080", "#008000", "#0f0", "#800000", "#000080", "#808000", "#800080", "#f00", "#ccc", "#008080", "#fff", "#ff0")

    ' Iterate through the array. If colour found, return the associated colour code
    For iCounter = 0 To UBound(arColour)
        If InStr(1, strProperty, arColour(iCounter), vbTextCompare) > 0 Then
            findColour = arCode(iCounter)
        End If
    Next
End Function

Private Function ValidateCSS(ByVal strCSS)
    Dim objXML, strStatus, strRetval, iStart, iEnd, strMessage
    Dim timeStart, timeEnd, strValidatorSource, strValidationResult

    Set objXML = Server.CreateObject("MSXML2.ServerXMLHTTP")

    ' Turn error trapping off so we can check for errors
    On Error Resume Next
    timeStart = Now()

    strValidatorSource = "http://jigsaw.w3.org/css-validator/validator?text=" & Server.URLEncode(strCSS) & "&warning=1&profile=css2&usermedium=all"
    
    objXML.Open "GET", strValidatorSource, True
    objXML.Send

    If objXML.readyState <> 4 then
        objXML.waitForResponse 10
    End If
    timeEnd = Now()

    ' Check if the server holding the resource timed out
    If DateDiff("s", timeStart, timeEnd) >= 10 Then
        ValidateCSS = "<p>" & DICLanguage(347) & ".</p>" & vbCrLf
        Set objXML = Nothing
        Exit Function
    End If

    ' Everything's fine, so turn error trapping back on again
    On Error Goto 0

    strStatus = objXML.Status
    strRetval = objXML.responseText
    Set objXML = Nothing

    If Trim(strRetval) = ""  Then 
        strValidationResult = "<p>" & DICLanguage(348) & ".</p>" & vbCrLf
    Else
        If InStr(strRetval, "<h2>Errors") > 0 Then
            If InStr(strRetval, "<h2>Warnings</h2>") Then
                strValidationResult = "<p>" & DICLanguage(349) & ".</p>" & vbCrLf
            Else
                strValidationResult = "<p>" & DICLanguage(350) & ".</p>" & vbCrLf
            End If
            iStart = InStr(strRetval, "<div id=""errors"">")
            If iStart > 0 Then
                iEnd = InStr(iStart, strRetval, "<div id=""css"">")
            End If
            If iStart > 0 And iEnd > iStart Then
                strMessage = Mid(strRetval, iStart, iEnd - iStart)
            End If
            ' Tidy up W3C message
            strMessage = Replace(strMessage, "<h2>Errors</a></h2>", "<h3>" & DICLanguage(352) & "</h3>")
            strMessage = Replace(strMessage, "<h2>Errors</h2>", "<h3>" & DICLanguage(352) & "</h3>")
            strMessage = Replace(strMessage, "</p></li></div>", "</p></li></ul></div>")
            strMessage = Replace(strMessage, "<h2>Warnings</a></h2>", "<h3>" & DICLanguage(353) & "</h3>")
            strMessage = Replace(strMessage, "<h2>Warnings</h2>", "<h3>" & DICLanguage(353) & "</h3>")
           strValidationResult = strValidationResult & strMessage & vbCrLf
        ElseIf InStr(strRetval, "<h2>Warnings</h2>") Then
            strValidationResult = "<p>" & DICLanguage(351) & "</p>" & vbCrLf
            iStart = InStr(strRetval,"<div id=""warnings"">")
            If iStart > 0 Then
                iEnd = InStr(iStart, strRetval,"<div id=""css"">")
            End If
            If iStart > 0 And iEnd > iStart Then
                strMessage = Mid(strRetval, iStart, iEnd - iStart)
				strMessage = Replace(strMessage, "<h2>Warnings</a></h2>", "<h3>" & DICLanguage(353) & "</h3>")
				strMessage = Replace(strMessage, "<h2>Warnings</h2>", "<h3>" & DICLanguage(353) & "</h3>")
            End If
            strValidationResult = strValidationResult & strMessage & vbCrLf
        End If
    End If
    ValidateCSS = strValidationResult
End Function

%>