📄 function.asp
字号:
set Infors=nothing
response.write "</table>"
End Function
Function NoPic(zf11_DisInfo)
response.write "<table width=""100"" border=""0"" align=""center"" cellpadding=""3"" cellspacing=""3""><tr> "& vbCrLf
response.write "<td><img src=""Images/zf11_nopic.gif"" border=""0""></td>"& vbCrLf
response.write "</tr><tr><td height=""18"">"& vbCrLf
response.write "<div align=""center"">"&zf11_DisInfo&"</div></td>"& vbCrLf
response.write "</tr></table>"& vbCrLf
End Function
Function zf11_ShowPic(zf11_Pic,zf11_InfoID,zf11_Title,zf11_long)
response.write "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0""><tr><td>"& vbCrLf
response.write "<TABLE width=""50"" border=0 align=center cellPadding=0 cellSpacing=0>"& vbCrLf
response.write "<TR><TD height=8><IMG height=8 src=""Images/table/bg_0ltop.gif"" width=8></TD>"& vbCrLf
response.write "<TD background=Images/table/bg_01.gif height=8></TD>"& vbCrLf
response.write "<TD height=8><IMG height=8 src=""Images/table/bg_0rtop.gif"" width=8></TD></TR>"& vbCrLf
response.write "<TR><TD width=8 background=Images/table/bg_03.gif></TD>"& vbCrLf
response.write "<TD width=""50"" height=""90"" align=""center"" bgColor=#ffffff><a href=typenews.asp?id="&zf11_InfoID&" Title='"&zf11_Title&"'><img src="&zf11_Pic&" border=0 width="&imageswidth&" height="&imagesheight&" ></a></TD>"& vbCrLf
response.write "<TD width=8 background=Images/table/bg_04.gif></TD>"& vbCrLf
response.write "</TR><TR><TD height=8><IMG height=8 src=""Images/table/bg_0lbottom.gif"" width=8></TD>"& vbCrLf
response.write "<TD background=Images/table/bg_02.gif height=8></TD>"& vbCrLf
response.write "<TD height=8><IMG height=8 src=""Images/table/bg_0rbottom.gif"" width=8></TD>"& vbCrLf
response.write "</TR></TABLE>"& vbCrLf
response.write "</td></tr><tr><td align=center height=18>"& vbCrLf
response.write "<a href=typenews.asp?id="&zf11_InfoID&" title='"&zf11_Title&"'>"
if GetLen(zf11_Title)>zf11_long then
response.write LeftStr(zf11_Title,zf11_long-2)
response.write "..."
else
response.write zf11_Title
end if
response.write "</a>"
response.write "</td></tr></table>"& vbCrLf
End Function
Function zf11_ShowTopPic(Top_num)
response.write "<TABLE cellSpacing=5 cellPadding=0 width=""100%"" align=center border=0><TBODY>"& vbCrLf
sql="select top "&Top_num&" * from Info where Ispic=1 and Pw_Good=True ORDER BY AddDate DESC,ID desc"
Set Rstop=conn.execute(Sql)
if Rstop.eof or Rstop.bof then
Call NoPic("无推荐图文信息")
end if
do while not Rstop.eof
response.write "<TR vAlign=top>"
response.write "<TD height=82 align=middle>"
Call zf11_ShowPic(Rstop("Pic"),Rstop(0),Rstop("Title"),120,98,18)
response.write "</TD>"
response.write "</TR>"
Rstop.movenext
loop
response.write "</TBODY></TABLE>"
Rstop.close
set Rstop=nothing
End Function
Dim MyCount : MyCount="http://www.zf11.com"
Sub Showlink(ltype,L_num)
dim rsl,strTemp,l
l=1
if not ltype="" then
ltype=1
end if
set rsl=conn.execute("select top "&L_num&" * from links where style="<ype&" order by id desc")
strTemp="<table border='0' cellspacing='0' cellpadding='0' align='center'width='100%'><tr>"
do until rsl.eof
if ltype>0 then
strTemp=strTemp&"<td align=left height=21> <a href='"&rsl("link")&"' title='网站名称："&rsl("name")&chr(13)&"网站简介："&rsl("note")&"' target=_blank>"&rsl("name")&"</a></td>"
else
strTemp=strTemp&"<td align=left height=21> <a href='"&rsl("link")&"' title='网站名称："&rsl("name")&chr(13)&"网站简介："&rsl("note")&"' target=_blank>"&rsl("name")&"</a></td>"
end if
if l mod 2 =0 then
strTemp=strTemp&"</tr><tr>"
end if
rsl.movenext
l=l+1
loop
rsl.close
set rsl=nothing
strTemp=strTemp&"</tr></table>"
response.write strTemp
End Sub
%>
<% '以下为原图片的format.asp里的文件。%>
<%
function cutstr(str,strlen,more,url)
if len(str)>strlen then
str=left(str,strlen) & "......"
end if
if (len(str)>strlen) and more then
str=str+" [url="+url+"]点这里查看详情[/url]"
end if
cutstr=str
end function
function strLength(str)
ON ERROR RESUME NEXT
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
end if
next
strLength=t
else
strLength=len(str)
end if
if err.number<>0 then err.clear
end function
function AutoUrl(str)
on error resume next
Set url=new RegExp
url.IgnoreCase =True
url.Global=True
url.MultiLine = True
url.Pattern = "^(http://[A-Za-z0-9\./=\?%\-&_~`@:+!]+)"
str = url.Replace(str,"[url=$1]$1[/url]")
url.Pattern = "(http://[A-Za-z0-9\./=\?%\-&_~`@:+!]+)$"
str = url.Replace(str,"[url=$1]$1[/url]")
url.Pattern = "^(www.[A-Za-z0-9\./=\?%\-&_~`@:+!]+)"
str = url.Replace(str,"[url=http://$1]$1[/url]")
url.Pattern = "(www.[A-Za-z0-9\./=\?%\-&_~`@:+!]+)$"
str = url.Replace(str,"[url=http://$1]$1[/url]")
set url=Nothing
AutoUrl=str
end function
Rem 判断数字是否整形
function isInteger(para)
on error resume next
dim str
dim l,i
if isNUll(para) then
isInteger=false
exit function
end if
str=cstr(para)
if trim(str)="" then
isInteger=false
exit function
end if
l=len(str)
for i=1 to l
if mid(str,i,1)>"9" or mid(str,i,1)<"0" then
isInteger=false
exit function
end if
next
isInteger=true
if err.number<>0 then err.clear
end function
function DoTrimProperly(str, nNamedFormat, properly, pointed, points)
dim strRet
strRet = Server.HTMLEncode(str)
strRet = replace(strRet, vbcrlf,"<br>")
strRet = replace(strRet, vbtab,"")
If (LEN(strRet) > nNamedFormat) Then
strRet = LEFT(strRet, nNamedFormat)
If (properly = 1) Then
Dim TempArray
TempArray = split(strRet, " ")
Dim n
strRet = ""
for n = 0 to Ubound(TempArray) - 1
strRet = strRet & " " & TempArray(n)
next
End If
If (pointed = 1) Then
strRet = strRet & points
End If
End If
DoTrimProperly = strRet
End Function
Function FormatStr(String)
on Error resume next
String = Replace(String, CHR(13), "")
String = Replace(String, CHR(32), " ")
String = Replace(String, "", " ")
String = Replace(String, "<", "<")
String = Replace(String, ">", ">")
String = Replace(String, CHR(10) & CHR(10), "<BR><BR>")
String = Replace(String, CHR(10), "<BR>")
FormatStr = String
End Function
Function CODEStr(String)
on Error resume next
String = Replace(String, "&", "&")
String = Replace(String, "R", "R")
String = Replace(String, "r", "r")
String = Replace(String, "&", "&amp;")
String = Replace(String, """, "&quot;")
String = Replace(String, "<", "&lt;")
String = Replace(String, ">", "&gt;")
String = Replace(String, " ", "&nbsp;")
String = Replace(String, "<", "<")
String = Replace(String, ">", ">")
CODEStr = String
End Function
Function Ubb2Html(str, showemot, showimg)
ON ERROR RESUME NEXT
if not str<>"" then exit function
tmpstr="uNobwab"
str=UbbStr(str,"url")
str=UbbStr(str,"quote")
str=UbbStr(str,"color")
str=UbbStr(str,"size")
str=UbbStr(str,"face")
if showemot then
for i=1 to 16
str=replace(str,":em"&i&":","<img src='emot/em"&i&".gif'>",1,6,1)
str=replace(str,":em"&i&":","",1,-1,1)
next
end if
if showimg then
str=UbbStr(str,"img")
str=UbbStr(str,"swf")
str=UbbStr(str,"dir")
str=UbbStr(str,"rm")
str=UbbStr(str,"mp")
str=UbbStr(str,"qt")
end if
str=UbbStr(str,"frame")
str=replace(str,"[b]","<b>",1,-1,1)
str=replace(str,"[/b]","</b>",1,-1,1)
str=replace(str,"[u]","<u>",1,-1,1)
str=replace(str,"[/u]","</u>",1,-1,1)
str=replace(str,"[br]","<br>",1,-1,1)
str=replace(str,"[center]","<center>",1,-1,1)
str=replace(str,"[/center]","</center>",1,-1,1)
str=replace(str,"[fly]","<marquee>",1,-1,1)
str=replace(str,"[/fly]","</marquee>",1,-1,1)
str=replace(str,"["&tmpstr,"[",1,-1,1)
str=replace(str,tmpstr&"]","]",1,-1,1)
str=replace(str,"/"&tmpstr,"/",1,-1,1)
Ubb2Html=str
End Function
function ubbstr(ubb_str,UbbKeyWord)
ON ERROR RESUME NEXT
tmpstr="uNobwab"
beginstr=1
endstr=1
do while UbbKeyWord="url" or UbbKeyWord="color" or UbbKeyWord="size" or UbbKeyWord="face"
beginstr=instr(beginstr,ubb_str,"["&UbbKeyWord&"=",1)
if beginstr=0 then exit do
endstr=instr(beginstr,ubb_str,"]",1)
if endstr=0 then exit do
LUbbKeyWord=UbbKeyWord
beginstr=beginstr+len(lUbbKeyWord)+2
text=mid(ubb_str,beginstr,endstr-beginstr)
codetext=replace(text,"[","["&tmpstr,1,-1,1)
codetext=replace(codetext,"]",tmpstr&"]",1,-1,1)
codetext=replace(codetext,"/","/"&tmpstr,1,-1,1)
select case UbbKeyWord
case "face"
ubb_str=replace(ubb_str,"[face="&text&"]","<font face='"&text&"'>",1,1,1)
ubb_str=replace(ubb_str,"[/face]","</font>",1,1,1)
case "color"
ubb_str=replace(ubb_str,"[color="&text&"]","<font color='"&text&"'>",1,1,1)
ubb_str=replace(ubb_str,"[/color]","</font>",1,1,1)
case "size"
if IsNumeric(text) then
if text>6 then text=6
if text<1 then text=1
ubb_str=replace(ubb_str,"[size="&text&"]","<font size='"&text&"'>",1,1,1)
ubb_str=replace(ubb_str,"[/size]","</font>",1,1,1)
end if
case "url"
ubb_str=replace(ubb_str,"[url="&text&"]","<a href='"&codetext&"' target=_blank>",1,1,1)
ubb_str=replace(ubb_str,"[/url]","</a>",1,1,1)
end select
loop
beginstr=1
do
beginstr=instr(beginstr,ubb_str,"["&UbbKeyWord&"]",1)
if beginstr=0 then exit do
endstr=instr(beginstr,ubb_str,"[/"&UbbKeyWord&"]",1)
if endstr=0 then exit do
LUbbKeyWord=UbbKeyWord
beginstr=beginstr+len(lUbbKeyWord)+2
text=mid(ubb_str,beginstr,endstr-beginstr)
codetext=replace(text,"[","["&tmpstr,1,-1,1)
codetext=replace(codetext,"]",tmpstr&"]",1,-1,1)
codetext=replace(codetext,"/","/"&tmpstr,1,-1,1)
select case UbbKeyWord
case "url"
ubb_str=replace(ubb_str,"["&UbbKeyWord&"]"&text,"<a href='"&codetext&"' target=_blank>"&codetext,1,1,1)
ubb_str=replace(ubb_str,"<a href='"&codetext&"' target=_blank>"&codetext&"[/"&UbbKeyWord&"]","<a href="&codetext&" target=_blank>"&codetext&"</a>",1,1,1)
case "img"
ubb_str=replace(ubb_str,"[img]"&text,"<table width='100%' align=center border='0' cellspacing='0' cellpadding='0' style='TABLE-LAYOUT: fixed'><tr><td><a href='"&codetext&"' target=_blank><img src="&codetext,1,1,1)
ubb_str=replace(ubb_str,"[/img]"," border=0 alt='点击打开新窗口'></a></td></tr></table>",1,1,1)
case "quote"
atext=replace(text,"[img]","",1,-1,1)
atext=replace(atext,"[/img]","",1,-1,1)
atext=replace(atext,"[swf]","",1,-1,1)
atext=replace(atext,"[/swf]","",1,-1,1)
atext=replace(atext,"[dir]","",1,-1,1)
atext=replace(atext,"[/dir]","",1,-1,1)
atext=replace(atext,"[rm]","",1,-1,1)
atext=replace(atext,"[/r⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -