📄 jxc_function.asp
字号:
temp=split(temp,",")
DateTimeFormat=temp(Weekday(DateTime)-1)
case else
DateTimeFormat=DateTime
end select
end function
%>
<%
Rem Pw_Sys 栏目的显示
Sub Gaobei_ShowSort()
response.write "<table width=""90%"" border=""0"" align=""center"" cellpadding=""1"" cellspacing=""1"">"& vbCrLf
Set Rs=conn.execute("select * from Sort where B_id=0 and setting order by S_order")
if Rs.eof and Rs.bof then
response.write "还没有任何栏目"
else
do while not Rs.eof
set names=rs("names")
set id=rs("id")
response.write "<tr><td colspan=""2"">"& vbCrLf
response.write "<a href=Sort.asp?SortID="&ID&">"&names&"</a>"
response.write "</td></tr><tr> "& vbCrLf
if Rs("Setting")<5 and Rs("Setting")<>3 then
Set RsClass=Conn.Execute("Select * from Sort where B_ID="& Rs("ID") &" order by S_Order")
do while not RsClass.eof
response.write "<tr><td width=""36%"" align=""right""><img src=""Images/Gaobei_skin/Gaobei_ico.gif"" width=""12"" height=""11"" align=""absmiddle""></td>"& vbCrLf
response.write "<td width=""64%"">"& vbCrLf
response.write "<a href='Class.asp?ClassID="&trim(RsClass("ID"))&"'>"&trim(RsClass("Names"))&"</a>"
response.write "</td></tr><tr> "& vbCrLf
RsClass.movenext
loop
RsClass.close
set RsClass=nothing
end if
Rs.movenext
loop
end if
Rs.close
set Rs=nothing
response.write "</table>"& vbCrLf
End sub
Rem Pw_Sys 信息条的显示
Function Gaobei_ShowInfo(s_num,nums,Linenum,S_info,Show_date)
response.write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""1"" cellspacing=""1"">"& vbCrLf
Select case s_num
case 1 '热门
InfoSql="select top "&nums&" * from Info order by hits desc,ID desc"
case 2 '新信息
InfoSql="select top "&nums&" * from Info order by AddDate desc,ID desc"
case 3 '大类热门
InfoSql="select top "&nums&" * from Info where Sort1="&S_info&" order by hits desc,ID desc"
case 4 '小类热门
InfoSql="select top "&nums&" * from Info where Sort2="&S_info&" order by hits desc,ID desc"
case 5 '大类
InfoSql="select top "&nums&" * from Info where Sort1="&S_info&" order by AddDate desc,ID desc"
case 6 '小类
InfoSql="select top "&nums&" * from Info where Sort2="&S_info&" order by AddDate desc,ID desc"
Case 7 '推荐
InfoSql="select top "&nums&" * from Info Where Pw_Good=True ORDER BY id DESC"
Case else '其它
InfoSql="select top "&nums&" * from Info order by hits desc"
End Select
Set InfoRs=Conn.Execute(InfoSql)
if InfoRs.eof or InfoRs.bof then
response.write"<tr><td align='center'>没有信息...</td></tr>"
end if
while not Infors.eof
set title=Infors("title")
set id=Infors("id")
response.write "<tr><td width=""8%""align=""right""><img src=""Images/Gaobei_skin/Gaobei_ico.gif"" width=""12"" height=""11"" align=""absmiddle""></td><td width=""92%""><p style='line-height: 150%'>"& vbCrLf
response.write "<a href='ViewInfo.asp?id="&id&"'title='"&title&"'>"
if GetLen(title)>Linenum then
response.write ""&LeftStr(title,Linenum-2)&""
response.write "..."
else
response.write ""&title&""
end if
if Show_date=1 then
response.write " "
response.write "<font color='#808080'>"
response.write DateTimeFormat(Infors("AddDate"),3)
response.write "</font>"
End if
response.write "</a></td></tr>"
Infors.movenext
wend
Infors.close
set Infors=nothing
response.write "</table>"
End Function
Function NoPic(Gaobei_DisInfo)
response.write "<table width=""100"" border=""0"" align=""center"" cellpadding=""3"" cellspacing=""3""><tr> "& vbCrLf
response.write "<td><img src=""Images/Gaobei_skin/Gaobei_nopic.gif"" border=""0""></td>"& vbCrLf
response.write "</tr><tr><td height=""18"">"& vbCrLf
response.write "<div align=""center"">"&Gaobei_DisInfo&"</div></td>"& vbCrLf
response.write "</tr></table>"& vbCrLf
End Function
Function Gaobei_ShowPic(Gaobei_Pic,Gaobei_InfoID,Gaobei_Title,Gaobei_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=ViewInfo.asp?id="&Gaobei_InfoID&" Title='"&Gaobei_Title&"'><img src="&Gaobei_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=ViewInfo.asp?id="&Gaobei_InfoID&" title='"&Gaobei_Title&"'>"
if GetLen(Gaobei_Title)>Gaobei_long then
response.write LeftStr(Gaobei_Title,Gaobei_long-2)
response.write "..."
else
response.write Gaobei_Title
end if
response.write "</a>"
response.write "</td></tr></table>"& vbCrLf
End Function
Function Gaobei_ShowTopPic(Top_num)
response.write "<TABLE cellSpacing=5 cellPadding=0 width=""100%"" align=center border=0><TBODY><TR vAlign=top>"& 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 "<TD height=82 align=middle>"
Call Gaobei_ShowPic(Rstop("Pic"),Rstop(0),Rstop("Title"),120,98,18)
response.write "</TD>"
Rstop.movenext
loop
response.write "</TR></TBODY></TABLE>"
Rstop.close
set Rstop=nothing
End Function
Dim MyCount : MyCount="http://www.gaobei.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")
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -