www.gusucode.com > 云枫企业网站源代码第二版 2.0源码程序 > admin/inc/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, "<", "<")
String = Replace(String, ">", ">")
String = Replace(String, CHR(10) & CHR(10), "<BR><BR>")
String = Replace(String, CHR(10), "<BR>")
FormatStr = 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,"[/rm]","",1,-1,1)
atext=replace(atext,"[mp]","",1,-1,1)
atext=replace(atext,"[/mp]","",1,-1,1)
atext=replace(atext,"[qt]","",1,-1,1)
atext=replace(atext,"[/qt]","",1,-1,1)
atext=replace(atext,"<br>","<br>",1,-1,1)
ubb_str=replace(ubb_str,"[quote]"&text,"<blockquote>引用<hr height=1 noshade class='sft'><b>"&atext,1,1,1)
ubb_str=replace(ubb_str,"[/quote]","</b><hr height=1 noshade class='sft'></blockquote><br>",1,1,1)
case "swf"
ubb_str=replace(ubb_str,"[swf]"&text,"Flash动画:<br>"&text&"<br><object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' width='420' height='360'><param name=movie value='"&codetext&"'><param name=quality value=high><embed src='"&codetext&"' quality=high type='application/x-shockwave-flash' width='420' height='360'></embed></object>",1,1,1)
ubb_str=replace(ubb_str,"[/swf]","</embed></object>",1,1,1)
case "dir"
ubb_str=replace(ubb_str,"[dir]"&text,"shockwave文件:<br>"&text&"<br><object classid=clsid:166B1BCA-3F9C-11CF-8075-444553540000 codebase=http://download.macromedia.com/pub/shockwave/cabs/director/sw.cab#version=7,0,2,0 width=420 height=360><param name=movie value='"&codetext&"'><param name=quality value=high><embed src='"&codetext&"' pluginspage=http://www.macromedia.com/shockwave/download/ width=420 height=360></embed></object>",1,1,1)
ubb_str=replace(ubb_str,"[/dir]","</embed></object>",1,1,1)
case "rm"
ubb_str=replace(ubb_str,"[rm]"&text,"realplay视频文件:<br>"&text&"<br><OBJECT classid=clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA class=OBJECT id=RAOCX width=420 height=360><PARAM NAME=SRC VALUE='"&codetext&"'><PARAM NAME=CONSOLE VALUE=Clip1><PARAM NAME=CONTROLS VALUE=imagewindow><PARAM NAME=AUTOSTART VALUE=true></OBJECT><br><OBJECT classid=CLSID:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA height=32 id=video2 width=420><PARAM NAME=SRC VALUE='"&codetext&"'><PARAM NAME=AUTOSTART VALUE=-1><PARAM NAME=CONTROLS VALUE=controlpanel><PARAM NAME=CONSOLE VALUE=Clip1></OBJECT>",1,1,1)
ubb_str=replace(ubb_str,"[/rm]","</object>",1,1,1)
case "mp"
ubb_str=replace(ubb_str,"[mp]"&text,"Media Player视频文件:<br>"&text&"<br><object align=middle classid=CLSID:22d6f312-b0f6-11d0-94ab-0080c74c7e95 class=OBJECT id=MediaPlayer width=420 height=360 ><param name=ShowStatusBar value=-1><param name=Filename value='"&codetext&"'><embed type=application/x-oleobject codebase=http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=5,1,52,701 flename=mp src='"&codetext&"' width=420 height=360></embed></object>",1,1,1)
ubb_str=replace(ubb_str,"[/mp]","</embed></object>",1,1,1)
case "qt"
ubb_str=replace(ubb_str,"[qt]"&text,"QuickTime视频文件:<br>"&text&"<br><embed src='"&codetext&"' width=420 height=360 autoplay=true loop=false controller=true playeveryframe=false cache=false scale=TOFIT bgcolor=#000000 kioskmode=false targetcache=false pluginspage=http://www.apple.com/quicktime/>",1,1,1)
ubb_str=replace(ubb_str,"[/qt]","</embed>",1,1,1)
case "frame"
ubb_str=replace(ubb_str,"[frame]"&text,"<br><table align='center' border=0 width='90%' cellspacing=1 cellpadding=0 class='sft'><tr><td><iframe marginwidth=0 framespacing=0 marginheight=0 frameborder=2 width='100%' height=200 src='"&codetext&"'>",1,1,1)
ubb_str=replace(ubb_str,"[/frame]","</iframe></td></tr><tr><td class=fontcn>页面:<a href='"&codetext&"' target=_blank>点这里参观</a></td></tr></table>",1,1,1)
end select
loop
ubbstr=ubb_str
end function
function htmlencode2(str)
dim result
dim l
if isNULL(str) then
htmlencode2=""
exit function
end if
l=len(str)
result=""
dim i
for i = 1 to l
select case mid(str,i,1)
case "<"
result=result+"<"
case ">"
result=result+">"
case chr(34)
result=result+"""
case "&"
result=result+"&"
case chr(32)
result=result+" "
if i+1<=l and i-1>0 then
if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9) then
result=result+" "
else
result=result+" "
end if
else
result=result+" "
end if
case chr(9)
result=result+" "
case else
result=result+mid(str,i,1)
end select
next
htmlencode2=result
end function
}
%>