📄 functions.asp
字号:
<%
'获得副ID字符串
function get_pids(byval id)
dim rs,str
set rs=conn.execute("select classid from data_class where id="&id&"")
if not rs.eof then
if rs("classid")=0 then
str=id
else
str=get_pids(rs("classid"))&","&id
end if
end if
rs.close
set rs=nothing
get_pids=str
end function
function get_pids_c(byval id)
dim rs,str
set rs=conn.execute("select classid from data_Categorys where id="&id&"")
if not rs.eof then
if rs("classid")=0 then
str=id
else
str=get_pids_c(rs("classid"))&","&id
end if
end if
rs.close
set rs=nothing
get_pids_c=str
end function
function get_path(byval id)
dim rs,str
set rs=conn.execute("select name,classid from data_class where id="&id&"")
if not rs.eof then
if rs("classid")=0 then
str="你的位置：产品展示 >> "&rs("name")
else
str=get_path(rs("classid"))&" >> "&rs("name")
end if
end if
rs.close
set rs=nothing
get_path=str
end function
function get_path_c(byval id)
dim rs,str
set rs=conn.execute("select name,classid from data_Categorys where id="&id&"")
if not rs.eof then
if rs("classid")=0 then
str="你的位置："&rs("name")
else
str=get_path_c(rs("classid"))&" >> "&rs("name")
end if
end if
rs.close
set rs=nothing
get_path_c=str
end function
'获得类路径名 后台
function get_classnames(byval id)
dim rs,str
set rs=conn.execute("select name,classid from data_class where id="&id&"")
if not rs.eof then
if rs("classid")=0 then
str=rs("name")&""
else
str=get_classnames(rs("classid"))&" >> "&rs("name")&""
end if
end if
rs.close
set rs=nothing
get_classnames=str
end function
function get_classnames_c(byval id)
dim rs,str
set rs=conn.execute("select name,classid from data_Categorys where id="&id&"")
if not rs.eof then
if rs("classid")=0 then
str=rs("name")&""
else
str=get_classnames_c(rs("classid"))&" >> "&rs("name")&""
end if
end if
rs.close
set rs=nothing
get_classnames_c=str
end function
'获得子类ID字符串
'==================================================
'class
function get_sids(byval id)
dim rs,temp
temp=id
set rs=conn.execute("select * from data_class where classid="&id&"")
while not rs.eof
temp=temp & "," & get_sids(rs("id"))
rs.movenext
wend
rs.close
set rs=nothing
get_sids=temp
end function
'categories
function get_sids_c(byval id)
dim rs,temp
temp=id
set rs=conn.execute("select * from data_Categorys where classid="&id&"")
while not rs.eof
temp=temp & "," & get_sids_c(rs("id"))
rs.movenext
wend
rs.close
set rs=nothing
get_sids_c=temp
end function
'==================================================
'生成并获得小图片,并且设置压缩方式和质量
'==================================================
function get_img_s(byval big,byval small,byval width_s,byval height_s)
If IsObjInstalled("Persits.Jpeg") Then
dim Jpeg,Path
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Path = Server.MapPath(big)
Jpeg.Open Path
Jpeg.Interpolation = 2
Jpeg.Quality = 85
' 设置缩略图大小（这里比例设定为50%）
if Jpeg.OriginalWidth/Jpeg.OriginalHeight>=width_s/height_s then
if Jpeg.OriginalWidth>width_s then
Jpeg.Width=width_s
Jpeg.Height=(Jpeg.OriginalHeight*width_s)/Jpeg.OriginalWidth
else
Jpeg.Width=Jpeg.OriginalWidth
Jpeg.Height=Jpeg.OriginalHeight
end if
else
if Jpeg.Originalheight>height_s then
Jpeg.height=height_s
Jpeg.width=(Jpeg.Originalwidth*height_s)/Jpeg.Originalheight
else
Jpeg.Width=Jpeg.OriginalWidth
Jpeg.Height=Jpeg.OriginalHeight
end if
end if
' 保存缩略图到指定文件夹下
Jpeg.Save Server.MapPath(small)
' 注销实例
Set Jpeg = Nothing
get_img_s=small
else
get_img_s=big
end if
end function
'==================================================
'生成并获得小图片,并且设置压缩方式和质量 比范围大
'==================================================
function get_img_s2(byval big,byval small,byval width_s,byval height_s)
If IsObjInstalled("Persits.Jpeg") Then
dim Jpeg,Path
dim x1,y1,x2,y2
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Path = Server.MapPath(big)
Jpeg.Open Path
Jpeg.Interpolation = 2
Jpeg.Quality = 85
' 设置缩略图大小（这里比例设定为50%）
if Jpeg.OriginalWidth/Jpeg.OriginalHeight>=width_s/height_s then
if Jpeg.OriginalWidth>width_s then
Jpeg.height=height_s
Jpeg.width=(Jpeg.Originalwidth*height_s)/Jpeg.Originalheight
else
Jpeg.Width=Jpeg.OriginalWidth
Jpeg.Height=Jpeg.OriginalHeight
end if
else
if Jpeg.Originalheight>height_s then
Jpeg.Width=width_s
Jpeg.Height=(Jpeg.OriginalHeight*width_s)/Jpeg.OriginalWidth
else
Jpeg.Width=Jpeg.OriginalWidth
Jpeg.Height=Jpeg.OriginalHeight
end if
end if
x1=(Jpeg.Width-width_s)/2
y1=(Jpeg.height-height_s)/2
x2=x1+width_s
y2=y1+height_s
'切图
jpeg.crop x1,y1,x2,y2
' 保存缩略图到指定文件夹下
Jpeg.Save Server.MapPath(small)
' 注销实例
Set Jpeg = Nothing
get_img_s2=small
else
get_img_s2=big
end if
end function
'==================================================
'判断服务器是否支持该组件
'==================================================
Function IsObjInstalled(byval 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 msg(str,flag)
response.Write(str)
select case flag
case "-1"
response.Write("<a href=""javascript:history.back("&flag&")"">返回</a>")
case else
response.Write("<a href="""&flag&""">返回</a>")
end select
if isobject(conn) then conn.close:set conn=nothing
response.End()
end function
'==================================================
'函数名：myfso
'作 用：创建文件夹和index.xml文件
'参 数：path ------文件夹(url)
'返 回：无
'==================================================
function myfso(byval path)
dim fso,f
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(server.MapPath(path)) Then
Set f = fso.GetFolder(server.MapPath(path))
Else
Set f = fso.CreateFolder(server.MapPath(path))
End If
set f=nothing
set fso=nothing
end function
'==================================================
'函数名：myfind
'作 用：遍历文件夹
'参 数：path ------文件夹(url)
'返 回：无
'==================================================
function myfind(byval path)
dim paths,subpath,i
path=replace(replace(path,"\","/"),"//","/")
paths=split(path,"/")
for i=0 to UBound(paths)-1
subpath=subpath & paths(i) & "/"
if cstr(left(server.MapPath(subpath),len(server.MapPath("../"))))=cstr(server.MapPath("../")) then
myfso(subpath)
end if
next
end function
'=============================================
'判断是否本地文件
'=============================================
function localhost(byval path)
if lcase(left(path,7))="http://" then
localhost=false
else
localhost=true
end if
end function
'=============================================
'删除文件
'=============================================
function del_file(Byval path)
dim fso,msg
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(server.MapPath(path))) Then
fso.DeleteFile(server.MapPath(path))
msg = " "
end if
set fso=nothing
end function
'================================
'函数名：HTMLEncode
'作 用：text-->html
'返 回：无
'================================
function HTMLEncode(byval 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> ")
HTMLEncode = fString
end if
end function
Public Function Strlength(Str)
Dim Temp_Str, i, Test_Str
Temp_Str = Len(Str)
For i = 1 To Temp_Str
Test_Str = (Mid(Str, i, 1))
If Asc(Test_Str) > 0 Then
Strlength = Strlength + 1
Else
Strlength = Strlength + 2
End If
Next
End Function
'从左边截取
Public Function Strleft(Str, L, SpiltStr)
Dim Temp_Str, i, Test_Str, lens
if Str<>"" then
Temp_Str = Len(Str)
For i = 1 To Temp_Str
Test_Str = (Mid(Str, i, 1))
Strleft = Strleft & Test_Str
If Asc(Test_Str) > 0 Then
lens = lens + 1
Else
lens = lens + 2
End If
If Strlength(Str) > L And lens >= L - 2 Then Exit For
Next
If Strlength(Str) > lens Then Strleft = Strleft & SpiltStr
end if
End Function
'从右边截取
Public Function Strright(Str, L, SpiltStr)
Dim Temp_Str, i, Test_Str, lens
Temp_Str = Len(Str)
For i = Temp_Str To 1 Step -1
Test_Str = (Mid(Str, i, 1))
Strright = Test_Str & Strright
If Asc(Test_Str) > 0 Then
lens = lens + 1
Else
lens = lens + 2
End If
If Strlength(Str) > L And lens >= L - 2 Then Exit For
Next
If Strlength(Str) > lens Then Strright = SpiltStr &Strright
End Function
'==================================================
'函数名：keyword_sousuo
'作 用：生成sql查询条件
'参 数：table_field ------ 表的字段名（之间用逗号分开）
' keyword ------ 搜索关键词（之间用空格分开）
'返 回：sql查询条件
'==================================================
function keyword_sousuo(byval table_field,byval keyword)
dim str01,str02,keywords,table_fields,i,j
table_fields=split(trim(table_field),",")
keywords=split(trim(keyword),",")
if table_field<>"" then
str01="("&table_fields(0)&" like '%"&keyword&"%'"
for j=0 to ubound(table_fields)
str01=str01&" or "&table_fields(j)&" like '%"&keyword&"%'"
next
str01=str01&")"
else
response.Write("<script>alert('ERROR!')</script>")
response.End()
end if
'全角－－》半角 空格
keyword=replace(keyword," "," ")
keywords=split(keyword," ")
if ubound(keywords)>0 then
for i=0 to ubound(keywords)
str02=str02&"("&table_fields(0)&" like '%"&keywords(i)&"%'"
for j=1 to ubound(table_fields)
str02=str02&" or "&table_fields(j)&" like '%"&keywords(i)&"%'"
next
str02=str02&")"
next
str02="("&replace(str02,")(",")and(")&")"
keyword_sousuo="(" & str01 & "or" & str02 & ")"
else
keyword_sousuo=str01
end if
end function
'==================================================
'函数名：keyword_tag
'作 用：将字符串里的关键词标记为红色
'参 数：str ------ 字符串
' keyword ------ 标记关键词（之间用空格分开）
'返 回：字符串（html格式）
'==================================================
function keyword_tag(byval str,byval keyword)
dim keywords,str01,str02,i
if str<>"" then
'全角－－》半角 空格
keyword=replace(keyword," "," ")
str01=replace(str,keyword,"<font color=""#ff0000"">"&keyword&"</font>")
keywords=split(keyword," ")
if ubound(keywords)>0 then
str02=str
for i=0 to ubound(keywords)
str02=replace(str02,keywords(i),"<font color=""#ff0000"">"&keywords(i)&"</font>")
next
keyword_tag=str02
else
keyword_tag=str01
end if
end if
end function
'----------------------------------------------翻页
function showpage_fun(byval pagecount,byval page,byval n)
dim query,temp,x,i,a
query = Split(Request.ServerVariables("QUERY_STRING"), "&")
For Each x In query
a = Split(x, "=")
If StrComp(a(0), "page", vbTextCompare) <> 0 and StrComp(a(0), "mode", vbTextCompare) <> 0 and StrComp(a(0), "submit", vbTextCompare) <> 0 Then
temp = temp & a(0) & "=" & a(1) & "&"
End If
Next
response.Write("<font color=""#ff0000"">"&page&"</font>/"&pagecount&"页 ")
'上一页
if page>1 and page<=pagecount then
response.Write(" <a href=""?"&temp&"page="&page-1&"""><<a> ")
else
response.Write(" < ")
end if
'循坏页
i=0
do while i<pagecount
i=i+1
If i<2 or i=pagecount or (i>=page-n and i<=page+n) or (page-1<=n and i<=2*n+2) or (pagecount-page<=n and i>=pagecount-2*n-1) Then
response.Write(" <a href=""?"&temp&"page="&i&""">")
if page=i then
response.Write("<b><font color=""#333333"">"&i&"</font></b>")
Else
response.Write(i)
End If
response.Write("</a> ")
else
'省略号
if i=2 then
response.Write(" .. ")
end if
if i=pagecount-1 then
response.Write(" .. ")
end if
End If
loop
'下一页
if page>=1 and page<pagecount then
response.Write(" <a href=""?"&temp&"page="&page+1&""">><a> ")
else
response.Write(" > ")
end if
response.Write(" <a href=""?"&temp&"page="&pagecount&""">尾页>></a>")
end function
'----------------------------------------------随机数
Function getkey(digits)
dim char_array(50),output,num
output=""
char_array(0) = "0"
char_array(1) = "1"
char_array(2) = "2"
char_array(3) = "3"
char_array(4) = "4"
char_array(5) = "5"
char_array(6) = "6"
char_array(7) = "7"
char_array(8) = "8"
char_array(9) = "9"
char_array(10) = "A"
char_array(11) = "B"
char_array(12) = "C"
char_array(13) = "D"
char_array(14) = "E"
char_array(15) = "F"
char_array(16) = "G"
char_array(17) = "H"
char_array(18) = "I"
char_array(19) = "J"
char_array(20) = "K"
char_array(21) = "L"
char_array(22) = "M"
char_array(23) = "N"
char_array(24) = "O"
char_array(25) = "P"
char_array(26) = "Q"
char_array(27) = "R"
char_array(28) = "S"
char_array(29) = "T"
char_array(30) = "U"
char_array(31) = "V"
char_array(32) = "W"
char_array(33) = "X"
char_array(34) = "Y"
char_array(35) = "Z"
randomize
do while len(output) < digits
num = char_array(Int((35 - 0 + 1) * Rnd + 0))
output = output + num
loop
getkey = output
End Function
'提取纯文字 去html标签
Function cutStr(str,strlen)
if str<>"" then
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="<(.[^>]*)>"
str=re.Replace(str,"")
set re=Nothing
Dim l,t,c,i
l=Len(str)
t=0
For i=1 to l
c=Abs(Asc(Mid(str,i,1)))
If c>255 Then
t=t+2
Else
t=t+1
End If
If t>=strlen Then
cutStr=left(str,i)&"..."
Exit For
Else
cutStr=str
End If
Next
cutStr=Replace(cutStr,chr(10),"")
cutStr=Replace(cutStr,chr(13),"")
'cutStr=Replace(cutStr,chr(32),"")
end if
End Function
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -