<%
dim conn,db
dim connstr
db="comdshuju1/hhgh13.mdb" '数据库文件位置
on error resume next
connstr="DBQ="+server.mappath(""&db&"")+";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"
set conn=server.createobject("ADODB.CONNECTION")
conn.open connstr
if err then
response.Write(err)
err.clear
else
end if
sub CloseConn()
conn.close
set conn=nothing
end sub
%>
<%
'常用函数建立连接数据库记录
Function RsName(Rs_Name,Sql,A,B)
Set Rs_Name=Server.CreateObject("Adodb.RecordSet")
Rs_Name.open Sql,conn,A,B
End Function
'************************************************************************
'L.C.H-002释放记录集
Sub CloseRs()
rs.close
set rs=nothing
End Sub
'************************************************************************
'L.C.H-003释放conn
Sub CloseConn()
conn.close
set conn=nothing
End Sub
'************************************************************************
'L.C.H-004显示错误提示且返回上一页
Function ShowError(a)
response.write("")
response.end()
End Function
'************************************************************************
'L.C.H-005显示错误提示且重新载入另一页
Function ShowErrorTo(a,b)
response.write("")
response.end()
End Function
'************************************************************************
'L.C.H-006显示错误提示且关闭该窗口
Function ShowErrorClose(a)
response.write("")
response.end()
End Function
'L.C.H-008禁止外部提交
Sub Remote()
if not (instr(1,Request.ServerVariables("http_Referer"),Request.ServerVariables ("SERVER_NAME"),1)=8) then
Call ShowError("参数错误！")
end if
end Sub
'************************************************************************
'L.C.H-010是否为数字
Function IsDigit(a)
if isnumeric(a)=false then
Call ShowError("参数错误！")
end if
end Function
'************************************************************************
'L.C.H-011传递ID的有效性
Function Isid(a)
if a="" or isnumeric(a)=false then
Call ShowError("参数错误！")
end if
end Function
'************************************************************************
'L.C.H-012关闭当前弹出窗口，并且刷新父窗口
Sub Refresh()
response.write("")
response.end()
end sub
'L.C.H-013根据传入语句得到是否存在此记录
Function Countid(sql)
RsName rs,sql,1,1
if not rs.eof then
Countid=rs("num")
else
Countid=0
end if
call CloseRs()
end Function
Function Input(s)
s = Trim(Request(s))
s = Replace(s,"'","‘")
s = Replace(s,"--","－－")
s = Replace(s,";","；")
s = Replace(s,"declare","Ｄｅｃｌａｒｅ")
s = Replace(s,"insert","")
s = Replace(s,".js",".ＪＳ")
s = Replace(s,"set",".Ｓｅｔ")
s = Replace(s,"update","ＵＰＤＡＴＥ")
s = Replace(s,"shell","Ｓｈｅｌｌ")
s = Replace(s,"master","ＭＡＳＴＥＲ")
s = Replace(s,"table","Ｔａｂｌｅ")
s = Replace(s,"exec","Ｅｘｅｃ")
s = Replace(s,"and","ａｎｄ")
s = Replace(s,"%","％")
s = Replace(s,"*","＊")
Input = s
End Function
Function NoHTML(s)
If IsNull(s) Then s= ""
s = Server.HTMLEncode(s)
s = Replace(s,VBCRLF," ")
NoHTML = s
End Function
function SplitToSQL(str,deli)
if str<>"" then
tmp=split(str,deli)
tmpstr=""
for i=0 to ubound(tmp)
tmpstr=tmpstr&"'"&trim(tmp(i))&"'"
if i"" then
'fString = replace(fString, ">", ">")
'fString = replace(fString, "<", "<")
fString = Replace(fString, CHR(13)& CHR(10), " ")
fString = Replace(fString, CHR(10) & CHR(10), "
")
fString = Replace(fString, CHR(13), " ")
fString = Replace(fString, CHR(10), " ")
fString = Replace(fString, " "," ")
fstring = replace(fstring,"'","''")
else
fString=""
end if
HTMLEncode = fString
end function
function HTMLDecode(fString)
if fString<>"" then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, "
", CHR(10) & CHR(10))
fString = Replace(fString, " ", CHR(13)& CHR(10))
fString = Replace(fString, " "," ")
fstring = replace(fstring,"''","'")
else
fString=""
end if
HTMLDecode = fString
end function
function getSystime()
set grs=conn.execute("select t=getdate()")
getSystime=grs(0)
end function
'*************************************
'防止外部提交
'*************************************
Function CheckPost()
Dim server_v1,server_v2
Dim bReturn
bReturn = False
server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
If Mid(server_v1,8,Len(server_v2))<>server_v2 Then
Else
bReturn=True
End If
'CheckPost = bReturn
CheckPost = False
End Function
'通用的正则表达式
Function DoRegExpSearch(sPattern,s)
Dim oRegEx
Dim bReturn
bReturn = False
Set oRegEx = New RegExp
oRegEx.Pattern = sPattern
oRegEx.IgnoreCase = False
bReturn = oRegEx.Test(s)
DoRegExpSearch = bReturn
End Function
'****************
'检查用户名
'CheckUserName
'****************
Function CheckUserName(s)
Dim bReturn
bReturn = 0
sPattern = "^\w+$"
If DoRegExpSearch(sPattern,s) Then
If Len(s) < 5 Or Len(s) > 15 Then
'sErrMessage = sErrMessage & "
用户名太长或者太短
"
bReturn=1
Else
bReturn =0
End If
Else
'sErrMessage = sErrMessage &"
"
bReturn=2
End If
CheckUserName = bReturn
End Function
Function CheckChineseName(s)
Dim bReturn
bReturn = False
sPattern = "[\u4e00-\u9fa5]"
If DoRegExpSearch(sPattern,s) Then
bReturn = True
Else
sErrMessage = sErrMessage & "
请输入正确的中文姓名
"
End If
CheckChineseName = bReturn
End Function
Function CheckEmail(s)
Dim sReturn
sReturn = False
sPattern = "\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*"
If DoRegExpSearch(sPattern,s) Then
sRetrun = True
Else
sErrMessage = sErrMessage & "
请输入正确的邮箱地址
"
End If
CheckEmail = sReturn
End Function
Function CheckPostCode(s)
Dim sReturn
sReturn = False
sPattern = "[1-9]\d{5}(?!\d)"
If DoRegExpSearch(sPattern,s) Then
bReturn = True
Else
sErrMessage = sErrMessage & "
请输入正确的邮政编码
"
End If
CheckPostCode = True
End Function
Sub ShowAlertMessage(s)
With Response
.Write ""
.End
End With
End Sub
Sub ShowAlertMessage4(s)
With Response
.Write ""
.End
End With
End Sub
Sub ShowAlertMessage2(s,sReturn)
If sReturn = "" Then sReturn = "history.back();"
With Response
.Write ""
.End
End With
End Sub
Sub ShowAlertMessage3(s)
With Response
.Write ""
.End
End With
End Sub
'生成定长随机串
function rnd_num(l)
Randomize
Do While Len(rndnum)0 then
thenumber=replace(thenumber,".","")'去除小数位
end if
length=len(thenumber) '取得数据长度
redim one(length-1)'重新定义数组大小
redim onestr(length-1)'重新定义数组大小
for i=0 to length-1
one(i)=mid(thenumber,i+1,1) '循环取得每一位的数字
one(i)=mid(string1,one(i)+1,1)'循环取得数字对应的大写
if checkp=0 then
'不含有小数的数据其数字对应的单位
onestr(i)=mid(string2,14-length+i,1)
else
'含有小数的数据其数字对应的单位
onestr(i)=mid(string2,15-length+i+len(thenumber)-checkp,1)
end if
one(i)=one(i)&onestr(i)'将数字与单位组合
next
Money=replace(join(one)," ","") '取得数组中所有的元素，并连接起来
'Money=replace(Money,"零元","元")
Money=replace(Money,"零万","万")
Money=replace(Money,"零亿","亿")
Money=replace(Money,"零仟","零")
Money=replace(Money,"零佰","零")
Money=replace(Money,"零拾","零")
'Money=replace(Money,"零角零分","整")
do while not instr(Money,"零零零")=0
Money=replace(Money,"零零零","零")
loop
do while not instr(Money,"零零")=0
Money=replace(Money,"零零","零")
loop
Money=replace(Money,"零元","元")
ConvertMoney=Money&"整"
'response.write Money '显示结果
end function
'分页
Sub LastNextPage(pagecount,page,resultcount)
Dim query, a, x, temp
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
if request.querystring<>"" then
query=split(request.querystring,"&")
else
query=split(request.form,"&")
end if
'query = Split(Request.ServerVariables("QUERY_STRING"), "&")
For Each x In query
a = Split(x, "=")
If StrComp(a(0), "page", vbTextCompare) <> 0 Then
temp = temp & a(0) & "=" & a(1) & "&"
End If
Next
Response.Write("
" & vbCrLf )
End Sub
'***********************************************
'过程名：showpage
'作 用：显示“上一页 下一页”等信息
'参 数：sfilename ----链接地址
' totalnumber ----总数量
' maxperpage ----每页数量
' ShowTotal ----是否显示总数量
' ShowAllPages ---是否用下拉列表显示所有页面以供跳转。有某些页面不能使用，否则会出现JS错误。
' strUnit ----计数单位
'***********************************************
Sub eLastNextPage(pagecount,page,resultcount)
Dim query, a, x, temp
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
if request.querystring<>"" then
query=split(request.querystring,"&")
else
query=split(request.form,"&")
end if
'query = Split(Request.ServerVariables("QUERY_STRING"), "&")
For Each x In query
a = Split(x, "=")
If StrComp(a(0), "page", vbTextCompare) <> 0 Then
temp = temp & a(0) & "=" & a(1) & "&"
End If
Next
Response.Write("
" & vbCrLf )
End Sub
'**********判断页数
function Pagenum(sql,num)
RsName rs,sql,1,1
if not rs.eof then
a=rs("num")
else
a=0
end if
rs.close
set rs=nothing
p=int(a)
if (p/num)=int(p/num) then
Pagenum=int(p / num)
else
Pagenum=int(p/num)+1
end if
end function
'**********判断页数
%>
