Jump to content
Fórum Script Brasil
  • 0

(Resolvido) Como alterar o paramento de contidade de resultado por pag


wsales

Question

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, "&amp;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>&nbsp;</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>

Link to comment
Share on other sites

1 answer to this question

Recommended Posts

Guest
This topic is now closed to further replies.


  • Forum Statistics

    • Total Topics
      152.2k
    • Total Posts
      652k
×
×
  • Create New...