自編DataBase函式庫，內有引數查詢及分頁操作
下面是DataBase.asp的完整程式碼。內有許多不相干的自編的偷懶函式（大家不要學我，我是嫌VB太囉嗦)，你不需要可以去掉
<%
'以下程式碼為通用程式碼
Option Explicit
Const SqlUserID = "sa" 'SQL資料庫使用者名稱
Const SqlPassword = "gdcc" 'SQL資料庫使用者密碼
Const SqlDatabaseName = "Test" 'SQL資料庫名
Const SqlHostIP = "(local)" 'SQL主機IP地址。本地（指網站與資料庫在同一臺伺服器上）可用“(local)”或“127.0.0.1”，非本機（指網站與資料庫分別在不同的伺服器上）請填寫資料庫伺服器的真實IP）
DIM QUERY_STRING
QUERY_STRING = Request.ServerVariables("QUERY_STRING")
DIM PATH_INFO '當前檔案路徑
PATH_INFO = Request.ServerVariables("PATH_INFO")
'用於分頁查詢的全域性變數
Dim TableName,KeyID,FieldList,Cond,Desc
'以下程式碼請勿改動
Dim Conn ,rs, sql,i
Sub OpenConn()
'On Error Resume Next
if IsObject(Conn) then exit sub
Dim ConnStr
ConnStr = "Provider = Sqloledb; User ID = " & SqlUserID & "; Password = " & SqlPassword & "; Initial Catalog = " & SqlDatabaseName & "; Data Source = " & SqlHostIP & ";"
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.open ConnStr
End Sub
Sub CloseConn()
If IsObject(Conn) Then
Conn.Close
Set Conn = Nothing
End If
End Sub
'the Content below added by wang 2008-3-13
'準備引數
private function parpareCmd(sql,ps)
OpenConn
dim p, cmd, rs , pnum
set cmd = Server.CreateObject("Adodb.Command")
cmd.CommandText = sql
cmd.ActiveConnection = Conn
pnum = ParamNum(sql)
'檢查引數個數是否小於必需數目。
'CreateParameter([Name] , [type] , [Direction] , [Size] , [Value] )
if (not isnull(ps)) then
if (ubound(ps)+1) < pnum then
Response.write "引數個數應該是 " & pnum & ". 但實際只傳遞了" & (ubound(ps)+1)
Response.end
end if
for i = 0 to pnum-1
set p = cmd.CreateParameter( , 130, ,chkLength(Ps(i)), Ps(i))
'response.write "P" & I & "=" & Ps(i) & "L:" &chkLength(Ps(i)) & "<br />"
cmd.Parameters.Append p
next
end if
set parpareCmd = cmd
end function
'通過sql中'?'號的個數得知引數個數
function ParamNum(sql)
ParamNum = 0
for i=1 to LEN(sql)
if mid(sql,i,1)="?" then ParamNum = ParamNum + 1
next
end function
'執行更新查詢
function ExecNonQuery(sql,ps)
dim cmd,rs
set cmd = parpareCmd(sql,ps)
set rs = cmd.Execute
set cmd=nothing
set rs=nothing
end function
'返回單個整數,如果為空則當作0處理
function ExecInt(sql, ps)
dim cmd,rs
set cmd = parpareCmd(sql,ps)
set rs = cmd.Execute
ExecInt=TurnInt(Rs(0))
set rs=nothing
set cmd=nothing
end function
'返回單個字串,如果為空則當作空串處理
function ExecStr(sql, ps)
dim cmd,rs
set cmd = parpareCmd(sql,ps)
set rs = cmd.Execute
if isnull(Rs(0)) then
ExecStr = ""
else
ExecStr=CStr(Rs(0))
end if
set rs=nothing
set cmd=nothing
end function
'返回一個記錄集
function ExecRs(sql, ps)
dim cmd,rs
set cmd = parpareCmd(sql,ps)
set rs = cmd.Execute()
set ExecRs=rs
set cmd=nothing
end function
function chkLength(s)
if isnull(s) then
chkLength = 2
else
chkLength = max(2,len(s))
end if
end function
function ChkFormNull(fn)
ChkFormNull = trim(RF(fn))
if ChkFormNull = "" then ChkFormNull = null
end function
function ChkNull(s)
ChkNull = trim(s)
if ChkNull = "" then ChkNull = null
end function
function iif(a,b,c)
if a then iif=b else iif=c
end function
'將數字格式化成帶前導0的字串
function fill0(n,znum)
dim sn,i
sn = cstr(n)
if len(sn) > znum then
fill0 = "####"
else
for i=1 to znum-len(sn)
sn= "0" + sn
next
fill0 = sn
end if
end function
'數字轉換，將null值視為0處理
function TurnInt(c)
if isnull(c) or c="" or not IsNumeric(c) then
TurnInt=0
else
TurnInt=CLng(c)
end if
end function
function max(i,j)
max = iif(i>j,i,j)
end function
'用正則表示式測試strng中是否有patrn
Function CheckExp(patrn, strng)
Dim regEx, matches '建立變數。
Set regEx = New RegExp '建立正則表示式。
regEx.Pattern = patrn '設定模式。
regEx.IgnoreCase = true '設定是否區分字元大小寫。
regEx.Global = True '設定全域性可用性。
Matches = regEx.test(strng) '執行搜尋。
CheckExp = matches
End Function
''''''''''''''''''''''''Cookies操作'''''''''''''''
Sub SetCookie(n, s)
Response.Cookies("Toers")(n) = s
end Sub
Sub SetCookieDate(d)
Response.Cookies("Toers").Expires = Date + d
End Sub
function GetCookie(n)
GetCookie = Request.Cookies("Toers")(n)
end function
'檔案型別
function FType(fn)
FType = right(fn,len(fn)-InStrRev(fn,"."))
end function
'程式碼過濾，在進入資料庫不需要過濾，在顯示時需要
function HtmEncode(str)
dim result
dim l
if isNULL(str) then
HtmEncode=""
exit function
end if
l=len(str)
result=""
dim i
for i = 1 to l
select case mid(str,i,1)
case "<"
result=result+"<"
case ">"
result=result+">"
case chr(13)
result=result+"<br>"
case chr(34)
result=result+"""
case "&"
result=result+"&"
case chr(32)
'result=result+" "
if i+1<=l and i-1>0 then
if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9) then
result=result+" "
else
result=result+" "
end if
else
result=result+" "
end if
case chr(9)
result=result+" "
case else
result=result+mid(str,i,1)
end select
next
HtmEncode=result
end function
''''''''''''對Rs("XXX")的處理
function RsStr(n)
if isnull(rs(n)) then
RsStr=""
else
rsStr =Trim(rs(n))
end if
end function
function RsLongStr(n)
if isnull(rs(n)) then
RsLongStr=""
else
RsLongStr=HtmEncode(rs(n))
end if
end function
function RsBool(n)
if isnull(rs(n)) then
RsBool =false
else
RsBool = CBool(rs(n))
end if
end function
function RsDate(n)
if isnull(rs(n)) then
RsDate =""
else
RsDate = FormatDateTime(rs(n),vbShortDate)
end if
end function
function RsInt(n)
if isnull(rs(n)) then
RsInt=0
else
RsInt=CLng(rs(n))
end if
end function
''''''''''''對錶單的處理''''''''''''''''''
function RQ(n)
RQ = trim(Request.QueryString(n))
end function
function RF(n)
RF = trim(Request.Form(n))
end function
' 將 1,2,3,4,5 轉換成 '1','2','3','4','5'
function AddQuot(s)
s = replace(s," ","")
AddQuot = "'" + replace(s,",","','") + "'"
end function
''''''''''''以下是對分頁的處理''''''''''''''''''''''
'用於翻頁的變數
DIM Page '頁號
DIM PSize '頁大小
DIM PCount '頁數
DIM RCount '記錄總數
Page= TurnInt(RQ("Page"))
if Page<1 then Page=1
if (PSize="") then PSize=15 Else PSize=CLng(PSize)
''''通用分頁函式，返回頁號為Page的記錄集''''''
'TableName-表名
'KeyId-排序關鍵字名
'FieldList-要查詢的欄位列表
'Cond-條件
'DESC-是否降序
'Page-當前頁號
'PSize-頁大小
'RCount-記錄總數
'Ps -查詢要用到的引數陣列
FUNCTION RsPage(TableName, KeyID, FieldList, Cond, Desc, Page, PSize, RCount,Ps)
Dim boundID,Descs,MaxMinKeyID, GtLt,pcnt
if Desc then
Descs="ORDER BY " + KeyID +" DESC"
MaxMinKeyID = "MIN("+KeyID+")"
GtLt = "<"
else
Descs="ORDER BY " + KeyID
MaxMinKeyID = "MAX("+KeyID+")"
GtLt = ">"
end if
Sql = "SELECT COUNT("+KeyID+") FROM "+TableName+" WHERE "+ Cond
RCount = ExecInt(sql,Ps)
pcnt = (RCount-1) / PSize + 1
if Page<1 then Page=1
if Page>Pcnt then page=Pcnt
sql = "SELECT "+MaxMinKeyID+" FROM (SELECT TOP "& (Page-1)*PSize & " " & KeyID &" FROM "+TableName+" WHERE ("+Cond+ ")"+DESCs + ") " & Left(KeyID,1)
boundID=ExecStr(sql,Ps)
if boundID = "" then GtLt="<>"
sql = "SELECT Top "&PSize & " " & FieldList & " FROM " & TableName &" WHERE (" & KeyID & GtLt &"'"& boundID & "') and (" & Cond & ")" & Descs
set RsPage=ExecRs(sql,Ps)
End Function
'通用翻頁子程式，用到了Page,PCount,PSize,RCount等全域性變數。
SUB ShowPage(itemName)
Dim re
if QUERY_STRING <> "" then
Set re = New RegExp
re.Pattern = "[&/?]?Page=/d*"
QUERY_STRING = re.Replace(QUERY_STRING,"")
end if
if QUERY_STRING <>"" then
QUERY_STRING = "?" & QUERY_STRING & "&Page="
else
QUERY_STRING = "?Page="
end if
PCount = (RCount-1) / PSize + 1
if PCount<=1 then Exit Sub
Response.write " <div class='show_page'>共 <b>"&RCount&"</b> 個 " &itemName & " "
Response.write " <a href='"&QUERY_STRING&"1'>首頁</a> "
Response.write iif(Page>1," <a href='"&QUERY_STRING&(Page-1)&"'>上一頁</a>", "上一頁")
Response.write iif(Page<PCount," <a href='"&QUERY_STRING&(Page+1)&"'>下一頁</a>", "下一頁")
Response.write " <a href='"&QUERY_STRING&PCount&"'>尾頁</a> "
Response.write " 頁次：<strong><font color=red>"&Page&"</font>/"&PCount&"</strong>頁 "
if (PCount<20) then
Response.write " 轉到：<select name='page' size='1' onchange=""location='"&QUERY_STRING&"'+this.options[this.selectedIndex].value;"">"
For i = 1 To PCount
Response.write "<option value='" & i & "'"
If Page = i Then Response.write " selected='selected' "
Response.write ">第" & i & "頁</option>"
Next
Response.write "</select>"
else
Response.write " 轉到第<input type='text' name='Page' size='2' maxlength='5' value='"&Page&"'"
Response.write " onKeyPress=""if (event.keyCode==13)location='"&QUERY_STRING&"'+this.value;"" />頁</div>"
end if
End SUB
%>