www.gusucode.com > 新锐领秀网络相册 1.1 > include/function.asp
<%
'----------------------------------------------------
' [Gong] (C)2007-2008 .
' This is NOT a freeware, use is subject to license terms
' Id: function.asp 2008-03-26 00:53:29 Gong
'----------------------------------------------------
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If Err = 0 Then IsObjInstalled = True
If Err = -2147352567 Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
Function gCheckPath() '最基本的防跨站提交
Dim ser_v1,ser_v2
gCheckPath = True
ser_v1=CStr(Request.ServerVariables("HTTP_REFERER"))
ser_v2=CStr(Request.ServerVariables("SERVER_NAME"))
If mid(ser_v1,8,len(ser_v2))<>ser_v2 then
CheckPath = False
End If
End Function
'==================================================================================================
'==================================================================================================
function gSafeRequest(ParaName,ParaType)
'--- 传入参数 ---
'ParaName:参数名称-字符型
'ParaType:参数类型-数字型(1表示以上参数是数字，0表示以上参数为字符)
Dim ParaValue
ParaValue=Request.QueryString(ParaName)
If ParaType=1 then
If not isNumeric(ParaValue) then
'Response.write "参数" & ParaName & "必须为数字型！"
Response.end
End if
Else
ParaValue=replace(ParaValue,chr(0),"")
ParaValue=replace(ParaValue,"'","''")
ParaValue=replace(ParaValue,chr(39),"''")
End if
gSafeRequest=ParaValue
End Function
'==================================================================================================
'==================================================================================================
Function CheckNumeric(Byval CHECK_ID)
If CHECK_ID<>"" and IsNumeric(CHECK_ID) Then _
CHECK_ID = cCur(CHECK_ID) _
Else _
CHECK_ID = 0
CheckNumeric = CHECK_ID
End Function
'==================================================================================================
'==================================================================================================
Function gGetTrueIP()
Dim ip
ip = Request.ServerVariables("HTTP_X_FORWARDED_FOR" )
If ip = "" Then ip = Request.ServerVariables("REMOTE_ADDR" )
gGetTrueIP=ip
End Function
'==================================================================================================
'==================================================================================================
Function ChkBadWords(Str)'过滤脏话
If IsNull(Str) Then Exit Function
Dim i
For i = 0 To UBound(BadWords)
If InStr(Str,BadWords(i))>0 Then
If i > UBound(rBadWord) Then
Str = Replace(Str,BadWords(i),"*")
Else
Str = Replace(Str,BadWords(i),rBadWord(i))
End If
End If
Next
ChkBadWords = Str
End Function
'==================================================================================================
'==================================================================================================
Function ReplaceRegBadChar(strChar)
Dim temp
temp=strChar
If temp<>"" then
temp=Replace(temp,"<","")
temp=Replace(temp,">","")
temp=Replace(temp,"(","")
temp=Replace(temp,")","")
temp=Replace(temp,";","")
temp=Replace(temp,"?","")
temp=Replace(temp,",","")
temp=Replace(temp,"*","")
temp=Replace(temp," ","")
temp=Replace(temp,"#","")
temp=Replace(temp,"￥","")
temp=Replace(temp,"…","")
temp=Replace(temp,"%","")
Else
temp=""
End If
ReplaceRegBadChar=temp
End Function
'==================================================================================================
'==================================================================================================
Function gCheckstr(Str)
If Isnull(Str) Then
gCheckstr = ""
Exit Function
End If
Str = Replace(Str,Chr(0),"")
gCheckStr = Replace(Str,"'","''")
End Function
'==================================================================================================
'==================================================================================================
Function strLength(str)'字符长度
If isNull(str) Or Str = "" Then
StrLength = 0
Exit Function
End If
Dim WINNT_CHINESE
WINNT_CHINESE=(len("例子")=2)
If WINNT_CHINESE Then
Dim l,t,c
Dim i
l=len(str)
t=l
For i=1 To l
c=asc(mid(str,i,1))
If c<0 Then c=c+65536
If c>255 Then t=t+1
Next
strLength=t
Else
strLength=len(str)
End If
End Function
'==================================================================================================
'==================================================================================================
Function CutStr(str,l)'截取子串
if isnull(str) Or Str = "" then
CutStr = ""
Exit Function
End If
if strLength(str)<=cint(l) Then
CutStr = str
else
CutStr = left(str,l*2)
end If
End Function
'==================================================================================================
'==================================================================================================
Function gRoundStr(num)
Dim str,strLen,temp,i
str = "0123456789abcdefghijklmnopqrstopwxyz"
for i = 1 to num
Randomize
strLen = Len(str)
temp = temp & mid(str,Round((RND * (strLen-1))+1),1)
Next
gRoundStr = temp
End Function
'==================================================================================================
'==================================================================================================
'生成文件名的函数
Function gMakeFileName(fname)
fname = fname
fname = replace(fname,"-","")
fname = replace(fname," ","")
fname = replace(fname,":","")
fname = replace(fname,"PM","")
fname = replace(fname,"AM","")
fname = replace(fname,"上午","")
fname = replace(fname,"下午","")
gMakeFileName=fname &gRoundStr(3)
End Function
'==================================================================================================
'==================================================================================================
'保持数据格式不变的函数
Function gHTMLEncode(fString)
If Not IsNull(fString) Then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, CHR(32), " ")
fString = Replace(fString, CHR(9), " ")
fString = Replace(fString, CHR(34), """)
'fString = Replace(fString, CHR(39), "'")
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
fString = Replace(fString, CHR(10), "<BR> ")
'iHTMLEncode = fString
End If
gHTMLEncode = fString
End Function
'==================================================================================================
'==================================================================================================
Function gHTMLDecode(fString)
If Not IsNull(fString) Then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, " ",CHR(32))
fString = Replace(fString, " ",CHR(9))
fString = Replace(fString, """,CHR(34))
'fString = Replace(fString, CHR(39), "'")
fString = Replace(fString, "",CHR(13))
fString = Replace(fString, "</P><P> ",CHR(10) & CHR(10))
fString = Replace(fString, "<BR> ",CHR(10))
'iHTMLEncode = fString
End If
gHTMLDecode = fString
End Function
'==================================================================================================
'==================================================================================================
'==================================================================================================
'==================================================================================================
'==================================================================================================
'==================================================================================================
Function gGetURL() '获取URL加?page=
Dim strurl,str_url,i,j,search_str,result_url,str_params
search_str="page="
strurl=Request.ServerVariables("URL")
Strurl=split(strurl,"/")
i=UBound(strurl,1)
str_url=strurl(i)'得到当前页文件名
str_params=Trim(Request.ServerVariables("QUERY_STRING"))
If str_params="" Then
result_url=str_url & "?page="
Else
If InstrRev(str_params,search_str)=0 Then
result_url=str_url & "?" & str_params &"&page="
Else
j=InstrRev(str_params,search_str)-2
If j=-1 Then
result_url=str_url & "?page="
Else
str_params=Left(str_params,j)
result_url=str_url & "?" & str_params &"&page="
End If
End If
End If
gGetURL=result_url
End Function
'==================================================================================================
'==================================================================================================
Function GetPageList(CurPage,RecordCount,PageSize,PageListNum)'分页函数
Dim pgcount,firstpage,endpage,lastpage,firststr,endstr,pagelist,pgcount1,addpage
Dim i,b,t
If RecordCount < PageSize Then '获取总页数
pgcount=1
Else
'pgcount1=split((rscount/pagesize),".")
'pgcount=pgcount1(0)
'lastpage=rscount mod pagesize
'If lastpage>0 then
'pgcount=pgcount+1
'End If
If (RecordCount Mod PageSize > 0) Then pgcount = Int(RecordCount / PageSize) + 1 Else pgcount = Int(RecordCount / PageSize) End If
End If
if clng(CurPage) > clng(pgcount) then'判断页数是否超出
CurPage = pgcount
end if
If PageListNum > pgcount Then
b = 1
t = pgcount
Else
b = curpage - 2
t = b + pagelistnum - 1
If b < 1 Then
t = curpage + 1 - b
b = 1
If (t - b) < pagelistnum Then
t = pagelistnum
End If
ElseIf t > pgcount Then
b = pgcount - pagelistnum + 1
t = pgcount
End if
End If
'endpage=firstpage+pagelistnum-1'计算最后页
'if clng(endpage)>clng(pgcount) then
'endpage=pgcount
'end if
if clng(curpage)>clng(pagelistnum) then'计算前一个pagelistnum
'firststr="<a class=""p_num"" href="""&gGetURL&"1"">首页</a>"
else
'firststr="<a class=""p_num"">首页</a>"
end if
if clng(curpage)>1 and clng(pgcount)>1 then'计算前一页
firststr=firststr & "<a class=""prev"" href="""&gGetURL&curpage-1&""">上一页</a>"
else
firststr=firststr & "<a class=""prev"">上一页</a>"
end if
'计算后一页
'if clng(curpage)<clng(pgcount) and clng(pgcount)>1 then
if clng(curpage)<clng(pgcount) Then
endstr="<a class=""next"" href="""&gGetURL&curpage+1&""">下一页</a> "
else
endstr="<a class=""next"">下一页</a>"
end if
'计算后一个pagelistnum
if clng(pgcount)-clng(endpage)>0 then
if clng(curpage)-clng(pgcount)>clng(pagelistnum) then
addpage=pagelistnum
else
addpage=clng(pgcount)-clng(endpage)
end if
'endstr=endstr &"<a class=""next"" href="""&gGetURL&curpage+addpage-1&""">尾页</a>"
else
'endstr=endstr&"<a class=""next"">尾页</a>"
end if
'获得循环页数
for i=b to t
if clng(i)=clng(curpage) then
pagelist = pagelist & "<strong>" & i & "</strong>"
else
pagelist=pagelist & "<a href=""" & gGetURL & i & """>" & i & "</a>"
end if
next
'返回函数值
dim a
'a="<BR><form action="&GetURL&SafeRequest("page",1)&" method=""get""><input type=text size=3 name=""page""><input type=submit value=""Go"" name=""b1""></form>"
a="<input class=""p_input"" type=text name=""b1"" onKeydown=""if(event.keyCode==13) {window.location='"&gGetURL&"'+this.value; return false;}"">"
GetPageList="<div style=""border:1px solid #ff0000;width:700px;height:26px;"" class=""pages"">"&firststr & pagelist & endstr&"</div>"
end function
'===============================================
'取得文件路径
'===============================================
Function GetFilePath(FullPath,str)
If FullPath <> "" Then
GetFilePath = left(FullPath,InStrRev(FullPath, str)-1)
Else
GetFilePath = ""
End If
End Function
Function gIsObjInstalled(strClassString)
On Error Resume Next
gIsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If Err = 0 Then gIsObjInstalled = True
If Err = -2147352567 Then gIsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
%>