" & vbCrLF & _
"" & vbCrLf
end sub
private sub ShowCategories(ByVal cond)
dim i
on error resume next
if mCategoryRs.RecordCount > 0 then
mCategoryRs.MoveFirst
mCategoryRs.PageSize = mRecordsPerPage
mCategoryRs.AbsolutePage = mReqFaqPage
end if
call AdmHeader()
Response.Write "" & vbCrLf & _
"| " & faqGetLocaleString("faq.Admin.AddCategory.Link", null) & " | " & vbCrLf & _
" " & vbCrLf
if ( mCategoryRs.RecordCount > 0 ) then
Response.Write " " & vbCrLf & _
" " & vbCrLf & _
" | " & _
" " & faqGetLocaleString("faq.Admin.Category.Label", null)& " | " & vbCrLf & _
" | " & vbCrLf & _
" " & vbCrLf
dim bg_color
bg_color = "#ffffff"
for i=1 to mCategoryRs.PageSize
if mCategoryRs.EOF then exit for
if bg_color = "#ffffff" then
bg_color = "#ffffee"
else
bg_color = "#ffffff"
end if
Response.Write " " & vbCrLf & _
" | " & Trim(mCategoryRs.Fields("Name").Value) & " | " & vbCrLf & _
" " & _
faqGetLocaleString("faq.Admin.EditFaq.Link", null) & " | " & vbCrLf & _
"" & _
faqGetLocaleString("faq.Admin.DeleteFaq.Link", null) & " | " & vbCrLf & " " & vbCrLf
mCategoryRs.MoveNext
next
dim href
href = Request.ServerVariables("URL").Item & "?act=adm.categ_list&faq_indx=[[page]]&ci=" & mComponentId
Response.Write " " & vbCrLf & Navigator(mCategoryRs, mRecordsPerPage, href)
else
Response.Write faqGetLocaleString("faq.Admin.NoCategories.Text", null)
end if
Response.Write " | " & vbCrLf
end sub
private sub CategoryForm(ByVal Id)
dim i, question, answer, dId
name = ""
description = ""
if id <> "" then
if mCategoryRs.RecordCount > 0 then
mCategoryRs.MoveFirst
do while not mCategoryRs.EOF
if Trim(mCategoryRs.Fields("Id")) = Id then
name = Trim(mCategoryRs.Fields("Name").Value)
description = Trim(mCategoryRs.Fields("Description").Value)
exit do
end if
mCategoryRs.MoveNext
loop
end if
end if
call AdmHeader()
Response.Write " " & vbCrLf
Response.Write "" & vbCrLf
end sub
private sub ShowRanks(ByVal cond)
dim i
on error resume next
if mRankRs.RecordCount > 0 then
mRankRs.MoveFirst
mRankRs.PageSize = mRecordsPerPage
mRankRs.AbsolutePage = mReqFaqPage
end if
call AdmHeader()
Response.Write "" & vbCrLf & _
"| " & faqGetLocaleString("faq.Admin.AddRank.Link", null) & " | " & vbCrLf & _
" " & vbCrLf
if ( mRankRs.RecordCount > 0 ) then
Response.Write " " & vbCrLf & _
" " & vbCrLf & _
" | " & _
" " & faqGetLocaleString("faq.Admin.RankList.RankColumn.Label", null) & " | " & vbCrLf & _
" " & _
" " & faqGetLocaleString("faq.Admin.RankList.RankNameColumn.Label", null) & " | " & vbCrLf & _
" | " & vbCrLf & _
" " & vbCrLf
dim bg_color
bg_color = "#ffffff"
for i=1 to mRankRs.RecordCount
if mRankRs.EOF then exit for
if bg_color = "#ffffff" then
bg_color = "#ffffee"
else
bg_color = "#ffffff"
end if
Response.Write " " & vbCrLf & _
" | " & Trim(mRankRs.Fields("Rate").Value) & " | " & vbCrLf & _
" " & Trim(mRankRs.Fields("Name").Value) & " | " & vbCrLf & _
" " & _
faqGetLocaleString("faq.Admin.EditRank.Link", null) & " | " & vbCrLf & _
"" & _
faqGetLocaleString("faq.Admin.DeleteRank.Link", null) & " | " & vbCrLf & " " & vbCrLf
mRankRs.MoveNext
next
Response.Write " " & vbCrLf
else
Response.Write faqGetLocaleString("faq.Admin.NoRanks.Text", null)
end if
Response.Write " | " & vbCrLf
end sub
private sub RankForm(ByVal Id)
dim i, rate, name
rate = 1
name = ""
if id <> "" then
if mRankRs.RecordCount > 0 then
mRankRs.MoveFirst
do while not mRankRs.EOF
if Trim(mRankRs.Fields("Rate")) = Id then
rate = CLng(Trim(mRankRs.Fields("Rate").Value))
name = Trim(mRankRs.Fields("Name").Value)
exit do
end if
mRankRs.MoveNext
loop
end if
else
if mRankRs.RecordCount > 0 then
mRankRs.MoveFirst
do while not mRankRs.EOF
if Clng(Trim(mRankRs.Fields("Rate").Value)) > Clng(rate) then rate = Clng(Trim(mRankRs.Fields("Rate").Value))
mRankRs.MoveNext
loop
rate = Clng(rate) + 1
mRankRs.MoveFirst
end if
end if
call AdmHeader()
Response.Write " " & vbCrLf
Response.Write "" & vbCrLf
end sub
private function Navigator(ByVal rsObj, ByVal itemsOnPage, ByVal href)
Dim str, itemsNumber, i, pagesNumber
if itemsOnPage = 1 then mReqFaqPage = rsObj.AbsolutePosition
itemsNumber = mReqFaqPage * itemsOnPage
pagesNumber = Fix(rsObj.RecordCount / itemsOnPage)
if pagesNumber <> rsObj.RecordCount / itemsOnPage then
pagesNumber = pagesNumber + 1
end if
str = ""
if pagesNumber > 1 then
str = str & "" & vbCrLf
end if
Navigator = str
end function
private sub SaveFaq(ByVal id)
if id <> "" then
'save editted item
if mFaqRs.RecordCount > 0 then
mFaqRs.MoveFirst
do while not mFaqRs.EOF
if Trim(mFaqRs.Fields("Id").Value) = id then
with mFaqRs
.Fields("DomainId").Value = mReqCategId
.Fields("Question").Value = Request.Form("question").Item
.Fields("Answer").Value = Request.Form("answer").Item
.Fields("Date").Value = FormatDateTime( Date, 2 )
.Update
end with
exit do
end if
mFaqRs.MoveNext
loop
mFaqRs.MoveFirst
end if
else
'add new item
id = 1
if mFaqRs.RecordCount > 0 then
mFaqRs.MoveFirst
do while not mFaqRs.EOF
if Clng(Trim(mFaqRs.Fields("Id").Value)) > Clng(id) then id = Trim(mFaqRs.Fields("Id").Value)
mFaqRs.MoveNext
loop
mFaqRs.MoveFirst
end if
with mFaqRs
.AddNew
.Fields("Id").Value = CLng(id) + 1
.Fields("DomainId").Value = mReqCategId
.Fields("Question").Value = Request.Form("question").Item
.Fields("Answer").Value = Request.Form("answer").Item
.Fields("Description").Value = Request.Form("description").Item
.Fields("UserId").Value = ""
.Fields("RateId").Value = ""
.Fields("Hits").Value = ""
.Fields("Date").Value = FormatDateTime( Date, 2 )
.Update
end with
end if
call Save("faq")
if err.number <> 0 then
call SetError(err)
exit sub
end if
end sub
private sub SaveCategory(ByVal id)
if id <> "" then
'save editted item
if mCategoryRs.RecordCount > 0 then
mCategoryRs.MoveFirst
do while not mCategoryRs.EOF
if Trim(mCategoryRs.Fields("Id").Value) = id then
mCategoryRs.Fields("Name").Value = Request.Form("name").Item
mCategoryRs.Fields("Description").Value = Request.Form("description").Item
mCategoryRs.Update
exit do
end if
mCategoryRs.MoveNext
loop
mCategoryRs.MoveFirst
end if
else
'add new item
id = 1
if mCategoryRs.RecordCount > 0 then
mCategoryRs.MoveFirst
do while not mCategoryRs.EOF
if Clng(Trim(mCategoryRs.Fields("Id").Value)) > Clng(id) then id = Trim(mCategoryRs.Fields("Id").Value)
mCategoryRs.MoveNext
loop
mCategoryRs.MoveFirst
end if
with mCategoryRs
.AddNew
.Fields("Id").Value = CLng(id) + 1
.Fields("Name").Value = Request.Form("name").Item
.Fields("Description").Value = Request.Form("description").Item
.Update
end with
end if
call Save("category")
if err.number <> 0 then
call SetError(err)
exit sub
end if
end sub
private sub SaveRank(ByVal id)
Dim rate, addNew
rate = Request.Form("rate").Item
addNew = true
if id <> "" then
'save editted item
if mRankRs.RecordCount > 0 then
mRankRs.MoveFirst
do while not mRankRs.EOF
if Trim(mRankRs.Fields("Rate").Value) = rate then
mRankRs.Fields("Name").Value = Request.Form("name").Item
mRankRs.Update
addNew = false
exit do
end if
mRankRs.MoveNext
loop
mRankRs.MoveFirst
end if
if addNew then
'add new item
with mRankRs
.AddNew
.Fields("Rate").Value = rate
.Fields("Name").Value = Request.Form("name").Item
.Update
end with
end if
call Save("rank")
if err.number <> 0 then
call SetError(err)
exit sub
end if
end if
end sub
private sub DeleteFaq(ByVal id)
if id <> "" then
if mFaqRs.RecordCount > 0 then
mFaqRs.MoveFirst
do while not mFaqRs.EOF
if Trim(mFaqRs.Fields("Id").Value) = id then
mFaqRs.Delete
mFaqRs.Update
exit do
end if
mFaqRs.MoveNext
loop
mFaqRs.MoveFirst
call Save("faq")
if err.number <> 0 then
call SetError(err)
exit sub
end if
end if
end if
end sub
private sub DeleteFaqByDomain(ByVal domainId)
if id <> "" then
if mFaqRs.RecordCount > 0 then
mFaqRs.MoveFirst
do while not mFaqRs.EOF
if Trim(mFaqRs.Fields("DomainId").Value) = domainId then
mFaqRs.Delete
mFaqRs.Update
exit do
end if
mFaqRs.MoveNext
loop
mFaqRs.MoveFirst
end if
end if
end sub
private sub DeleteCategory(ByVal id)
if id <> "" then
if mCategoryRs.RecordCount > 0 then
mCategoryRs.MoveFirst
do while not mCategoryRs.EOF
if Trim(mCategoryRs.Fields("Id").Value) = id then
Call DeleteFaqByDomain(id)
mCategoryRs.Delete
mCategoryRs.Update
exit do
end if
mCategoryRs.MoveNext
loop
mCategoryRs.MoveFirst
call Save("faq")
if err.number <> 0 then
call SetError(err)
exit sub
end if
call Save("category")
if err.number <> 0 then
call SetError(err)
exit sub
end if
end if
end if
end sub
private sub DeleteRank(ByVal id)
if id <> "" then
if mRankRs.RecordCount > 0 then
mRankRs.MoveFirst
do while not mRankRs.EOF
if Trim(mRankRs.Fields("Rate").Value) = id then
mRankRs.Delete
mRankRs.Update
exit do
end if
mRankRs.MoveNext
loop
mRankRs.MoveFirst
call Save("rank")
if err.number <> 0 then
call SetError(err)
exit sub
end if
end if
end if
end sub
private sub Save(ByVal table)
Dim f, line, i
on error resume next
select case LCase(table)
case "faq"
set f = faqOpenFile(mFaqFilePath, 2)
if f is nothing then
exit sub
end if
f.WriteLine mFaqTableHead
if mFaqRs.BOF and mFaqRs.EOF then
else
mFaqRs.MoveFirst
do while not mFaqRs.EOF
line = ""
for i=0 to mFaqRs.Fields.Count - 1
if line <> "" then line = line & ";"
line = line & """" & Encode(Trim(mFaqRs.Fields(i).Value)) & """"
next
f.WriteLine line
mFaqRs.MoveNext
loop
end if
f.close
case "rank"
set f = faqOpenFile(mRankFilePath, 2)
if f is nothing then
exit sub
end if
f.WriteLine mRankTableHead
if mRankRs.BOF and mRankRs.EOF then
else
mRankRs.MoveFirst
do while not mRankRs.EOF
line = ""
for i=0 to mRankRs.Fields.Count - 1
if line <> "" then line = line & ";"
line = line & """" & Encode(Trim(mRankRs.Fields(i).Value)) & """"
next
f.WriteLine line
mRankRs.MoveNext
loop
end if
f.close
case "category"
set f = faqOpenFile(mCategoryFilePath, 2)
if f is nothing then
exit sub
end if
f.WriteLine mCategoryTableHead
if mCategoryRs.BOF and mCategoryRs.EOF then
else
mCategoryRs.MoveFirst
do while not mCategoryRs.EOF
line = ""
for i=0 to mCategoryRs.Fields.Count - 1
if line <> "" then line = line & ";"
line = line & """" & Encode(Trim(mCategoryRs.Fields(i).Value)) & """"
next
f.WriteLine line
mCategoryRs.MoveNext
loop
end if
f.close
end select
end sub
private function Encode(ByVal s)
Dim str
on error resume next
str = s
str = Replace(str, vbCrLf, "vbCrLf")
str = Replace(str, """", """)
Encode = str
end function
private function Decode(ByVal s)
Dim str
on error resume next
str = s
str = Replace(str, "vbCrLf", vbCrLf)
str = Replace(str, """, """")
Decode = str
end function
end class
%>
|
"
mPrefix = ""
mRecordsPerPage = 10
mNextPage = ""
mLanguage = "en"
mFaqTableHead = "Id,DomainId,Question,Description,Answer,UserId,RateId,Hits,Date"
mRankTableHead = "Rate,Name"
mCategoryTableHead = "Id,Name,Description"
redim mDefaultRate(4)
mDefaultRate(1) = faqGetLocaleString("faq.Rate.1.Text", null) '"Slightly"
mDefaultRate(2) = faqGetLocaleString("faq.Rate.2.Text", null) '"Quite"
mDefaultRate(3) = faqGetLocaleString("faq.Rate.3.Text", null) '"Good"
mDefaultRate(4) = faqGetLocaleString("faq.Rate.4.Text", null) '"Very Good"
mErrorMessage = ""
end sub
private sub Class_Terminate()
on error resume next
set mFaqRs = nothing
set mRankRs = nothing
set mCategoryRs = nothing
if mErrorMessage <> "" then Response.Write mErrorMessage
end sub
public function Initialize(ByVal sitePath, ByVal scriptDir, ByVal rootDir, ByVal debugMode)
on error resume next
Initialize = false
mSitePath = sitePath
mScriptsDirName = scriptDir
mRelPathToRoot = rootDir
mIsDebugMode = debugMode
mRankStar = Replace(mRankStar, "[[path]]", rootDir & scriptDir)
Dim xmlDoc
set xmlDoc = faqOpenXMLFile(mSitePath & mScriptsDirName & "\" & mXmlPropFile)
if xmlDoc is nothing then
if err.number = 0 then
call err.Raise ( 601, "faq_search.Initialize", faqGetLocaleString("Error.601", Array(mSitePath & mScriptsDirName & "\" & mXmlPropFile)) )
end if
call SetError(err)
exit function
end if
Dim ComponentNode
set ComponentNode = faqGetNode(xmlDoc,,"Component", Array("name","id"), Array(mComponentName, mComponentId), -1)
If ComponentNode Is Nothing Then
if err.number = 0 then
call err.Raise ( 400, "faq_search.Initialize", faqGetLocaleString("Error.400", Array(mComponentId)) )
end if
call SetError(err)
exit function
end if
mPrefix = faqGetProperty(ComponentNode, "dbPath")
if not inStr(1, mPrefix, "\", 1) > 0 then
Dim absPath, relPath
set relPath = nothing
set relPath = faqReFind(mPrefix, "\.\./")
absPath = mSitePath & mScriptsDirName
if not relPath is nothing then
if relPath.count > 0 then
for i=1 to relPath.count
absPath = Left(absPath, inStrRev(absPath,"\") - 1)
mPrefix = Replace(mPrefix, "../", "", 1, 1)
next
else
if inStr(1, mPrefix, "./") > 0 then
mPrefix = Replace(mPrefix, "./", "", 1, 1)
end if
end if
set relPath = nothing
end if
mPrefix = absPath & "\" & Replace(mPrefix, "/", "\")
end if
mFaqFilePath = mPrefix & "FAQ.csv"
mCategoryFilePath = mPrefix & "category.csv"
mRankFilePath = mPrefix & "rank.csv"
mRecordsPerPage = faqGetProperty(ComponentNode, "recordsperpage")
if ( mRecordsPerPage = "" ) then mRecordsPerPage = 10
mNextPage = faqGetProperty(ComponentNode, "nextpage")
mLanguage = faqGetProperty(ComponentNode, "language")
set ComponentNode = nothing
set xmlDoc = nothing
'initialize all the existing tables
if not faqFileExist(mFaqFilePath) then
if not faqCreateDB(mFaqFilePath, mFaqTableHead) then
call SetError(err)
exit function
end if
end if
set mFaqRs = faqRSFileContent(mFaqFilePath, "")
if mFaqRs is nothing then
call SetError(err)
exit function
end if
if not faqFileExist(mCategoryFilePath) then
if not faqCreateDB(mCategoryFilePath, mCategoryTableHead) then
call SetError(err)
exit function
end if
end if
set mCategoryRs = faqRSFileContent(mCategoryFilePath, "")
if mCategoryRs is nothing then
call SetError(err)
exit function
end if
if not faqFileExist(mRankFilePath) then
if not faqCreateDB(mRankFilePath, mRankTableHead) then
call SetError(err)
exit function
end if
end if
set mRankRs = faqRSFileContent(mRankFilePath, "")
if mRankRs is nothing then
call SetError(err)
exit function
end if
if mRankRs.RecordCount = 0 then
for i=1 to Ubound(mDefaultRate)
mRankRs.AddNew
mRankRs.Fields("Rate").Value = CStr(i)
mRankRs.Fields("Name").Value = mDefaultRate(i)
mRankRs.Update
next
call Save("rank")
if err.number <> 0 then
call SetError(err)
exit function
end if
end if
mRankRs.Sort = "Rate ASC"
if err.number = 0 then Initialize = true
end function
public sub ManageAdmin()
dim cond
cond = ""
if mReqCategId <> "" then cond = "DomainId=" & mReqCategId
if mConstraint <> "" then
if cond <> "" then
dim cnd
cnd = cond
cond = "(" & cnd & " and Question like '*" & Encode(mConstraint) & "*') or (" & cnd & " and Answer like '*" & Encode(mConstraint) & "*')"
else
cond = "Question like '*" & Encode(mConstraint) & "*' OR Answer like '*" & Encode(mConstraint) & "*'"
end if
end if
select case LCase(mReqAct)
case "adm.faq_add"
call FaqForm(mReqFaqId)
case "adm.faq_edit"
call FaqForm(mReqFaqId)
case "adm.faq_save"
call SaveFaq(mReqFaqId)
call ShowFaqs(cond)
case "adm.faq_delete"
call DeleteFaq(mReqFaqId)
call ShowFaqs(cond)
case "adm.faq_list"
call ShowFaqs(cond)
case "adm.categ_add"
call CategoryForm(mReqCategId)
case "adm.categ_edit"
call CategoryForm(mReqCategId)
case "adm.categ_save"
call SaveCategory(mReqCategId)
call ShowCategories("")
case "adm.categ_delete"
call DeleteCategory(mReqCategId)
call ShowCategories("")
case "adm.categ_list"
call ShowCategories("")
case "adm.rank_add"
call RankForm(mReqRankId)
case "adm.rank_edit"
call RankForm(mReqRankId)
case "adm.rank_save"
call SaveRank(mReqRankId)
call ShowRanks("")
case "adm.rank_delete"
call DeleteRank(mReqRankId)
call ShowRanks("")
case "adm.rank_list"
call ShowRanks("")
case else
call ShowFaqs(cond)
end select
end sub
private sub SetError(ByVal errObj)
dim errNumber, errDescription
errNumber = errObj.number
errDescription = errObj.description
if mIsDebugMode then
mErrorMessage = errDescription
else
mErrorMessage = "