分页的解析处理（ASP）

<%@ Language = VBScript %>
<% Option Explicit %>
<script language="javascript">
function fPageClick(pageno){
var url = ''
url = 'page.asp' +
'?crtpage=' + pageno
document.location.replace(url);
}
</script>
<%
Const GSTR_DIS_FVLH_TTL_BACK = "<<前へ"
Const GSTR_DIS_FVLH_TTL_FWRD = "次へ>>"
'==========================================================
'機能 : 表示用ページ番号解析処理
'引数 : なし
' total IN 全ページ数
' current IN カレントのページ
' dispnum IN 中央表示ページ数 ※ 奇数
' amari IN 余りページ表示数 指定数に大体近い数が採用される
' aryPagesL OUT 左ページ番号の配列
' aryPagesM OUT 中央ページ番号の配列
' aryPagesR OUT 右ページ番号の配列
' jmpL OUT 左ジャンプ数
' jmpR OUT 右ジャンプ数
'返却値 : なし
'==========================================================
Function fblnGetArrayOfManyPages(ByVal total, ByVal current, ByVal dispnum, ByVal amari, ByRef aryPagesL, ByRef aryPagesM, ByRef aryPagesR, ByRef jmpL, ByRef jmpR)

Dim currentL, currentR 'カレント5件の左右のページ番号
Dim lenL, lenR 'カレント左右の残り件数
Dim sepL, sepR '左右のジャンプ間隔
Dim viewL, viewR '左右の実表示個数
fblnGetArrayOfManyPages = False
If current > total Or current < 1 Then Exit Function
If total <= 0 Then Exit Function
If dispnum <= 0 Then Exit Function
If dispnum / 2 = Int(dispnum / 2) Then Exit Function
If amari <= 0 Then Exit Function
currentL = current - Int(dispnum / 2)
If currentL <= 2 Then
currentL = 1
currentR = dispnum
Else
currentR = current + Int(dispnum / 2)
If currentR >= total - 3 Then
currentL = total - dispnum
currentR = total
End If
End If
If total <= dispnum Then
currentL = 1
currentR = total
End If
lenL = currentL - 1
lenR = total - currentR
If lenL <= 0 Then
viewL = 1
Else
viewL = Round(amari * lenL / (lenL +lenR), 0)
End If
If lenR <= 0 Then
viewR = total
Else
viewR = Round(amari * lenR / (lenL +lenR), 0)
End If
sepL = 0
sepR = 0
If viewL > 0 Then
sepL = Round(LenL / viewL, 0)
If sepL < 1 Then sepL = 1
End If
If viewR > 0 Then
sepR = Round(LenR / viewR, 0)
If sepR < 1 Then sepR = 1
End If
'ページ配列の生成
Dim intPagesL, intPagesM, intPagesR
Dim i
intPagesL = 0
If sepL > 0 Then
For i = 1 To currentL Step sepL
If i >= currentL Then Exit For
If Not IsArray(aryPagesL) Then aryPagesL = Array(-1)
ReDim Preserve aryPagesL(intPagesL)
aryPagesL(intPagesL) = i
intPagesL = intPagesL + 1
Next
Else
If currentL > 1 Then
If Not IsArray(aryPagesL) Then aryPagesL = Array(-1)
ReDim Preserve aryPagesL(intPagesL)
aryPagesL(intPagesL) = 1
End If
End If
intPagesM = 0
For i = currentL To currentR
If Not IsArray(aryPagesM) Then aryPagesM = Array(-1)
ReDim Preserve aryPagesM(intPagesM)
aryPagesM(intPagesM) = i
intPagesM = intPagesM + 1
Next
If total > currentR Then
intPagesR = 0
If sepR > 0 Then
For i = currentR + sepR To total Step sepR
If i >= total Then
' If intPagesR > 0 Then
' intPagesR = intPagesR - 1
' End If
Exit For
End If
If Not IsArray(aryPagesR) Then aryPagesR = Array(-1)
ReDim Preserve aryPagesR(intPagesR)
aryPagesR(intPagesR) = i
intPagesR = intPagesR + 1
Next
End If
If Not IsArray(aryPagesR) Then aryPagesR = Array(-1)
ReDim Preserve aryPagesR(intPagesR)
aryPagesR(intPagesR) = total
End If
jmpL = sepL
jmpR = sepR
fblnGetArrayOfManyPages = True
End Function

