<%@ CodePage=1256 LCID=1065 %> <% Const EW_PAGE_ID = "list" Const EW_TABLE_NAME = "news" %> <% Session.Timeout = 60 %> <% Response.Expires = 0 Response.ExpiresAbsolute = Now() - 1 Response.AddHeader "pragma", "no-cache" Response.AddHeader "cache-control", "private, no-cache, no-store, must-revalidate" %> <% ' Open connection to the database Dim conn Set conn = Server.CreateObject("ADODB.Connection") conn.Open EW_DB_CONNECTION_STRING %> <% Dim Security Set Security = New cAdvancedSecurity %> <% %> <% ' Common page loading event (in userfn60.asp) Call Page_Loading() %> <% ' Page load event, used in current page Call Page_Load() %> <% news.Export = Request.QueryString("export") ' Get export parameter sExport = news.Export ' Get export parameter, used in header sExportFile = news.TableVar ' Get export file, used in header %> <% ' Paging variables Dim Pager, PagerItem ' Pager Dim nDisplayRecs ' Number of display records Dim nRecRange ' Record display range Dim nStartRec, nStopRec, nTotalRecs nStartRec = 0 ' Start record index nStopRec = 0 ' Stop record index nTotalRecs = 0 ' Total number of records nDisplayRecs = 1 nRecRange = 10 Dim i Dim nRecCount nRecCount = 0 ' Record count Dim RowCnt, RowIndex, OptionCnt ' Sort Dim sSortOrder ' Search filters Dim sSrchAdvanced, sSrchBasic, sSrchWhere, sFilter sSrchAdvanced = "" ' Advanced search filter sSrchBasic = "" ' Basic search filter sSrchWhere = "" ' Search where clause sFilter = "" Dim bEditRow, nEditRowCnt ' Edit row Dim sDeleteConfirmMsg ' Delete confirm message sDeleteConfirmMsg = "آيا از حذف اين خبر مطمئن هستيد؟ " ' Master/Detail Dim sDbMasterFilter, sDbDetailFilter sDbMasterFilter = "" ' Master filter sDbDetailFilter = "" ' Detail filter Dim sSqlMaster sSqlMaster = "" ' Sql for master record ' Set up records per page dynamically SetUpDisplayRecs() ' Handle reset command ResetCmd() ' Get basic search criteria sSrchBasic = BasicSearchWhere() ' Build search criteria If sSrchAdvanced <> "" Then If sSrchWhere <> "" Then sSrchWhere = sSrchWhere & " AND " sSrchWhere = sSrchWhere & "(" & sSrchAdvanced & ")" End If If sSrchBasic <> "" Then If sSrchWhere <> "" Then sSrchWhere = sSrchWhere & " AND " sSrchWhere = sSrchWhere & "(" & sSrchBasic & ")" End If ' Save search criteria If sSrchWhere <> "" Then If sSrchBasic = "" Then Call ResetBasicSearchParms() news.SearchWhere = sSrchWhere ' Save to Session nStartRec = 1 ' Reset start record counter news.StartRecordNumber = nStartRec Else Call RestoreSearchParms() End If ' Build filter sFilter = "" If sDbDetailFilter <> "" Then If sFilter <> "" Then sFilter = sFilter & " AND " sFilter = sFilter & "(" & sDbDetailFilter & ")" End If If sSrchWhere <> "" Then If sFilter <> "" Then sFilter = sFilter & " AND " sFilter = sFilter & "(" & sSrchWhere & ")" End If ' Set up filter in Session news.SessionWhere = sFilter news.CurrentFilter = "" ' Set Up Sorting Order SetUpSortOrder() ' Set Return Url news.ReturnUrl = "newslist.asp" %> <% If news.Export = "" Then %> <% End If %> <% If news.Export = "" Then %> <% End If %> <% ' Load recordset Dim rs Set rs = LoadRecordset() nTotalRecs = rs.RecordCount nStartRec = 1 If nDisplayRecs > 0 Then ' Display all records nDisplayRecs = nTotalRecs End If If Not (EW_EXPORT_ALL And news.Export <> "") Then SetUpStartRec() ' Set up start record position End If %>

اخبار

<% If news.Export = "" Then %>
  نمايش همه اخبار 
<% End If %> <% If Session(EW_SESSION_MESSAGE) <> "" Then %>

<%= Session(EW_SESSION_MESSAGE) %>

