<% class FaqDetails private mFaqRs private mRankRs private mCategoryRs private mConstraint private mDomainId private mDomainName private mRankFilePath private mCategoryFilePath private mFaqFilePath private mSitePath private mScriptsDirName private mRelPathToRoot private mRankStar private mFaqTableHead private mRankTableHead private mCategoryTableHead 'xml variables private mPrefix private mSendEmail private mShowHits private mShowNavigation private mShowRating private mShowRatingEditor private mShowModify private mRecordsPerPage private mNextPage private mIsDebugMode private mDefaultRate private mErrorMessage private mLanguage 'request variables private mReqAct private mReqFaqId private mReqFaqPage public mComponentId public mComponentName public mXmlPropFile public mLangFile private sub Class_Initialize() on error resume next set mFaqRs = Server.CreateObject("ADODB.RecordSet") set mRankRs = Server.CreateObject("ADODB.RecordSet") set mCategoryRs = Server.CreateObject("ADODB.RecordSet") mConstraint = "" if Request.Form("toc_question").Item <> "" then mConstraint = Request.Form("toc_question").Item elseif Request.QueryString("question").Item <> "" then mConstraint = Request.QueryString("question").Item end if mDomainId = "" if Request("id_domain").Item <> "" then mDomainId = Request("id_domain").Item mDomainName = "" mIsDebugMode = false mRankStar = "