Function fGetPageHTML(strHTML,totalPage,currentPage,dispnum,amari)
Dim aryPagesL, aryPagesM, aryPagesR, jmpL, jmpR, i, intTempPage

'If fblnGetArrayOfManyPages(lngPageNumber, lngCurentPage, 5, 6, aryPagesL, aryPagesM, aryPagesR, jmpL, jmpR) Then
If fblnGetArrayOfManyPages(totalPage, currentPage, dispnum, amari, aryPagesL, aryPagesM, aryPagesR, jmpL, jmpR) Then
Dim strDisp, strDelmiL, strDelmiR
If currentPage = 1 Then
strHTML = strHTML & GSTR_DIS_FVLH_TTL_BACK & " "
Else
strHTML = strHTML & "<a href=javascript:fPageClick(" & currentPage-1 & ")>" & GSTR_DIS_FVLH_TTL_BACK & "</a> "
End If

'## 実ページ番号の表示部分
strDelmiL = "…"
strDelmiR = "…"
If jmpL <= 1 Then
strDelmiL = " "
End If
If jmpR <= 1 Then
strDelmiR = " "
End If
If IsArray(aryPagesL) Then
intTempPage = CInt(-100)
For i = 0 To UBound(aryPagesL)
If (intTempPage + 1) < CInt(aryPagesL(i)) Then
strHTML = strHTML & "<a href=javascript:fPageClick(" & CStr(aryPagesL(i)) & ")>" & CStr(aryPagesL(i)) & "</a>" & strDelmiL
intTempPage = CInt(aryPagesL(i))
End If
Next
End If
If IsArray(aryPagesM) Then
For i = 0 To UBound(aryPagesM)
If Int(aryPagesM(i)) = Int(currentPage) Then
strHTML = strHTML & "<b>[" & CStr(aryPagesM(i)) & "]</b>"
Else
strHTML = strHTML & "<a href=javascript:fPageClick(" & CStr(aryPagesM(i)) & ")>" & CStr(aryPagesM(i)) & "</a>"
End If
If i <> UBound(aryPagesM) Then
strHTML = strHTML & " "
End If
Next
End If
If IsArray(aryPagesR) Then
Dim strHTMLWork : strHTMLWork = ""
intTempPage = CInt(aryPagesR(UBound(aryPagesR))) + 100
For i = UBound(aryPagesR) To 0 Step -1
If (intTempPage - 1) > CInt(aryPagesR(i)) Then
strHTMLWork = strDelmiR & "<a href=javascript:fPageClick(" & CStr(aryPagesR(i)) & ")>" & CStr(aryPagesR(i)) & "</a>" & strHTMLWork
intTempPage = CInt(aryPagesR(i))
End If
Next
strHTML = strHTML & strHTMLWork
End If
'## 「次へ>>」の表示部分
If Int(currentPage) = Int(currentPage) Then
strHTML = strHTML & " " & GSTR_DIS_FVLH_TTL_FWRD & "</td>"
Else
strHTML = strHTML & " <a href=javascript:fPageClick(" & currentPage+1 & ")>" & GSTR_DIS_FVLH_TTL_FWRD & "</a></td>"
End If
Else
strHTML = strHTML & ""
End If
End Function

Dim lngCurentPage
Dim strHTML
Dim blnRet
If Request.QueryString("crtpage")<>"" Then
lngCurentPage = CLng(Request.QueryString("crtpage"))
Else
lngCurentPage = 1
End If
blnRet = fGetPageHTML(strHTML,1000,lngCurentPage,5,6)
response.write(strHTML)
%>