Ola pessoal to quebrando cabeça ainda com aquele blog, a bronca agora é essa, como eu aumento o limite de registro por pagina?? tente de tudo e na conegui. abaix o codigo para você darem uma maõzinha
<% @ Language=VBScript %>
<% Option Explicit %>
<!--#include file="common.asp" -->
<%
'****************************************************************************************
'** Copyright Notice
'**
'** Web Wiz NewsPad(TM)
'** http://www.webwiznewspad.com
'**
'** Copyright (C)2001-2011 Web Wiz Ltd. All Rights Reserved.
'**
'** THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS UNDER LICENSE FROM WEB WIZ LTD.
'**
'** IF YOU DO NOT AGREE TO THE LICENSE AGREEMENT THEN WEB WIZ LTD. IS UNWILLING TO LICENSE
'** THE SOFTWARE TO YOU, AND YOU SHOULD DESTROY ALL COPIES YOU HOLD OF 'WEB WIZ' SOFTWARE
'** AND DERIVATIVE WORKS IMMEDIATELY.
'**
'** If you have not received a copy of the license with this work then a copy of the latest
'** license contract can be found at:-
'**
'** http://www.webwiz.co.uk/license
'**
'** For more information about this software and for licensing information please contact
'** 'Web Wiz' at the address and website below:-
'**
'** Web Wiz Ltd, Unit 10E, Dawkins Road Industrial Estate, Poole, Dorset, BH15 4JD, England
'** http://www.webwiz.co.uk
'**
'** Removal or modification of this copyright notice will violate the license contract.
'**
'****************************************************************************************
'*************************** SOFTWARE AND CODE MODIFICATIONS ****************************
'**
'** MODIFICATION OF THE FREE EDITIONS OF THIS SOFTWARE IS A VIOLATION OF THE LICENSE
'** AGREEMENT AND IS STRICTLY PROHIBITED
'**
'** If you wish to modify any part of this software a license must be purchased
'**
'****************************************************************************************
'Set the response buffer to true as we maybe redirecting
Response.Buffer = True
'Make sure this page is not cached
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 2
Response.AddHeader "pragma","no-cache"
Response.AddHeader "cache-control","private"
Response.CacheControl = "No-Store"
'see if the web front end is active
Call WebFrontEnd()
'Dimension variables
Dim strSearchCriteria 'Holds the search criteria
Dim intCategory 'Holds the category we are looking at
Dim lngNewsletterID 'Holds saved newsletter ID
Dim strNewsletterSubject 'Holds saved newsletter Subject
Dim strNewsletterNote 'Holds saved newsletter Note
Dim dtmNewsletterDate 'Holds saved newsletter Date sent
Dim blnDisplay 'Set to true if displayed to public
Dim blnHTMLFormat 'Set to true if in HTML format
Dim sarryBlogPost 'Array to hold post recordset
Dim sarryMemberDetails 'Holds the members details
Dim intTotalRecords 'Total number of records in array
Dim lngTotalRecordsPages 'Total number of pages
Dim intStartPosition 'Start position in array
Dim intEndPosition 'End position in array
Dim intCurrentRecord 'Current record position
Dim intRecordPositionPageNum 'Current page position
Dim intRecordsPerPage 'Records displayed on each page
Dim intPageLinkLoopCounter 'Loop counter for displaying links to other pages
Dim strCategoryName 'Holds the name of the category
Dim strCanonicalURL 'Holds Canonical URL
Dim strPostLink 'Holds the link for the post
Dim lngNoOfComments 'Holds the number of comments
Dim strPageTitle 'Holds the page title for the page
Dim strUserID 'Holds the users ID
Dim strBlogPost 'Holds the blog post
Dim strBlogPostSubject 'Holds the blog post subject
Dim blnActiveMember
Dim strCatDescription
Dim strPostStartDate
Dim strPostEndDate
blnActiveMember = False
'Number of records per page
intRecordsPerPage = intBlogPostsPerPage
'If this is the first time the page is displayed then the Forum Topic record position is set to page 1
If isNumeric(Request.QueryString("PN")) = false Then
intRecordPositionPageNum = 1
ElseIf Request.QueryString("PN") < 1 Then
intRecordPositionPageNum = 1
'Else the page has been displayed before so the Forum Topic record postion is set to the Record Position number
Else
intRecordPositionPageNum = IntC(Request.QueryString("PN"))
End If
'Read in if there is a post month
If isDate(Request.QueryString("Y") & "-" & Request.QueryString("M")) Then
strPostStartDate = internationalDateTime(Request.QueryString("Y") & "-" & Request.QueryString("M") & "-1")
strPostEndDate = internationalDateTime(Request.QueryString("Y") & "-" & Request.QueryString("M") & "-" & getMonthDayNo(Request.QueryString("M"),Request.QueryString("Y")))
End If
'Read in if there is a post date
If isDate(Request.QueryString("DATE")) Then
strPostStartDate = internationalDateTime(Request.QueryString("DATE"))
strPostEndDate = internationalDateTime(Request.QueryString("DATE"))
End If
'Response.Write(strPostDate)
'Get the category to be displayed
If isNumeric(Request.QueryString("CAT")) = false Then
intCategory = 0
Else
intCategory = IntC(Request.QueryString("CAT"))
End If
'Get the search critiria if this is a search (clean it up incase of SQL injection
If NOT Request.QueryString("KW") = "" Then
strSearchCriteria = formatSQLInput(Trim(Mid(Request.QueryString("KW"), 1, 20)))
End If
'If we are within a category, read in the category name (done before main sql as some posts are not in categories)
If intCategory > 0 Then
strSQL = "SELECT " & strDbTable & "Category.Cat_Name, " & strDbTable & "Category.Description " & _
"FROM " & strDbTable & "Category " & _
"WHERE " & strDbTable & "Category.Cat_ID = " & intCategory & ";"
'Set error trapping
On Error Resume Next
'Query the database
rsCommon.Open strSQL, adoCon
'If an error has occurred write an error to the page
If Err.Number <> 0 Then Call errorMsg("An error has occurred while executing SQL query on database.", "get_cat_name", "default.asp")
'Disable error trapping
On Error goto 0
'If records returned read em in
If NOT rsCommon.EOF Then
strCategoryName = rsCommon("Cat_Name")
strCatDescription = rsCommon("Description")
'Use the blog description as the description meta tag
strBlogMetaDescription = strCatDescription
End If
rsCommon.Close
End If
'Initalise the strSQL variable with an SQL statement to query the database
strSQL = "SELECT " & strDbTable & "Newsletter.Newsletter_ID, " & strDbTable & "Newsletter.Newsletter_subject, " & strDbTable & "Newsletter.Newsletter_date, " & strDbTable & "Newsletter.Newsletter, " & strDbTable & "Newsletter.Author, " & strDbTable & "Newsletter.Allow_Comments, " & strDbTable & "Newsletter.Private " & _
"From " & strDbTable & "Newsletter" & strDBNoLock & " "
'If we are requiring a category we need to join the table
If intCategory > 0 Then
strSQL = strSQL & ", " & strDbTable & "NewsCat" & strDBNoLock & " " & _
"WHERE " & strDbTable & "Newsletter.Newsletter_ID = " & strDbTable & "NewsCat.Newsletter_ID " & _
"AND " & strDbTable & "NewsCat.Cat_ID = " & intCategory & " " & _
"AND " & strDbTable & "Newsletter.Blog_publish = " & strDBTrue & " "
Else
strSQL = strSQL & "WHERE " & strDbTable & "Newsletter.Blog_publish = " & strDBTrue & " "
End If
'If we have a date then include this in the WHERE clause
If isDate(strPostStartDate) Then
strSQL = strSQL & "AND (" & strDbTable & "Newsletter.Newsletter_date BETWEEN " & formatDbDate(strPostStartDate) & " AND " & formatDbDate(strPostEndDate) & ")"
End If
'If a search cretiria is selected then run a where like query
If strSearchCriteria <> "" Then
strSQL = strSQL & "AND (" & strDbTable & "Newsletter.Newsletter_subject Like '%" & strSearchCriteria & "%' OR " & strDbTable & "Newsletter.Newsletter Like '%" & strSearchCriteria & "%')"
End If
strSQL = strSQL & "ORDER BY " & strDbTable & "Newsletter.Newsletter_date DESC;"
'SQL Query Array Look Up table
'0 = Newsletter_ID
'1 = Newsletter_subject
'2 = Newsletter_date
'3 = Description
'4 = Author
'5 = Allow_Comments
'6 = Private
'Set error trapping
On Error Resume Next
'Query the database
rsCommon.Open strSQL, adoCon
'If an error has occurred write an error to the page
If Err.Number <> 0 Then Call errorMsg("An error has occurred while executing SQL query on database.", "get_newsletter_data", "default.asp")
'Disable error trapping
On Error goto 0
'If records returned read them into an array
If NOT rsCommon.EOF Then
'Read in the newsletter recordset into an array
sarryBlogPost = rsCommon.GetRows()
'Count the number of records
intTotalRecords = Ubound(sarryBlogPost,1) + 1
'Count the number of pages for the topics using FIX so that we get the whole number and not any fractions
lngTotalRecordsPages = FIX(intTotalRecords / intRecordsPerPage)
'If there is a remainder or the result is 0 then add 1 to the total num of pages
If intTotalRecords Mod intRecordsPerPage > 0 OR lngTotalRecordsPages = 0 Then lngTotalRecordsPages = lngTotalRecordsPages + 1
'Start position
intStartPosition = ((intRecordPositionPageNum - 1) * intRecordsPerPage)
'End Position
intEndPosition = intStartPosition + intRecordsPerPage
'Get the start position
intCurrentRecord = intStartPosition
End If
'Clean up
rsCommon.Close
'If this page is above the maximum number of pages in the blog then send a 404 header status
If intRecordPositionPageNum > lngTotalRecordsPages AND intTotalRecords <> 0 Then Response.Status = "404 Not Found"
'See if the user is allowed to view the blog post and if logged in update any blog post codes
If isArray(sarryBlogPost) Then
'Read in the users ID code
strUserID = Trim(Mid(Request.Cookies(strCookiePrefix)("UID"), 1, 33))
'Clean up the USER ID address getting rid of unwanted characters
strUserID = IDcharacterStrip(strUserID)
'Get the users details from the database
If strUserID <> "" Then
'Initalise the strSQL variable with an SQL statement to query the database
strSQL = "SELECT " & strDbTable & "Members.Name, " & strDbTable & "Members.Email, " & strDbTable & "Members.Company, " & strDbTable & "Members.Address1, " & strDbTable & "Members.Address2, " & strDbTable & "Members.City, " & strDbTable & "Members.State, " & strDbTable & "Members.Country, " & strDbTable & "Members.Postcode, " & strDbTable & "Members.Active " & _
"FROM " & strDbTable & "Members" & strDBNoLock & " " & _
"WHERE " & strDbTable & "Members.ID_Code = '" & strUserID & "';"
'Query the database
rsCommon.Open strSQL, adoCon
'If a record is not returned then the user is not a subscriber
If NOT rsCommon.EOF Then
'Read in if the member is active
blnActiveMember = CBool(rsCommon("Active"))
'Place member deatils in array
sarryMemberDetails = rsCommon.GetRows()
End If
'Close db
rsCommon.Close
End If
End If
'Call sub routime to create links to mutiple pages
If strSearchCriteria <> "" AND intCategory > 0 Then
strLinkPage = ("default.asp?KW=" & strSearchCriteria & "&CAT=" & intCategory & "&")
ElseIf strSearchCriteria <> "" Then
strLinkPage = ("default.asp?KW=" & strSearchCriteria & "&")
ElseIf intCategory > 0 Then
strLinkPage = ("default.asp?CAT=" & intCategory & "&")
Else
'Call sub routime to create links to mutiple pages
strLinkPage = ("default.asp?")
End If
'if a category build the link title
If strCategoryName <> "" Then strLinkPageTitle = SeoUrlTitle(strCategoryName, "&t=")
'If URL Rewriting is enabled create the canonical to the page for improved SEO
If NOT Request.ServerVariables("HTTP_X_ORIGINAL_URL") = "" OR NOT Request.ServerVariables("HTTP_X_REWRITE_URL") = "" Then
If intCategory > 0 AND intRecordPositionPageNum = 1 Then
strCanonicalURL = strNewsPadURI & SeoUrlTitle(strCategoryName, "") & "_cat" & intCategory & ".html"
ElseIf intCategory > 0 Then
strCanonicalURL = strNewsPadURI & SeoUrlTitle(strCategoryName, "") & "_cat" & intCategory & "_page" & intRecordPositionPageNum & ".html"
ElseIf intRecordPositionPageNum = 1 Then
strCanonicalURL = strNewsPadURI
Else
strCanonicalURL = strNewsPadURI & SeoUrlTitle(strNewsPadName, "") & "_page" & intRecordPositionPageNum & ".html"
End If
'Else canonical without URL rewriting
Else
If intCategory > 0 AND intRecordPositionPageNum = 1 Then
strCanonicalURL = strNewsPadURI & "default.asp?CAT=" & intCategory & SeoUrlTitle(strCategoryName, "&t=")
ElseIf intCategory > 0 Then
strCanonicalURL = strNewsPadURI & "default.asp?CAT=" & intCategory & "&PN=" & intRecordPositionPageNum & SeoUrlTitle(strCategoryName, "&t=")
ElseIf intRecordPositionPageNum = 1 Then
strCanonicalURL = strNewsPadURI
Else
strCanonicalURL = strNewsPadURI & "default.asp?PN=" & intRecordPositionPageNum
End If
End If
%>
<!--#include file="includes/browser_page_encoding_inc.asp" -->
<html>
<head>
<title>Blog </title>
</head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<% Session.LCID = 1046 ' Brazil %>
<STYLE type=text/css>BODY {
BACKGROUND-REPEAT: repeat-y
}
TD {
FONT-FAMILY: arial,verdana,helvetica,sans-serif; FONT-SIZE: 13px
}
A:link {
COLOR: #4F8B52; TEXT-DECORATION: none
}
A:visited {
COLOR: #4F8B52
}
A:active {
COLOR: #4F8B52
}
A:hover {
COLOR: #1A2E1B
}
</STYLE>
<body leftmargin="0" topmargin="0" bgcolor="#EFF8EF">
<%
'If there are no topics to display, show a message saying so
If intTotalRecords <= 0 Then
'If there are no Topic's to display then display the appropriate error message
Response.Write(vbCrLf & " <tr>" & _
vbCrLf & " <td><br />" & _
vbCrLf & " <table width=""230"" align=""center"" class=""errorTable"" cellspacing=""1"" cellpadding=""1"">" & _
vbCrLf & " <tr>" & _
vbCrLf & " <td><img src=""" & strImagePath & "error.png"" alt=""" & strTxtError & """ align=""absmiddle"" /> <strong>" & strTxtError & "</strong>")
'Select which message to display
If strSearchCriteria <> "" Then
Response.Write(strTxtYourSearchFailedToFindResults)
ElseIf intCategory > 0 Then
Response.Write(strTxtThereAreNoNewsBulletinsToDisplay & " " & strTxtInThisCategory)
Else
Response.Write(strTxtThereAreNoNewsBulletinsToDisplay)
End If
Response.Write(".</td>" & _
vbCrLf & " </tr>" & _
vbCrLf & " </table>" & _
vbCrLf & "")
'Else there the are topic's so write the HTML to display the topic names and a discription
Else
'Do....While Loop to loop through the recorset to display the blog posts
Do While intCurrentRecord < intEndPosition
'If there are no topic records left to display then exit loop
If intCurrentRecord >= intTotalRecords Then Exit Do
'SQL Query Array Look Up table
'0 = Newsletter_ID
'1 = Newsletter_subject
'2 = Newsletter_date
'3 = Description
'4 = Author
'5 = Allow_Comments
'6 = Private
'Read in the post
strBlogPost = sarryBlogPost(3,intCurrentRecord)
strBlogPostSubject = sarryBlogPost(1,intCurrentRecord)
'If URL Rewriting is enabled create the canonical to the page for improved SEO
If NOT Request.ServerVariables("HTTP_X_ORIGINAL_URL") = "" OR NOT Request.ServerVariables("HTTP_X_REWRITE_URL") = "" Then
strPostLink = SeoUrlTitle(strBlogPostSubject, "") & "_post" & sarryBlogPost(0,intCurrentRecord) & ".html"
'Else canonical without URL rewriting
Else
strPostLink = "post.asp?id=" & sarryBlogPost(0,intCurrentRecord) & SeoUrlTitle(sarryBlogPost(1,intCurrentRecord), "&t=")
End If
'If a private post and not an active member tell the user they need to be logged in
If BoolC(sarryBlogPost(6,intCurrentRecord)) AND blnActiveMember = False Then
strBlogPost = strTxtThisNewsletterIsPrivate & ". <a href=""sign_up.asp"">" & strTxtClickToSubscribe & "</a>"
End If
%>
<table cellpadding="0" cellpadding="0" width="230">
<tr>
<td> </td><td><%
'If a private post then do not have the post subject as a link
If BoolC(sarryBlogPost(6,intCurrentRecord)) AND blnActiveMember = False Then
Response.Write("<h52>" & strBlogPostSubject & "</h5>")
'Else display the post subject as a link
Else
Response.Write("<hr size=""-1"" color=""#CDE5CD"" width=""255""><strong><a href=""" & strPostLink & """ title=""" & strBlogPostSubject & """ class=""h5"">" & strBlogPostSubject & "</a></strong>")
End If
%>
</td>
</tr>
</table>
<%
'Move to the next record
intCurrentRecord = intCurrentRecord + 1
Loop
End If
%>
</body>
</html>
Question
wsales
Ola pessoal to quebrando cabeça ainda com aquele blog, a bronca agora é essa, como eu aumento o limite de registro por pagina?? tente de tudo e na conegui. abaix o codigo para você darem uma maõzinha
Link to comment
Share on other sites
1 answer to this question
Recommended Posts