" mPrefix = "" mSendEmail = false mShowHits = false mShowNavigation = false mShowRating = false mShowRatingEditor = false mShowModify = false mRecordsPerPage = 10 mNextPage = "" mLanguage = "en" mFaqTableHead = "Id,DomainId,Question,Description,Answer,UserId,RateId,Hits,Date" mRankTableHead = "Rate,Name" mCategoryTableHead = "Id,Name,Description" mReqAct = "" if Request("act").Item <> "" then mReqAct = Request("act").Item mReqFaqId = "" if Request("id_faq").Item <> "" then mReqFaqId = Request("id_faq").Item mReqFaqPage = 1 if Request("faq_indx").Item <> "" then mReqFaqPage = Request("faq_indx").Item 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" mSendEmail = faqGetProperty(ComponentNode, "sendEmail") if ( mSendEmail <> "" ) then mSendEmail = CBool(mSendEmail) mShowHits = faqGetProperty(ComponentNode, "showhits") if ( mShowHits <> "" ) then mShowHits = CBool(mShowHits) mShowNavigation = faqGetProperty(ComponentNode, "shownavigation") if ( mShowNavigation <> "" ) then mShowNavigation = CBool(mShowNavigation) mShowRating = faqGetProperty(ComponentNode, "showrating") if ( mShowRating <> "" ) then mShowRating = CBool(mShowRating) mShowRatingEditor = faqGetProperty(ComponentNode, "showratingeditor") if ( mShowRatingEditor <> "" ) then mShowRatingEditor = CBool(mShowRatingEditor) mShowModify = faqGetProperty(ComponentNode, "showmodify") if ( mShowModify <> "" ) then mShowModify = CBool(mShowModify) 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 if err.number = 0 then Initialize = true end function public sub ManageDetails() dim cond cond = "" if mDomainId <> "" then cond = "DomainId=" & mDomainId if mConstraint <> "" then if cond <> "" then dim cnd cnd = cond cond = "(" & cnd & "Question like '*" & mConstraint & "*') or (" & cnd & "Answer like '*" & mConstraint & "*')" else cond = "Question like '*" & mConstraint & "*' OR Answer like '*" & mConstraint & "*'" end if end if select case LCase(mReqAct) case "cli.faq_view" call FaqHit(mReqFaqId) if err.number <> 0 then call SetError(err) exit sub end if call ShowFAQDetails(mReqFaqId, cond) case "cli.faq_list" call ShowDetails(cond) case "cli.faq_rate" call RateFaq(mReqFaqId, Request.Form("id_rank").Item) if err.number <> o then call SetError(err) exit sub end if call ShowFAQDetails(mReqFaqId, cond) case "cli.faq_search" if mConstraint <> "" then cond = "Question like '*" & mConstraint & "*' OR Answer like '*" & mConstraint & "*'" call ShowDetails(cond) case else if mConstraint <> "" then cond = "Question like '*" & mConstraint & "*' OR Answer like '*" & mConstraint & "*'" call ShowDetails(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 = "

" & faqGetLocaleString("Error.Text.Generic", null) & "

" & _ "

" & faqGetLocaleString("Error.Text.Code", null) & " " & errNumber & "

" end if errObj.Clear end sub public sub ShowDetails(ByVal cond) dim lRs on error resume next set lRs = mFaqRs.Clone if cond <> "" then lRs.Filter = cond if lRs.RecordCount > 0 then lRs.MoveFirst lRs.PageSize = mRecordsPerPage lRs.AbsolutePage = mReqFaqPage end if dim pageCount pageCount = lRs.PageCount if pageCount = 0 then pageCount = 1 Response.Write " " & vbCrLF & _ " " & vbCrLf & _ " " & vbCrLf & _ " " & vbCrLf if ( mShowNavigation ) then Dim previousRef, nextRef previousRef = Request.ServerVariables("URL").Item & "?act=cli.faq_list&ci=" & mComponentId nextRef = Request.ServerVariables("URL").Item & "?act=cli.faq_list&ci=" & mComponentId Response.Write " " & vbCrLf end if Response.Write " " & vbCrLf & "

" if mDomainId <> "" then Response.Write faqGetLocaleString("faq.Details.Show.Header.Category.Label", null) & ": " & _ DomainName(mDomainId) & "" & vbCrLf elseif mReqAct = "cli.faq_search" then Response.Write faqGetLocaleString("faq.Search.Text.FaqFound", null) & " " & mConstraint else Response.Write faqGetLocaleString("faq.Details.Show.Header.AllCategories.Label", null) end if Response.Write "

" & _ faqGetLocaleString("faq.Details.Show.Header.CurrentPage", Array(mReqFaqPage,pageCount)) & "

" & Navigator(lRs, mRecordsPerPage, previousRef, nextRef) & "

" & vbCrLf & "

" & vbCrLf if not lRs.EOF then dim dateform for i=1 to lRs.PageSize if lRs.EOF then exit for if mLanguage = "en" then dateform = month(Trim(lRs.Fields("Date").Value)) & "/" & _ day(Trim(lRs.Fields("Date").Value)) & "/" & _ year(Trim(lRs.Fields("Date").Value)) else dateform = day(Trim(lRs.Fields("Date").Value)) & "." & _ month(Trim(lRs.Fields("Date").Value)) & "." & _ year(Trim(lRs.Fields("Date").Value)) end if Response.Write " " & vbCrLf & _ " " & vbCrLf & _ " " & vbCrLf & " " & vbCrLf & _ " " & vbCrLf & _ " " & vbCrLf & _ " " & vbCrLf & "

" & _ DecodeStr(Trim(lRs.Fields("Question").Value)) & "

" & vbCrLf & _ "

" if Len(Trim(lRs.Fields("Answer").Value)) > 100 then Response.Write DecodeStr(Mid(Trim(lRs.Fields("Answer").Value), 1, 100)) & " ..." else Response.Write DecodeStr(Trim(lRs.Fields("Answer").Value)) end if Response.Write "

" & vbCrLf Response.Write " " & vbCrLf & _ " " & vbCrLf & _ " " & vbCrlf & _ " " & vbCrLf & _ " " & vbCrLf & _ " " & vbCrLf & "

" & _ faqGetLocaleString("faq.Rate.Label", null) & " " & GetRatingStars(Trim(lRs.Fields("RateId").Value)) & _ "

" & _ faqGetLocaleString("faq.Hits.Label", null) & ": " & Trim(lRs.Fields("Hits").Value) & _ "

" & _ faqGetLocaleString("faq.ModifiyDate.Label", null) & ": " & _ dateform & "

" & vbCrLf Response.Write " " & vbCrLf & _ " " & vbCrLf & " " & vbCrLf & _ " " & vbCrLf & "

" & vbCrLf & "
" & vbCrLf lRs.MoveNext next lRs.MoveFirst else Response.Write "

" & faqGetLocaleString("faq.Admin.NoQuestions.Text", null) & "

" & vbCrLf end if set lRs = nothing end sub public sub ShowFAQDetails(ByVal id, ByVal cond) dim lRs, prevId, nextId on error resume next set lRs = mFaqRs.Clone if cond <> "" then lRs.Filter = cond prevId = 0 nextId = 0 lRs.MoveFirst do while not lRs.EOF lRs.MovePrevious if not lRs.BOF then prevId = Trim(lRs.Fields("Id").Value) lRs.MoveNext if Trim(lRs.Fields("Id").Value) = id then lRs.MoveNext if not lRs.EOF then nextId = Trim(lRs.Fields("Id").Value) lRs.MovePrevious exit do end if lRs.MoveNext loop dim dateform if mLanguage = "en" then dateform = month(Trim(lRs.Fields("Date").Value)) & "/" & _ day(Trim(lRs.Fields("Date").Value)) & "/" & _ year(Trim(lRs.Fields("Date").Value)) else dateform = day(Trim(lRs.Fields("Date").Value)) & "." & _ month(Trim(lRs.Fields("Date").Value)) & "." & _ year(Trim(lRs.Fields("Date").Value)) end if Response.Write " " & vbCrLf & _ " " & vbCrLF & " " & vbCrLf & " " & vbCrLf Response.Write " " & vbCrLF & " " & vbCrLf & " " & vbCrLf & _ " " & vbrLf & " " & vbCrLf & " " & vbCrLf if ( mShowModify ) then Response.Write " " & vbCrLf & " " & vbCrLf & " " & vbCrLf & _ " " & vbCrLf & " " & vbCrLf & "" & vbCrLf & _ " " & vbCrLf & " " & vbCrLf & " " & vbCrLf & _ " " & vbCrLf & " " & vbCrLf & " " & vbCrLf & _ " " & vbCrLf & " " & vbCrLf & _ "

" & vbCrLf & _ " " & vbCrLf & _ " " & vbCrLf & _ " " & vbCrLf & _ " " & vbCrLf & _ " " & vbCrLf if ( mShowNavigation ) then Dim previousRef, nextRef previousRef = Request.ServerVariables("URL").Item & "?act=cli.faq_view&id_faq=" & prevId & "&ci=" & mComponentId nextRef = Request.ServerVariables("URL").Item & "?act=cli.faq_view&id_faq=" & nextId & "&ci=" & mComponentId Response.Write " " & vbCrLf end if Response.Write "

" & _ faqGetLocaleString("faq.Details.BackLink", null) & "

" & faqGetLocaleString("faq.Details.Show.Header.Category.Label", null) & ": " & DomainName(Trim(lRs.Fields("DomainId").Value)) & "

" & _ faqGetLocaleString("faq.Details.Show.Header.CurrentPage", Array(lRs.AbsolutePosition,lRs.RecordCount)) & "

" & Navigator(lRs, 1, previousRef, nextRef) & "

" & vbCrLf & "

" & DecodeStr(Trim(lRs.Fields("Question").Value)) & _ "

" & _ "Modified on: " & dateform & "

" & DecodeStr(Trim(lRs.Fields("Answer").Value)) & _ "

" & vbCrLf & _ " " & vbCrLf if ( mShowRatingEditor ) then Response.Write " " Response.Write " " & vbCrLf if ( mShowRating ) then Response.Write " " & vbCrLf & _ "

" & _ faqGetLocaleString("faq.Details.Item.RatingQuestion", null) & vbCrLf & _ GetRatingSelect(Trim(lRs.Fields("RateId").Value)) & _ "

" & _ faqGetLocaleString("faq.RateAverage.Label", null) & ": " & _ GetRatingStars(Trim(lRs.Fields("RateId").Value)) + "

" & vbCrLf set lRs = nothing end sub private function FaqHit(ByVal id) dim hitNr hitNr = 0 if mFaqRs.RecordCount > 0 then mFaqRs.MoveFirst do while not mFaqRs.EOF if Trim(mFaqRs.Fields("Id").Value) = id then if Trim(mFaqRs.Fields("Hits").Value) <> "" then hitNr = Clng(Trim(mFaqRs.Fields("Hits").Value)) mFaqRs.Fields("Hits").Value = hitNr + 1 mFaqRs.Update exit do end if mFaqRs.MoveNext loop mFaqRs.MoveFirst call Save("faq") if err.number <> 0 then exit function end if end if end function private function RateFaq(ByVal faqId, ByVal rate) if mFaqRs.RecordCount > 0 then mFaqRs.MoveFirst do while not mFaqRs.EOF if Trim(mFaqRs.Fields("Id").Value) = faqId then if rate <> "" then if Trim(mFaqRs.Fields("RateId").Value) <> "" then mFaqRs.Fields("RateId").Value = (CDbl(Trim(mFaqRs.Fields("RateId").Value)) + CLng(rate)) / 2 else mFaqRs.Fields("RateId").Value = rate end if end if exit do end if mFaqRs.MoveNext loop mFaqRs.MoveFirst call Save("faq") if err.number <> 0 then exit function end if end if end function 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 & """" & 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 & """" & 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 & """" & Trim(mCategoryRs.Fields(i).Value) & """" next f.WriteLine line mCategoryRs.MoveNext loop end if f.close end select end sub private function GetRatingSelect(ByVal rate) dim str_select str_select= vbCrLf & _ "" & vbCrLf GetRatingSelect = str_select end function private function Navigator(ByVal rsObj, ByVal itemsOnPage, ByVal previousRef, ByVal nextRef) Dim str, itemsNumber if itemsOnPage = 1 then mReqFaqPage = rsObj.AbsolutePosition itemsNumber = mReqFaqPage * itemsOnPage str = "" & _ "" & _ "

" if mReqFaqPage > 1 then str = str & "" & _ faqGetLocaleString("faq.Details.Show.Header.PreviousPage", null) & "" else str = str & "" & faqGetLocaleString("faq.Details.Show.Header.PreviousPage", null) & "" end if str = str & "

" if itemsNumber < rsObj.RecordCount then str = str & "" & _ faqGetLocaleString("faq.Details.Show.Header.NextPage", null) & "" else str = str & "" & faqGetLocaleString("faq.Details.Show.Header.NextPage", null) & "" end if str = str & "

" Navigator = str end function private function DomainName(ByVal id) DomainName = "" if mCategoryRs.RecordCount > 0 then do while not mCategoryRs.EOF if Trim(mCategoryRs.Fields("Id").Value) = id then DomainName = Trim(mCategoryRs.Fields("Name").Value) exit do end if mCategoryRs.MoveNext loop mCategoryRs.MoveFirst end if end function private function GetRatingStars(ByVal Rate) dim str str = "" if Rate <> "" then for j=1 to Clng(Rate) str = str & mRankStar & vbCrlf next else str = faqGetLocaleString("faq.NotRated.Label", null) end if GetRatingStars = str end function private function DecodeStr(ByVal str) dim s s = str s = Replace(s, "<", "<") s = Replace(s, ">", ">") s = Replace(s, """, """") s = Replace(s, "vbCrLf", "
") DecodeStr = s end function end class %>