<%
' Populates the nof_locale global variable
' with locale data
' @throws [620] File not found
Function nwLocaleToDictionary(Path, LocaleFile)
On Error Resume Next
Dim lDictionary, LocalFilePath
LocaleFilePath = path & "\" & LocaleFile
set lDictionary = Server.CreateObject("Scripting.Dictionary")
set nwLocaleToDictionary = lDictionary
If Not nwFileExist(LocaleFilePath) Then
Err.Raise 620, "nw_functions.nwLocaleToDictionary", nwGetLocaleString("Error.620", Array(LocaleFilePath))
Exit Function
End If
set lDictionary = nwProcessResourceFile(Path, LocaleFile)
set nwLocaleToDictionary = lDictionary
End Function
Function nwProcessResourceFile(Path, FileName)
Dim localeDictionary
On Error Resume Next
set localeDictionary = Server.CreateObject("Scripting.Dictionary")
set nwProcessResourceFile = localeDictionary
'Read resources file into an array:
Dim f
Set f = nwOpenFile(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 Left(curLine, 7) = "@IMPORT" Then
'Get the name of the file to import:
Dim importFile 'As String
importFile = Replace(curLine, "@IMPORT", "")
importFile = Trim(importFile)
importFile = Replace(importFile, "'", "")
importFile = Replace(importFile, """", "")
dim ld, key
if nwFileExist(path & "\" & importFile) then
set ld = nwProcessResourceFile(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 nwProcessResourceFile = localeDictionary
End Function
' @returns OnSuccess: An XML Document object
' @returns OnFailure: An empty object
'
' @throws 620 XML file not found
' @throws 650 XML server object could be created
' @throws 601 XML file could not be opened
Function nwOpenXMLFile(ByVal file)
On Error Resume Next
Dim FSO
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
If not FSO.FileExists(file) Then
Err.Raise 901, "nw_function.nwOpenXMLFile", nwGetLocaleString("Error.901", Array("Scripting.FileSystemObject"))
Exit Function
End If
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
Err.Raise 650, "nw_function.nwOpenXMLFile", nwGetLocaleString("Error.650", Null)
Exit Function
else
Dim f
set f = fso.OpenTextFile(file, 1)
dim str
str = f.ReadAll
if (cstr(str) = "") then
Err.Raise 601, "nw_function.nwOpenXMLFile", nwGetLocaleString("Error.601", Array(file))
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 f = nothing
end if
set nwOpenXMLFile = xmlDoc
End Function
' @returns OnSuccess: An XML node
' @returns OnFailure: Nothing object
Function nwGetNode(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 nwGetNode = CompNode
End Function
Public Function nwGetLabels(ByVal XmlElement)
On Error Resume Next
dim labelsNode, labelsArray
ReDim labelsArray(0)
labelsArray(0) = ""
set labelsNode = nwGetXMLElementByName(XmlElement, "fields")
if labelsNode is Nothing then
nwGetLabels = ""
exit function
end if
For i = 0 To labelsNode.childNodes.length - 1
if ( isArray(labelsArray(0)) ) then ReDim Preserve labelsArray(UBound(labelsArray)+1)
labelsArray(UBound(labelsArray)) = Array(labelsNode.childNodes.Item(i).nodeTypedValue, labelsNode.childNodes.Item(i).Attributes.Item(0).nodeTypedValue, labelsNode.childNodes.Item(i).Attributes.Item(1).nodeTypedValue)
Next
nwGetLabels = labelsArray
End Function
Public Function nwGetProperty(ByVal XmlElement, ByVal PropName)
On Error Resume Next
Dim PropNode
Set PropNode = nwGetXMLElementByName(XmlElement, PropName)
if PropNode is Nothing then
nwGetProperty = ""
else
nwGetProperty = PropNode.nodeTypedValue
end if
End Function
Public Function nwGetAttribute(ByVal XmlElement, ByVal PropName, ByVal AttrName)
On Error Resume Next
Dim PropNode
Set PropNode = nwGetXMLElementByName(XmlElement, PropName)
nwGetAttribute = ""
if not PropNode is Nothing then
if ( PropNode.Attributes.length > 0 ) then
For i = 0 to PropNode.Attributes.length - 1
if ( PropNode.Attributes.Item(i).NodeName = AttrName ) then
nwGetAttribute = PropNode.Attributes.Item(i).nodeTypedValue
exit for
end if
next
end if
end if
End Function
Public Function nwGetXMLElementByName(ByVal XmlElement, ByVal TagName)
On Error Resume Next
Dim i, j
Set nwGetXMLElementByName = Nothing
For i = 0 To XmlElement.childNodes.length - 1
If Trim(XmlElement.childNodes.Item(i).nodeName) = Trim(TagName) Then
Set nwGetXMLElementByName = XmlElement.childNodes.Item(i)
Exit For
End If
Next
End Function
' Creates database, if exists overwrites it
' @throws [500] Failed to create CSV text file
Sub nwCreateDB(ByVal path, ByVal head)
Dim fso, f
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
if isEmpty(fso) then
Err.Raise 901, "nw_functions.nwCreateDB", nwGetLocaleString("Error.901", Array("Scripting.FileSystemObject"))
Exit Sub
end if
Set f = fso.CreateTextFile(path, True)
Set fso = Nothing
if f is nothing then
Err.Raise 500, "nw_functions.nwCreateDB", nwGetLocaleString("Error.500", Array(path))
Exit Sub
end if
f.WriteLine head
f.Close()
set f = nothing
end sub
' @throws 520 Failed to open file
' @throws 502 Failed to open file
' return a two dimensionl array; the first dimension is the record count
' number and the second dimension is the db fields number
function nwGetDB(ByVal Path, Byval Flag)
Dim fieldsArray, contentarray1
On Error Resume Next
Set f = nwOpenFile(Path, 1)
If Err.Number <> 0 Then
if ( Err.Number = 525 ) then
'//try to create the file
Dim head
head = "id,title,shortmessage,fullmessage,author,image,date,validation"
err.Clear 'clear the previuos error
call nwCreateDB(path, head)
If Err.Number <> 0 Then
Exit function
end if
else
Exit function
end if
End If
Dim cont
cont = 0
Do While f.AtEndOfStream <> true
line = f.readline
if line <> "" then
cont = cont + 1
end if
loop
f.close
set f = nwOpenFile(path, 1)
If Err.Number <> 0 Then
Exit function
End If
if f.AtEndOfStream <> true then
'//get the header
lineFields = f.readline
if lineFields <> "" then
fieldsarray = split(lineFields, ",")
end if
for k=0 to ubound(fieldsarray)
if trim(fieldsarray(k))="validation" then
valid_pos=k
end if
next
'//get the data
redim dbarray(cont-2)
j=0
do while f.AtEndOfStream <> true
line=f.readline
if line<>"" then
dbarray(j)=line
j=j+1
end if
loop
contor1=0
contor2=j
for s=0 to ubound(dbarray)
tab=split( mid(dbarray(s), 2, Len(dbarray(s))-2), """,""" )
if trim(tab(ubound(tab)))="true" then
contor1=contor1+1
end if
next
if flag=1 then
redim contentarray1(contor1, ubound(fieldsarray))
id1=0
for n=0 to ubound(fieldsarray)
contentarray1(id1,n) = fieldsArray(n)
next
id1=id1+1
for s=0 to ubound(dbarray)
tab=split( mid(dbarray(s), 2, Len(dbarray(s))-2), """,""" )
if trim(tab(ubound(tab)))="true" then
for n=0 to ubound(fieldsarray)
contentarray1(id1,n)=dbDecode(tab(n))
next
id1=id1+1
end if
next
else
redim contentarray1(contor2, ubound(fieldsarray))
id1=0
for n=0 to ubound(fieldsarray)
contentarray1(id1,n) = fieldsArray(n)
next
id1=id1+1
for s=0 to ubound(dbarray)
tab=split( mid(dbarray(s), 2, Len(dbarray(s))-2), """,""" )
for n=0 to ubound(fieldsarray)
contentarray1(id1,n)=dbDecode(tab(n))
next
id1=id1+1
next
end if
end if
nwGetDB = contentarray1
end function
sub nwDisplayPages(Byval offset, Byval numberoflines, Byval itemnsnumber, Byval howmany, ByVal extraVars)
Response.Write "" & nwGetLocaleString("nw.View.Text.Pages", null) & ": "
aux1=round(numberoflines/itemnsnumber)
aux2=numberoflines/itemnsnumber
aux3=int(numberoflines/itemnsnumber)
if aux1=aux2 and aux1=aux3 then
numberofpages=aux1
else
if aux2>aux3 then
numberofpages=aux3+1
end if
end if
if offset<>0 then
if int(offset/itemnsnumber)=(offset/itemnsnumber) then
curentpage=int(offset/itemnsnumber)
else
curentpage=int(offset/itemnsnumber)+1
end if
else
curentpage=1
end if
aux = int(howmany/2)
if curentpage<=aux+1 then
i = 0
else
i = curentpage-aux-1
end if
if numberofpages <= howmany then
i=0
else
if numberofpages-curentpage<=aux-1 then
i = numberofpages-howmany
end if
end if
j=1
do while j<=howmany and i<=numberofpages-1
if i+1=curentpage then
pg=i+1
Response.Write ""&pg&" "
else
pg=i+1
off=(i*itemnsnumber)+1
Response.Write ""&pg&" "
end if
i=i+1
j=j+1
loop
Response.Write "(" & numberofpages & ")"
end sub
sub nwUpdateDB(Byval arrayf, Byval file)
on error resume next
set f = nwOpenFile(file,2)
if (err.number <> 0) then
if ( Err.Number = 525 ) then
'//try to create the file
Dim head
head = "id,title,shortmessage,fullmessage,author,image,date,validation"
err.Clear 'clear the previuos error
call nwCreateDB(file, head)
If Err.Number <> 0 Then
exit sub
end if
else
exit sub
end if
end if
if IsArray(arrayf) then
'//write the header
line = arrayf(i,0)
for k=1 to ubound(arrayf, 2)
line = line & "," & arrayf(i,k)
next
f.writeline line
'//write the data
for i=1 to ubound(arrayf)
if arrayf(i,0) <> "" then
line = dbEncode(arrayf(i,0))
for k=1 to ubound(arrayf, 2)
line = line & """,""" & dbEncode(arrayf(i,k))
next
f.writeline """" & line & """"
end if
next
end if
f.close
end sub
sub nwsendmail(Byval file,Byval values, Byval email)
body = nwGetTemplateValue(file, "Body")
body = Replace(body, "{beginiterator}{0}{enditerator}", values, 1, -1, 1)
Set objMail = Server.CreateObject("CDO.Message")
'Set cnfg = Server.CreateObject("CDO.Configuration")
objMail.From = nwGetTemplateValue(file, "From")
objMail.To = email
objMail.Subject = nwGetTemplateValue(file, "Subject")
objMail.HTMLBody = body
On error resume next
objMail.send
Set objMail = Nothing
Set cnfg = Nothing
end sub
function nwEncodeValue(ByVal str)
Dim regEx, Match, Matches
Set regEx = New RegExp
regEx.Pattern = """"
regEx.IgnoreCase = True
regEx.Global = True
nwEncodeValue = regEx.Replace(str,"'")
regEx.Pattern = "\r\n"
regEx.IgnoreCase = True
regEx.Global = True
nwEncodeValue = regEx.Replace(nwEncodeValue, " ")
set regEx = nothing
end function
function nwFileExist(ByVal path)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
if fso.FileExists(path) then
nwFileExist = true
else
nwFileExist = false
end if
set fso = nothing
end function
function nwGetTemplateValue(ByVal path, ByVal property)
Dim fso, f, pos, prop, line
set f = nwOpenFile(path, 1)
prop = ""
Do While f.AtEndOfStream <> True
line = f.ReadLine
if Len(prop) = 0 then
pos = inStr(1, line, property & "=", 1)
if pos > 0 then
if Right(line,1) <> "\" then
prop = Mid(line, pos + Len(property)+1, Len(Line)-(pos + Len(property)))
exit do
end if
prop = Mid(line, pos + Len(property)+1, Len(Line)-(pos + Len(property))-1)
end if
else
if Right(line,1) <> "\" then
prop = prop & line
exit do
end if
prop = prop & Left(line, Len(line)-1)
end if
loop
f.Close
nwGetTemplateValue = prop
end function
' Attempts to open the [path] file in [oType] mode
' @returns A TextStream object
' @throws [520] Failed to open file
' @throws [502] Failed to write to file
Function nwOpenFile(ByVal path, ByVal oType)
On Error Resume Next
Dim FSO, f
set nwOpenFile = nothing
set f = nothing
Set FSO = CreateObject("Scripting.FileSystemObject")
if not FSO.FileExists(path) then
Err.Raise 525, "nw_functions.nwOpenFile", nwGetLocaleString("Error.525", Array(path))
Exit Function
end if
Set f = FSO.OpenTextFile(path, oType)
if f is nothing then
set FSO = nothing
if oType = 1 then
Err.Raise 520, "nw_functions.nwOpenFile", nwGetLocaleString("Error.520", Array(path))
else
Err.Raise 502, "nw_functions.nwOpenFile", nwGetLocaleString("Error.502", Array(path))
end if
Exit Function
end if
set nwOpenFile = f
set f = nothing
set fso = nothing
End Function
'@return OnSuccess: HTML Errors List ("Er 1 msg...")
'@return OnFailure: Empty String
Function SaveNewsItem(ByRef contentarray, ByRef objUploader, ByRef ComponentNode)
On Error Resume Next
SaveNewsItem = ""
Dim TemplateEmail
TemplateEmail = "nw_EmailTemplate_" & language & ".properties"
DBPath = nwGetProperty(ComponentNode, "dbPath")
if dbPath = "" then
'the db path was not set
call err.raise ( 526, "nw_add.SaveNewsItem", nwGetLocaleString("Error.526", null) )
exit function
end if
Dim relPath, absPath
if not inStr(1, dbPath, "\", 1) > 0 then
set relPath = nothing
set relPath = nwReFind(dbPath, "\.\./")
absPath = nof_sitePath & nof_scriptDir
if not relPath is nothing then
if relPath.count > 0 then
for i=1 to relPath.count
absPath = Left(absPath, inStrRev(absPath,"\") - 1)
dbPath = Replace(dbPath, "../", "", 1, 1)
next
else
if inStr(1, dbPath, "./") <> -1 then
dbPath = Replace(dbPath, "./", "", 1, 1)
end if
end if
set relPath = nothing
end if
dbPath = absPath & "\" & Replace(dbPath, "/", "\")
end if
path = nof_sitePath & nof_scriptDir & "\images"
fileToUpload = objUploader.Form("oldimage")
For Each File In objUploader.Files.Items
tmpNr = 1
fileToUpload = nwEncodeValue(File.FileName)
' Assign a unique file name:
if nwFileExist(path & "\" & fileToUpload) then
fileToUpload = Replace(fileToUpload,"." & File.FileExtension, CStr(tmpNr) & "." & File.FileExtension, 1, 1, 1)
while nwFileExist(path & "\" & fileToUpload)
fileToUpload = Replace(fileToUpload, CStr(tmpNr) & "." & File.FileExtension, CStr(tmpNr+1) & "." &File.FileExtension, 1, 1, 1)
tmpNr = tmpNr + 1
wend
end if
if File.FileSize > 204800 then
SaveNewsItem = "" & nwGetLocaleString("nw.AddForm.FileOverSize.Message", null)
Exit Function
end if
if File.FileSize = 0 Then
SaveNewsItem = "" & nwGetLocaleString("nw.AddForm.FileEmpty.Message", null)
Exit Function
end if
if not ( LCase(File.FileExtension) = "jpg" or LCase(File.FileExtension) = "gif" or LCase(File.FileExtension) = "jpg" _
or LCase(File.FileExtension) = "jpeg" or LCase(File.FileExtension) = "png" )then
SaveNewsItem = "" & nwGetLocaleString("nw.AddForm.FileBadExtension.Message", Array(".gif, .jpg, .jpeg or .png"))
Exit Function
end if
Err.Clear()
Call File.SaveToDisk(path, fileToUpload)
if Err.number <> 0 then
exit function
end if
'//remove the old image
if objUploader.Form("oldimage") <> "" then
Call File.RemoveFromDisk(path, objUploader.Form("oldimage"))
end if
next
for i=0 to Ubound(contentarray)
if contentarray(i,0) = objUploader.Form("id") then
contentarray(i,1) = objUploader.Form("title")
contentarray(i,2) = objUploader.Form("shortmessage")
contentarray(i,3) = objUploader.Form("fullmessage")
contentarray(i,4) = objUploader.Form("author")
contentarray(i,5) = fileToUpload
contentarray(i,7) = objUploader.Form("status")
exit for
end if
next
Set f = nwOpenFile(dbpath, 2)
if f is nothing then
if err.number <> 0 then
if ( Err.Number = 525 ) then
'//try to create the file
err.Clear 'clear the previuos error
call nwCreateDB(file, "")
If Err.Number <> 0 Then
exit function
end if
else
exit function
end if
else
call Err.Raise ( 502, "nw_add.SaveNewsItem", nwGetLocaleString("Error.502", Array(dbpath)) )
exit function
end if
end if
for i=0 to Ubound(contentarray,1)
line = ""
if i=0 then
for j=0 to Ubound(contentarray,2)
if line <> "" then line = line & ","
line = line & contentarray(i,j)
next
'// line = join(contentarray(i),",")
else
for j=0 to Ubound(contentarray,2)
if line <> "" then line = line & ""","""
line = line & dbEncode(contentarray(i,j))
next
line = """" & line & """"
'// line = """" & join(contentarray(i),""",""") & """"
end if
f.writeline line
next
f.close
End Function
'@return OnSuccess: HTML Errors List ("Er 1 msg...")
'@return OnFailure: Empty String
Function AddNewsItem(ByRef objUploader, ByRef ComponentNode, ByVal offset)
On Error Resume Next
AddNewsItem = ""
Dim TemplateEmail
TemplateEmail = "nw_EmailTemplate_" & language & ".properties"
DBPath = nwGetProperty(ComponentNode, "dbPath")
if dbPath = "" then
'the db path was not set
call err.raise ( 526, "nw_add.AddNewsItem", nwGetLocaleString("Error.526", null) )
exit function
end if
Dim relPath, absPath
if not inStr(1, dbPath, "\", 1) > 0 then
set relPath = nothing
set relPath = nwReFind(dbPath, "\.\./")
absPath = nof_sitePath & nof_scriptDir
if not relPath is nothing then
if relPath.count > 0 then
for i=1 to relPath.count
absPath = Left(absPath, inStrRev(absPath,"\") - 1)
dbPath = Replace(dbPath, "../", "", 1, 1)
next
else
if inStr(1, dbPath, "./") <> -1 then
dbPath = Replace(dbPath, "./", "", 1, 1)
end if
end if
set relPath = nothing
end if
dbPath = absPath & "\" & Replace(dbPath, "/", "\")
end if
path = nof_sitePath & nof_scriptDir & "\images"
fileToUpload = ""
For Each File In objUploader.Files.Items
tmpNr = 1
fileToUpload = nwEncodeValue(File.FileName)
' Assign a unique file name:
if nwFileExist(path & "\" & fileToUpload) then
fileToUpload = Replace(fileToUpload,"." & File.FileExtension, CStr(tmpNr) & "." & File.FileExtension, 1, 1, 1)
while nwFileExist(path & "\" & fileToUpload)
fileToUpload = Replace(fileToUpload, CStr(tmpNr) & "." & File.FileExtension, CStr(tmpNr+1) & "." &File.FileExtension, 1, 1, 1)
tmpNr = tmpNr + 1
wend
end if
if File.FileSize > 204800 then
AddNewsItem = "" & nwGetLocaleString("nw.AddForm.FileOverSize.Message", null)
Exit Function
end if
if File.FileSize = 0 Then
AddNewsItem = "" & nwGetLocaleString("nw.AddForm.FileEmpty.Message", null)
Exit Function
end if
if not ( LCase(File.FileExtension) = "jpg" or LCase(File.FileExtension) = "gif" or LCase(File.FileExtension) = "bmp" _
or LCase(File.FileExtension) = "jpeg" or LCase(File.FileExtension) = "png" ) then
AddNewsItem = "" & nwGetLocaleString("nw.AddForm.FileBadExtension.Message", Array(".gif, .jpg, .jpeg or .png"))
Exit Function
end if
Err.Clear()
Call File.SaveToDisk(path, fileToUpload)
if Err.number <> 0 then
exit function
end if
next
Dim head
head = "id,title,shortmessage,fullmessage,author,image,date,validation"
Set f = nwOpenFile(dbpath, 1)
If f Is Nothing Then
if err.number <> 0 then
if ( Err.Number = 525 ) then
'//try to create the file
err.Clear 'clear the previuos error
call nwCreateDB(file, head)
If Err.Number <> 0 Then
exit function
end if
else
exit function
end if
else
call Err.Raise ( 501, "nw_admin.AddNewsItem", nwGetLocaleString("Error.501", Array(dbpath)) )
exit function
end if
End If
id = 0
f.skipline
Do While f.AtEndOfStream <> true
line=f.readline
arrline=split(mid(line,2,Len(line)-1),""",""")
if ( line <> "" and ubound(arrline) > 0 ) then
id=arrline(0)
end if
loop
id=id+1
f.close
dim crDate
crDate = DateAdd("n", offset, now())
line="""" & id & """,""" & dbEncode(objUploader.Form("title")) & """" & _
",""" & dbEncode(objUploader.Form("shortMessage")) & """" & _
",""" & dbEncode(objUploader.Form("fullMessage")) & """" & _
",""" & dbEncode(objUploader.Form("author")) & """" & _
",""" & dbEncode(fileToUpload) & """" & _
",""" & CStr(FormatDateTime( crDate, 2 ) & " " & FormatdateTime(crDate, 4)) & ":" & Second(crDate) & """" & _
",""" & objUploader.Form("status") & """"
Err.Clear()
Set f = nwOpenFile(dbpath, 8)
if f is nothing then
if err.number <> 0 then
if ( Err.Number = 525 ) then
'//try to create the file
err.Clear 'clear the previuos error
call nwCreateDB(file, head)
If Err.Number <> 0 Then
exit function
end if
else
exit function
end if
else
call Err.Raise ( 502, "nw_add.AddNewsItem", nwGetLocaleString("Error.502", Array(dbpath)) )
exit function
end if
end if
f.writeline line
f.close
End Function
'MM/DD/YYYY;MMM,DD YYYY;DD/MM/YYYY
function dateFormat(ByVal strDate, ByVal dMask, ByVal tMask, ByVal offset)
dim pos, postDate
postDate = DateAdd("h", offset, CDate(strDate))
pos = inStr(1, dMask, "/")
if ( pos > 1 ) then
if ( mid(dMask,1,1) = "0" ) then
dateFormat = Month(postDate) & "/" & Day(postDate) & "/" & Year(postDate)
else
dateFormat = Day(postDate) & "/" & Month(postDate) & "/" & Year(postDate)
end if
else
dateFormat = nwGetLocaleString("nw.month[" & Month(postDate) & "].name", null) & ", " & Day(postDate) & " " & Year(postDate)
end if
dateFormat = dateFormat
if ( tMask <> "" ) then
dateFormat = dateFormat & " " & timeFormat(postDate, tMask)
end if
end function
'H:MM:SS AM/PM;HH:MM:SS
function timeFormat(ByVal str, ByVal mask)
dim timecontent, timedivisions
timedivisions = split(mask, " ")
timecontent = split(timedivisions(0), ":")
if ( UBound(timedivisions) > 0 ) then
timeFormat = TimeSerial(Hour(str), Minute(str), Second(str))
else
timeFormat = Hour(str) & ":"
if Len(Cstr(Minute(str))) > 1 then
timeFormat = timeFormat & CStr(Minute(str))
else
timeFormat = timeFormat & "0" & CStr(Minute(str))
end if
timeFormat = timeFormat & ":"
if Len(Cstr(Second(str))) > 1 then
timeFormat = timeFormat & CStr(Second(str))
else
timeFormat = timeFormat & "0" & CStr(Second(str))
end if
end if
end function
function formEscape(byVal str)
formEscape = replace(str, """", """)
end function
function dbEncode(ByVal str)
dbEncode = nwHtmlSpecialChars(str, false)
end function
function dbDecode(ByVal str)
dbDecode = nwUndoHtmlSpecialChars(str)
end function
function htmlEncode(ByVal str)
str = replace(str, "<", "<")
str = replace(str, ">", ">")
str = replace(str, vbCrLf, "
")
htmlEncode = str
end function
'the second parameter must be true only in case the function is
'used to display the text in page;
function nwHtmlSpecialChars(ByVal text, ByVal forView)
if ( forView ) then
if ( trim(text) = "" ) then
nwHtmlSpecialChars = " "
exit function
end if
end if
text = replace(text, "<", "<")
text = replace(text, ">", ">")
text = replace(text, CStr(chr(34)), """)
text = replace(text, vbCrLf, "
")
nwHtmlSpecialChars = text
end function
function nwUndoHtmlSpecialChars(ByVal text)
text = replace(text, "<", "<")
text = replace(text, ">", ">")
text = replace(text, """, CStr(chr(34)))
text = replace(text, "
", vbCrLf)
nwUndoHtmlSpecialChars = text
end function
Function nwReFind(ByVal str, ByVal patrn)
Dim regEx
Set regEx = New RegExp
regEx.Pattern = patrn
regEx.IgnoreCase = True
regEx.Global = True
Set nwReFind = regEx.Execute(str)
set regEx = nothing
End Function
' Stops execution on fatal error
' @param Code (int) Error code
Function nwRaiseFatalError(ByVal errObj, ByVal isDebugMode)
Dim errMsg, errDescription, errNumber
errNumber = errObj.number
errDescription = errObj.description
if isDebugMode then
errMsg = "" & errDescription & "
"
else
errMsg = "" & nwGetLocaleString("Error.Text.Generic", null) & "
" & _
nwGetLocaleString("Error.Text.Code", null) & " " & errNumber & "
"
end if
Response.Write(errMsg)
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 "{#}"
' @returns OnSuccess Key's value
' @returns OnFailure "[[Key]]"
function nwGetLocaleString(ByVal Key, ByVal CustomTags)
dim outStr
On Error Resume Next
outStr = "[[" & Key & "]]"
If TypeName(nof_locale) <> "Dictionary" Then
nwGetLocaleString = 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
nwGetLocaleString = outStr
end function
%>