' Populates the nof_locale global variable
' with locale data
' @throws   [620] File not found

Function faqLocaleToDictionary(Path, LocaleFile)

    On Error Resume Next
                
    Dim fso, lDictionary, LocalFilePath
    LocaleFilePath = path & "\" & LocaleFile
    set lDictionary = Server.CreateObject("Scripting.Dictionary")
    set faqLocaleToDictionary = lDictionary
    
    If Not faqFileExist(LocaleFilePath) Then
        Err.Raise 620, "faq_XmlLib.faqLocaleToDictionary", faqGetLocaleString("Error.620", Array(LocaleFilePath)) 
        Exit Function
    End If

    set lDictionary = faqProcessResourceFile(Path, LocaleFile)
    
    set faqLocaleToDictionary = lDictionary
End Function

Function faqProcessResourceFile(Path, FileName)
    Dim localeDictionary
    
    On Error Resume Next
    
    set localeDictionary = Server.CreateObject("Scripting.Dictionary")
    set faqProcessResourceFile = localeDictionary
  
    'Read resources file into an array:
        
    Dim f
    Set f = faqOpenFile(Path & "\" & FileName, 1)
    if f is nothing then
        exit function
    end if

    Dim fContents
    fContents = f.ReadAll   
        
    set f = nothing
   
    Dim aFile
    aFile = split(fContents, vbCrLf)        
        
    For i = 0 To Ubound(aFile)
        
        Dim curLine
        curLine = Trim(aFile(i))
        
        Select Case Left(curLine, 1)
        
        Case "@":   'Directive, process it:
        
            If LCase(Left(curLine, 7)) = "@import" Then
                 
                'Get the name of the file to import:
                
                Dim importFile 'As String
                importFile = Replace(LCase(curLine), "@import", "")
                importFile = Trim(importFile)
                importFile = Replace(importFile, "'", "")
                importFile = Replace(importFile, """", "")
                
                dim ld, key
                if FileExist(path & "\" & importFile) then
                    set ld = faqProcessResourceFile(Path, importFile)
                    key = ld.Keys
                    for j=0 to ld.count - 1
                        localeDictionary.Add key(j), ld.Item(key(j))
                    next
                end if
            End If
        
        Case "#":   'Comment, ignore it:
            
        Case Else:  'If key/value pair, retrieve it:
                
            If InStr(curLine, "=") > 0 Then
                
                arrLine = Split(curLine, "=")
                key = arrLine(0)
                value = arrLine(1)
                if Left(value, 1) = "$" then
                    if localeDictionary.Exists( Mid(value, 2) ) then
                        value = localeDictionary.Item(Mid(value, 2))
                    end if
                end if
                    
                If localeDictionary.Exists(key) Then
                    localeDictionary(key) = value
                Else
                    localeDictionary.Add key, value
                End If

            End If
            
        End Select

    Next 
    
    set faqProcessResourceFile = localeDictionary
End Function

Function faqOpenXMLFile(ByVal FilePath)
    On Error Resume Next    

    set faqOpenXMLFile = nothing
    
    Dim Prefixes
    Prefixes = Array("Microsoft.XMLDOM","MSXML2.DOMDocument.3.0","MSXML2.DOMDocument.4.0")
    
    Dim xmlDoc
    Dim i   
    for i = 0 to UBound(Prefixes)
        Set xmlDoc = Nothing
        Set xmlDoc = Server.CreateObject(Prefixes(i))
        If (xmlDoc Is Nothing And i > 0) Then
            Err.Clear()
            Set xmlDoc = Server.CreateObject(Prefixes(i-1))
        End If
    next

    if (xmlDoc is nothing) then 
        Set FSO = Nothing
        Call Err.Raise(650, "faqOpenXMLFile", faqGetLocaleString("Error.650", Null) & ", " & err.description)
        Exit Function
    end if

    Dim f
    set f = faqOpenFile(FilePath, 1)
    if err.number <> 0 then exit function

    dim str
    str = f.ReadAll
    
    Set f = Nothing            
    
    if (cstr(str) = "") then 
        Set XMLDoc = Nothing
        Call Err.Raise ( 600, "faqOpenXMLFile", faqGetLocaleString("Error.600", Array(FilePath)) )
        Exit Function
    end if

    Dim regEx
    Set regEx = New RegExp
    regEx.Pattern = "^\s*<" & chr(37) & "[^" & chr(37) & ">]*" & chr(37) & ">\s*"
    regEx.IgnoreCase = True
    regEx.Global = True
    str = regEx.Replace(str, "")
    set regEx = nothing

    xmlDoc.loadXML(str)
    Set faqOpenXMLFile = xmlDoc

    Set xmlDoc = nothing
End Function

Public function faqGetNode(ByVal XML, ByVal StartNode, ByVal Nodename, ByVal attrName, ByVal attrVal, ByVal tagNr)
    
    On Error Resume Next
     
    Dim NodeList
    If IsObject(StartNode) then
        Set NodeList = XML.documentElement.selectNodes(Nodename)
    else
        Set NodeList = XML.GetElementsByTagName(NodeName)
    end if
    
    Dim CompNode
    set CompNode = nothing
    
    Dim i
    For i = 0 To NodeList.length - 1
        Dim continue
        continue = true
        if NodeList.Item(i).Attributes.length > 0 then
            Dim sw
            sw = true
            if isArray(attrName) then
                Dim k
                for k = 0 to UBound(attrName)
                    Dim j
                    For j = 0 to NodeList.Item(i).Attributes.length - 1
                        if LCase(NodeList.Item(i).Attributes.Item(j).nodeName) = LCase(attrName(k)) then
                            if Lcase(NodeList.Item(i).Attributes.Item(j).nodeTypedValue) = Lcase(attrVal(k)) then 
                                if not sw then 
                                    continue = false
                                else
                                    sw = false
                                end if
                            end if
                        end if
                    next
                next
            elseif attrName <> "" then
                if LCase(NodeList.Item(i).Attributes.Item(j).nodeName) = LCase(attrName) then
                    if NodeList.Item(i).Attributes.Item(j).nodeTypedValue = attrVal then continue = false
                end if
            end if
        elseif tagNr >= 0 then
            if i = tagNr then
                continue = false
            end if
        end if

        if not continue then
            set CompNode = NodeList.Item(i)
            Exit For
        end if
    next
    
    set faqGetNode = CompNode

end function

Public Function faqGetProperty(ByVal XmlElement, ByVal PropName)
    
    On Error Resume Next
    
    faqGetProperty = ""
    
    Dim PropNode
    Set PropNode = faqGetXMLElementByName(XmlElement, PropName)
    
    if Not PropNode Is Nothing then
        faqGetProperty = PropNode.nodeTypedValue
    end if
    
End Function

Public Function faqGetXMLElementByName(ByVal XmlElement, ByVal TagName)
    
    On Error Resume Next
    
    Set faqGetXMLElementByName = nothing
    
    Dim i, j
    
    For i = 0 To XmlElement.childNodes.length - 1
        If Trim(XmlElement.childNodes.Item(i).nodeName) = Trim(TagName) Then
            Set faqGetXMLElementByName = XmlElement.childNodes.Item(i)
            Exit Function
        End If
    Next
End Function

Function faqReFind(ByVal str, ByVal patrn)
    Dim regEx
    
    Set regEx = New RegExp
    regEx.Pattern = patrn
    regEx.IgnoreCase = True
    regEx.Global = True
    
    Set faqReFind = regEx.Execute(str)
    set regEx = nothing
End Function

'file function
function faqOpenFile(ByVal path, ByVal oType)
            
    On Error Resume Next
    Dim FSO, f      

    set faqOpenFile = nothing
    set f = nothing

    Set FSO = CreateObject("Scripting.FileSystemObject")  
    if fso is nothing then
        call Err.Raise ( 910, "faqOpenFile", faqGetLocaleString("Error.910", Array("Scripting.FileSystemObject")) )
        Exit Function
    end if

    if not fso.FileExists(path) then
        set fso = nothing
        call Err.Raise ( 525, "faqOpenFile", faqGetLocaleString("Error.525", Array(path)) )
        Exit Function
    end if
    
    Set f = FSO.OpenTextFile(path, oType)   
    if f is nothing then 
        call err.raise ( 502, "faqOpenFile", faqGetLocaleString("Error.502", Array(path)) )
        set fso = nothing
        Exit Function
    end if      
    set faqOpenFile = f
        
    set fso = nothing
    
end function

'### FileExist function - check if a file exist ###'
function faqFileExist(ByVal path)
    Dim fso
		
    Set fso = CreateObject("Scripting.FileSystemObject")
    if fso.FileExists(path) then
    	faqFileExist = true
    else
    	faqFileExist = false
    end if
    	   
    set fso = nothing
end function

' Creates database, if exists overwrites it
' @throws [500] Failed to create CSV text file
function faqCreateDB(ByVal path, ByVal head)
    Dim fso, f

    On Error Resume Next
    
    faqCreateDB = false
    
    set f = nothing
    Set fso = CreateObject("Scripting.FileSystemObject") 
    if isEmpty(fso) then
        call Err.Raise ( 910, "faqOpenFile", faqGetLocaleString("Error.910", Array("Scripting.FileSystemObject")) )
        Exit function
    end if
    Set f = fso.CreateTextFile(path, True)

    if f is nothing then     
         Set fso = nothing
         call Err.Raise(500, "faqCreateDB",faqGetLocaleString("Error.500", Array(path)) )
         Exit function
    end if
       
    f.WriteLine head 
    f.Close()
       
    set f = nothing
    set fso = nothing
    
    if err.number = 0 then faqCreateDB = true
end function

Function faqRSFileContent(ByVal path, ByVal condition)
    
    On Error Resume Next
    Set faqRSFileContent = nothing
    
    Dim condField, condValue, condArr, condOp, condIdx
    
    if inStr(1, condition, "=") > 0 then
        condOp = "="
    elseif inStr(1, condition, "like") > 0 then
        condOp = "like"
    end if
    condArr = split(condition, condOp)
    if UBound(condArr) = 1 then
        condField = Trim(condArr(0))
        condValue = Trim(condArr(1))
    else
        condition = ""
    end if
    
    
    Dim f
    set f = faqOpenFile(path, 1)
    if f is nothing then
        Exit Function
    end if
    
    Dim fileLine
    fileLine = f.ReadLine
    
    Dim rs    
    set rs = Server.CreateObject("ADODB.RecordSet")
    if rs is nothing then
        call Err.Raise ( 910, "faqOpenFile", faqGetLocaleString("Error.910", Array("ADODB.RecordSet")) )
        Exit Function
    end if
    
    Dim allFields    
    allFields = Split(fileLine, ",", -1, 1)
    For i = 0 To UBound(allFields)
        if LCase(condField) = LCase(allFields(i)) then condIdx = i
        
        rs.Fields.Append CStr(allFields(i)), 129, 1000
    Next
    rs.CursorType = 1
    rs.LockType = 3
    rs.Open

    Dim addRec
    Do While f.AtEndOfStream <> True
        fileLine = f.ReadLine
        fileLine = Mid(fileLine, 2, Len(fileLine)-2)

        addRec = CBool(condition = "")
        allFields = Split(fileLine, """;""", -1, 1)
            
        if condition <> "" then
            if condOp = "=" then
                if allFields(condIdx) = condValue then
                    addRec = true
                end if
            else
                if inStr(1, LCase(allFields(condIdx)), LCase(condValue)) > 0 then
                    addRec = true
                end if
            end if
        end if

        if addRec then
            With rs
                .AddNew
                For i = 0 To UBound(allFields)
                    .Fields(i).Value = Trim(allFields(i))
                Next
                .Update
                .MoveFirst
            End With
        end if
    Loop
    f.Close
    
'    if not isEmpty(orderBy) and orderBy <> "" then rs.Sort = orderBy
    
    set faqRSFileContent = rs
    set rs = nothing
    
end function

function faqGetDomainName(ByVal path, ByVal domainId)
    Dim f, dName
    
    on error resume next
    faqGetDomainName = ""
    
    set f = faqOpenFile(path, 1)
    if f is nothing then
        Exit Function
    end if
    
    fileLine = f.ReadLine
    Do While f.AtEndOfStream <> True
        fileLine = f.ReadLine
        fileLine = Mid(fileLine, 2, Len(fileLine)-2)

        allFields = Split(fileLine, """;""", -1, 1)
        if allFields(1) = domainId then
            dName = allFields(2)
            exit do
        end if
    loop
    f.close
    
    faqGetDomainName = dName
end function

' Searches for Key in the nof_locale global Dictionary and returns its value
'
' @param    (As String)     Key         The name of the resource key to be retrieved 
' @param    (As Array)      CustomTags  Values that should replace the "{#}"
'                                       in the returned value (optional) 
'
' @returns  OnSuccess       Key's value
' @returns  OnFailure       "[[Key]]"

function faqGetLocaleString(ByVal Key, ByVal CustomTags)
    dim outStr
    On Error Resume Next
    
    outStr = "[[" & Key & "]]"
    
    If TypeName(nof_locale) <> "Dictionary" Then
        faqGetLocaleString = outStr
        Exit Function
    End If
    
    If nof_locale.Exists(Key) Then
        outStr = nof_locale(Key)  
    End If
    
    If IsArray(CustomTags) Then
        For i = 0 To UBound(CustomTags)
            outStr = Replace(outStr, "{" & CStr(i + 1) & "}", CustomTags(i))
        Next
    End If
    
    dim regExp
    set regExp = new RegExp
    regExp.Pattern = "\{[0-9]{1}\}"
    regExp.Global = true
    
    outStr = regExp.Replace(outStr, "")
    set regExp = nothing
    
    faqGetLocaleString = outStr
end function