<% Session(EW_SESSION_MESSAGE) = "" ' Clear message End If %> <% If news.Export = "" Then %>
<% If Not IsObject(Pager) Then Set Pager = ew_NewPrevNextPager(nStartRec, nDisplayRecs, nTotalRecs) %> <% If Pager.RecordCount > 0 Then %> <% Else %> <% If sSrchWhere = "0=101" Then %> محدوده جستجو را وارد کنيد <% Else %> خبري يافت نشد <% End If %> <% End If %>
<% End If %>
<% If news.Export = "" Then %>
<% If Security.CanAdd Then %> ثبت خبر جديد    <% End If %>
<% End If %> <% If nTotalRecs > 0 Then %> <% OptionCnt = 0 If Security.CanEdit Then OptionCnt = OptionCnt + 1 ' edit End If If Security.CanDelete Then OptionCnt = OptionCnt + 1 ' delete End If %> <% If news.Export = "" Then %> <% If Security.CanEdit Then %> <% End If %> <% If Security.CanDelete Then %> <% End If %> <% End If %> <% If (EW_EXPORT_ALL And news.Export <> "") Then nStopRec = nTotalRecs Else nStopRec = nStartRec + nDisplayRecs - 1 ' Set the last record to display End If ' Move to first record directly for performance reason nRecCount = nStartRec - 1 If Not rs.Eof Then rs.MoveFirst rs.Move nStartRec - 1 End If RowCnt = 0 Do While (Not rs.Eof) And (nRecCount < nStopRec) nRecCount = nRecCount + 1 If CLng(nRecCount) >= CLng(nStartRec) Then RowCnt = RowCnt + 1 ' Init row class and style news.CssClass = "ewTableRow" news.CssStyle = "" ' Init row event news.RowClientEvents = "onmouseover='ew_MouseOver(this);' onmouseout='ew_MouseOut(this);' onclick='ew_Click(this);'" ' Display alternate color for rows If RowCnt Mod 2 = 0 Then news.CssClass = "ewTableAltRow" End If Call LoadRowValues(rs) ' Load row values news.RowType = EW_ROWTYPE_VIEW ' Render view Call RenderRow() %> > > ><%= news.NewsNo.ViewValue %> > ><%= news.NewsDate.ViewValue %> > ><%= news.NewsHeadline.ViewValue %> > ><%= news.NewsText.ViewValue %> > <% If news.PictureOrFile.HrefValue <> "" Then %> <% If Not IsNull(news.PictureOrFile.Upload.DbValue) Then %> <%= news.PictureOrFile.ViewValue %> <% End If %> <% Else %> <% If Not IsNull(news.PictureOrFile.Upload.DbValue) Then %> <%= news.PictureOrFile.ViewValue %> <% End If %> <% End If %> <% If news.Export = "" Then %> <% If Security.CanEdit Then %> <% End If %> <% If Security.CanDelete Then %> <% End If %> <% End If %> <% End If rs.MoveNext Loop %>
<% If news.Export <> "" Then %> شماره <% Else %> &ordertype=<%= news.NewsNo.ReverseSort %>" style="text-decoration: none">شماره<% If news.NewsNo.Sort = "ASC" Then %><% ElseIf news.NewsNo.Sort = "DESC" Then %><% End If %> <% End If %> <% If news.Export <> "" Then %> تاريخ <% Else %> &ordertype=<%= news.NewsDate.ReverseSort %>" style="text-decoration: none">تاريخ<% If news.NewsDate.Sort = "ASC" Then %><% ElseIf news.NewsDate.Sort = "DESC" Then %><% End If %> <% End If %> <% If news.Export <> "" Then %> عنوان خبر <% Else %> &ordertype=<%= news.NewsHeadline.ReverseSort %>" style="text-decoration: none">عنوان خبر <% If news.NewsHeadline.Sort = "ASC" Then %><% ElseIf news.NewsHeadline.Sort = "DESC" Then %><% End If %> <% End If %> <% If news.Export <> "" Then %> متن خبر <% Else %> متن خبر (*)<% If news.NewsText.Sort = "ASC" Then %><% ElseIf news.NewsText.Sort = "DESC" Then %><% End If %> <% End If %> <% If news.Export <> "" Then %> فايل ضميمه <% Else %> فايل ضميمه<% If news.PictureOrFile.Sort = "ASC" Then %><% ElseIf news.PictureOrFile.Sort = "DESC" Then %><% End If %> <% End If %>   
ويرايش حذف
<% End If %>
<% ' Close recordset and connection rs.Close Set rs = Nothing %> <% If news.Export = "" Then %> <% End If %> <% If news.Export = "" Then %> <% End If %> <% ' If control is passed here, simply terminate the page without redirect Call Page_Terminate("") ' ----------------------------------------------------------------- ' Subroutine Page_Terminate ' - called when exit page ' - clean up ADO connection and objects ' - if url specified, redirect to url, otherwise end response ' Sub Page_Terminate(url) ' Page unload event, used in current page Call Page_Unload() ' Global page unloaded event (in userfn60.asp) Call Page_Unloaded() conn.Close ' Close Connection Set conn = Nothing Set Security = Nothing Set news = Nothing ' Go to url if specified If url <> "" Then Response.Clear Response.Redirect url End If ' Terminate response Response.End End Sub ' ' Subroutine Page_Terminate (End) ' ---------------------------------------- %> <% ' Set up number of records displayed per page Sub SetUpDisplayRecs() Dim sWrk sWrk = Request.QueryString(EW_TABLE_REC_PER_PAGE) If sWrk <> "" Then If IsNumeric(sWrk) Then nDisplayRecs = CInt(sWrk) Else If LCase(sWrk) = "all" Then ' Display all records nDisplayRecs = -1 Else nDisplayRecs = 1 ' Non-numeric, load default End If End If news.RecordsPerPage = nDisplayRecs ' Save to Session ' Reset start position nStartRec = 1 news.StartRecordNumber = nStartRec Else If news.RecordsPerPage <> "" Then nDisplayRecs = news.RecordsPerPage ' Restore from Session Else nDisplayRecs = 1 ' Load default End If End If End Sub ' Return Basic Search sql Function BasicSearchSQL(Keyword) Dim sKeyword sKeyword = ew_AdjustSql(Keyword) BasicSearchSQL = "" BasicSearchSQL = BasicSearchSQL & "[NewsDate] LIKE '%" & sKeyword & "%' OR " BasicSearchSQL = BasicSearchSQL & "[NewsHeadline] LIKE '%" & sKeyword & "%' OR " BasicSearchSQL = BasicSearchSQL & "[NewsText] LIKE '%" & sKeyword & "%' OR " If Right(BasicSearchSQL, 4) = " OR " Then BasicSearchSQL = Left(BasicSearchSQL, Len(BasicSearchSQL)-4) End Function ' Return Basic Search Where based on search keyword and type Function BasicSearchWhere() Dim sSearchStr, sSearchKeyword, sSearchType Dim sSearch, arKeyword, sKeyword sSearchStr = "" sSearchKeyword = Request.QueryString(EW_TABLE_BASIC_SEARCH) sSearchType = Request.QueryString(EW_TABLE_BASIC_SEARCH_TYPE) If sSearchKeyword <> "" Then sSearch = Trim(sSearchKeyword) If sSearchType <> "" Then While InStr(sSearch, " ") > 0 sSearch = Replace(sSearch, " ", " ") Wend arKeyword = Split(Trim(sSearch), " ") For Each sKeyword In arKeyword If sSearchStr <> "" Then sSearchStr = sSearchStr & " " & sSearchType & " " sSearchStr = sSearchStr & "(" & BasicSearchSQL(sKeyword) & ")" Next Else sSearchStr = BasicSearchSQL(sSearch) End If End If If sSearchKeyword <> "" then news.BasicSearchKeyword = sSearchKeyword news.BasicSearchType = sSearchType End If BasicSearchWhere = sSearchStr End Function ' Clear all search parameters Sub ResetSearchParms() ' Clear search where sSrchWhere = "" news.SearchWhere = sSrchWhere ' Clear basic search parameters Call ResetBasicSearchParms() End Sub ' Clear all basic search parameters Sub ResetBasicSearchParms() ' Clear basic search parameters news.BasicSearchKeyword = "" news.BasicSearchType = "" End Sub ' Restore all search parameters Sub RestoreSearchParms() sSrchWhere = news.SearchWhere End Sub ' Set up Sort parameters based on Sort Links clicked Sub SetUpSortOrder() Dim sOrderBy Dim sSortField, sLastSort, sThisSort Dim bCtrl ' Check for an Order parameter If Request.QueryString("order").Count > 0 Then news.CurrentOrder = Request.QueryString("order") news.CurrentOrderType = Request.QueryString("ordertype") ' Field NewsNo Call news.UpdateSort(news.NewsNo) ' Field NewsDate Call news.UpdateSort(news.NewsDate) ' Field NewsHeadline Call news.UpdateSort(news.NewsHeadline) ' Field NewsText Call news.UpdateSort(news.NewsText) news.StartRecordNumber = 1 ' Reset start position End If sOrderBy = news.SessionOrderBy ' Get order by from Session If sOrderBy = "" Then If news.SqlOrderBy <> "" Then sOrderBy = news.SqlOrderBy news.SessionOrderBy = sOrderBy news.NewsNo.Sort = "DESC" End If End If End Sub ' Reset command based on querystring parameter cmd= ' - RESET: reset search parameters ' - RESETALL: reset search & master/detail parameters ' - RESETSORT: reset sort parameters Sub ResetCmd() Dim sCmd ' Get reset cmd If Request.QueryString("cmd").Count > 0 Then sCmd = Request.QueryString("cmd") ' Reset search criteria If LCase(sCmd) = "reset" Or LCase(sCmd) = "resetall" Then Call ResetSearchParms() End If ' Reset Sort Criteria If LCase(sCmd) = "resetsort" Then Dim sOrderBy sOrderBy = "" news.SessionOrderBy = sOrderBy news.NewsNo.Sort = "" news.NewsDate.Sort = "" news.NewsHeadline.Sort = "" news.NewsText.Sort = "" End If ' Reset start position nStartRec = 1 news.StartRecordNumber = nStartRec End If End Sub %> <% ' Set up Starting Record parameters based on Pager Navigation Sub SetUpStartRec() Dim nPageNo ' Exit if nDisplayRecs = 0 If nDisplayRecs = 0 Then Exit Sub ' Check for a START parameter If Request.QueryString(EW_TABLE_START_REC).Count > 0 Then nStartRec = Request.QueryString(EW_TABLE_START_REC) news.StartRecordNumber = nStartRec ElseIf Request.QueryString(EW_TABLE_PAGE_NO).Count > 0 Then nPageNo = Request.QueryString(EW_TABLE_PAGE_NO) If IsNumeric(nPageNo) Then nStartRec = (nPageNo-1)*nDisplayRecs+1 If nStartRec <= 0 Then nStartRec = 1 ElseIf nStartRec >= ((nTotalRecs-1)\nDisplayRecs)*nDisplayRecs+1 Then nStartRec = ((nTotalRecs-1)\nDisplayRecs)*nDisplayRecs+1 End If news.StartRecordNumber = nStartRec Else nStartRec = news.StartRecordNumber End If Else nStartRec = news.StartRecordNumber End If ' Check if correct start record counter If Not IsNumeric(nStartRec) Or nStartRec = "" Then ' Avoid invalid start record counter nStartRec = 1 ' Reset start record counter news.StartRecordNumber = nStartRec ElseIf CLng(nStartRec) > CLng(nTotalRecs) Then ' Avoid starting record > total records nStartRec = ((nTotalRecs-1)\nDisplayRecs)*nDisplayRecs+1 ' Point to last page first record news.StartRecordNumber = nStartRec ElseIf (nStartRec-1) Mod nDisplayRecs <> 0 Then nStartRec = ((nStartRec-1)\nDisplayRecs)*nDisplayRecs+1 ' Point to page boundary news.StartRecordNumber = nStartRec End If End Sub %> <% ' Load recordset Function LoadRecordset() ' Call Recordset Selecting event Call news.Recordset_Selecting(news.CurrentFilter) ' Load list page sql Dim sSql sSql = news.ListSQL ' Response.Write sSql ' Uncomment to show SQL for debugging ' Load recordset Dim rs Set rs = Server.CreateObject("ADODB.Recordset") rs.CursorLocation = EW_CURSORLOCATION rs.Open sSql, conn, 1, 2 ' Call Recordset Selected event Call news.Recordset_Selected(rs) Set LoadRecordset = rs End Function %> <% ' Load row based on key values Function LoadRow() Dim rs, sSql, sFilter sFilter = news.SqlKeyFilter If Not IsNumeric(news.NewsNo.CurrentValue) Then LoadRow = False ' Invalid key, exit Exit Function End If sFilter = Replace(sFilter, "@NewsNo@", ew_AdjustSql(news.NewsNo.CurrentValue)) ' Replace key value ' Call Row Selecting event Call news.Row_Selecting(sFilter) ' Load sql based on filter news.CurrentFilter = sFilter sSql = news.SQL Set rs = Server.CreateObject("ADODB.Recordset") rs.Open sSql, conn If rs.Eof Then LoadRow = False Else LoadRow = True rs.MoveFirst Call LoadRowValues(rs) ' Load row values ' Call Row Selected event Call news.Row_Selected(rs) End If rs.Close Set rs = Nothing End Function ' Load row values from recordset Sub LoadRowValues(rs) news.NewsNo.DbValue = rs("NewsNo") news.NewsDate.DbValue = rs("NewsDate") news.NewsHeadline.DbValue = rs("NewsHeadline") news.NewsText.DbValue = rs("NewsText") news.PictureOrFile.Upload.DbValue = rs("PictureOrFile") End Sub %> <% ' Render row values based on field settings Sub RenderRow() ' Call Row Rendering event Call news.Row_Rendering() ' Common render codes for all row types ' NewsNo news.NewsNo.CellCssStyle = "" news.NewsNo.CellCssClass = "" ' NewsDate news.NewsDate.CellCssStyle = "" news.NewsDate.CellCssClass = "" ' NewsHeadline news.NewsHeadline.CellCssStyle = "" news.NewsHeadline.CellCssClass = "" ' NewsText news.NewsText.CellCssStyle = "" news.NewsText.CellCssClass = "" ' PictureOrFile news.PictureOrFile.CellCssStyle = "" news.PictureOrFile.CellCssClass = "" If news.RowType = EW_ROWTYPE_VIEW Then ' View row ' NewsNo news.NewsNo.ViewValue = news.NewsNo.CurrentValue news.NewsNo.CssStyle = "" news.NewsNo.CssClass = "" news.NewsNo.ViewCustomAttributes = "" ' NewsDate news.NewsDate.ViewValue = news.NewsDate.CurrentValue news.NewsDate.ViewValue = ew_Highlight(news.NewsDate.ViewValue, news.BasicSearchKeyword, news.BasicSearchType, "") news.NewsDate.CssStyle = "" news.NewsDate.CssClass = "" news.NewsDate.ViewCustomAttributes = "" ' NewsHeadline news.NewsHeadline.ViewValue = news.NewsHeadline.CurrentValue news.NewsHeadline.ViewValue = ew_Highlight(news.NewsHeadline.ViewValue, news.BasicSearchKeyword, news.BasicSearchType, "") news.NewsHeadline.CssStyle = "" news.NewsHeadline.CssClass = "" news.NewsHeadline.ViewCustomAttributes = "" ' NewsText news.NewsText.ViewValue = news.NewsText.CurrentValue news.NewsText.ViewValue = ew_Highlight(news.NewsText.ViewValue, news.BasicSearchKeyword, news.BasicSearchType, "") news.NewsText.CssStyle = "" news.NewsText.CssClass = "" news.NewsText.ViewCustomAttributes = "" ' PictureOrFile If Not IsNull(news.PictureOrFile.Upload.DbValue) Then news.PictureOrFile.ViewValue = "فايل" Else news.PictureOrFile.ViewValue = "" End If news.PictureOrFile.CssStyle = "" news.PictureOrFile.CssClass = "" news.PictureOrFile.ViewCustomAttributes = "" ' NewsNo ' *** view refer script news.NewsNo.HrefValue = "" ' NewsDate ' *** view refer script news.NewsDate.HrefValue = "" ' NewsHeadline ' *** view refer script news.NewsHeadline.HrefValue = "" ' NewsText ' *** view refer script news.NewsText.HrefValue = "" ' PictureOrFile ' *** view refer script If Not IsNull(news.PictureOrFile.Upload.DbValue) Then news.PictureOrFile.HrefValue = "news_pictureorfile_bv.asp?NewsNo=" & news.NewsNo.CurrentValue If news.Export <> "" Then news.PictureOrFile.HrefValue = ew_ConvertFullUrl(news.PictureOrFile.HrefValue) Else news.PictureOrFile.HrefValue = "" End If ElseIf news.RowType = EW_ROWTYPE_ADD Then ' Add row ElseIf news.RowType = EW_ROWTYPE_EDIT Then ' Edit row ElseIf news.RowType = EW_ROWTYPE_SEARCH Then ' Search row End If ' Call Row Rendered event Call news.Row_Rendered() End Sub %> <% ' Write Audit Trail start/end for grid update Sub WriteAuditTrailDummy(typ) On Error Resume Next Dim table table = "news" ' Write Audit Trail Dim filePfx, curDate, curTime, id, user, action Dim i filePfx = "log" curDate = ew_ZeroPad(Year(Date), 4) & "/" & ew_ZeroPad(Month(Date), 2) & "/" & ew_ZeroPad(Day(Date), 2) curTime = ew_ZeroPad(Hour(Time), 2) & ":" & ew_ZeroPad(Minute(Time), 2) & ":" & ew_ZeroPad(Second(Time), 2) id = Request.ServerVariables("SCRIPT_NAME") If IsObject(Security) Then user = Security.CurrentUserID action = typ Call ew_WriteAuditTrail(filePfx, curDate, curTime, id, user, action, table, "", "", "", "") End Sub %> <% ' Page Load event Sub Page_Load() '***Response.Write "Page Load" End Sub ' Page Unload event Sub Page_Unload() '***Response.Write "Page Unload" End Sub %>