common.asp

网站 QCNEWS后台管理程序,风格流行功能强大

re.Pattern="(\[EMAIL\])(\S+\@.[^\[]*)(\[\/EMAIL\])"
strContent= re.Replace(strContent,"<img align=absmiddle src=image/email1.gif><A HREF=""mailto:$2"">$2</A>")
re.Pattern="(\[EMAIL=(\S+\@.[^\[]*)\])(.[^\[]*)(\[\/EMAIL\])"
strContent= re.Replace(strContent,"<img align=absmiddle src=image/email1.gif><A HREF=""mailto:$2"" TARGET=_blank>$3</A>")

'自动识别网址
re.Pattern = "^((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+)"
strContent = re.Replace(strContent,"<img align=absmiddle src=image/url.gif border=0><a target=_blank href=$1>$1</a>")
re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+)$"
strContent = re.Replace(strContent,"<img align=absmiddle src=image/url.gif border=0><a target=_blank href=$1>$1</a>")
re.Pattern = "([^>=""])((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+)"
strContent = re.Replace(strContent,"$1<img align=absmiddle src=image/url.gif border=0><a target=_blank href=$2>$2</a>")

'自动识别www等开头的网址
re.Pattern = "([^(http://|http:\\)])((www|cn)[.](\w)+[.]{1,}(net|com|cn|org|cc)(((\/[\~]*|\\[\~]*)(\w)+)|[.](\w)+)*(((([?](\w)+){1}[=]*))*((\w)+){1}([\&](\w)+[\=](\w)+)*)*)"
strContent = re.Replace(strContent,"<img align=absmiddle src=image/url.gif border=0><a target=_blank href=http://$2>$2</a>")


re.Pattern="\[color=(.[^\[]*)\](.[^\[]*)\[\/color\]"
strContent=re.Replace(strContent,"<font color=$1>$2</font>")
re.Pattern="\[face=(.[^\[]*)\](.[^\[]*)\[\/face\]"
strContent=re.Replace(strContent,"<font face=$1>$2</font>")
re.Pattern="\[align=(center|left|right)\](.*)\[\/align\]"
strContent=re.Replace(strContent,"<div align=$1>$2</div>")

re.Pattern="\[SHADOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/SHADOW]"
strContent=re.Replace(strContent,"<table width=$1 ><tr><td style=""filter:shadow(color=$2, strength=$3)"">$4</td></tr></table>")
re.Pattern="\[GLOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/GLOW]"
strContent=re.Replace(strContent,"<table width=$1 ><tr><td style=""filter:glow(color=$2, strength=$3)"">$4</td></tr></table>")

re.Pattern="\[MP=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/MP]"
strContent=re.Replace(strContent,"<object align=middle classid=CLSID:22d6f312-b0f6-11d0-94ab-0080c74c7e95 class=OBJECT id=MediaPlayer width=$1 height=$2 ><param name=ShowStatusBar value=-1><param name=Filename value=$3><embed type=application/x-oleobject codebase=http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=5,1,52,701 flename=mp src=$3  width=$1 height=$2></embed></object>")


re.Pattern="\[RM=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/RM]"
strContent=re.Replace(strContent,"<OBJECT classid=clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA class=OBJECT id=RAOCX width=$1 height=$2><PARAM NAME=SRC VALUE=$3><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=$1><PARAM NAME=SRC VALUE=$3><PARAM NAME=AUTOSTART VALUE=-1><PARAM NAME=CONTROLS VALUE=controlpanel><PARAM NAME=CONSOLE VALUE=Clip1></OBJECT>")

re.Pattern="\[CENTER](.[^\[]*)\[\/CENTER]"
strContent=re.Replace(strContent,"<center>$1</center>")
re.Pattern="\[i\](.[^\[]*)\[\/i\]"
strContent=re.Replace(strContent,"<i>$1</i>")
re.Pattern="\[u\](.[^\[]*)(\[\/u\])"
strContent=re.Replace(strContent,"<u>$1</u>")
re.Pattern="\[b\](.[^\[]*)(\[\/b\])"
strContent=re.Replace(strContent,"<b>$1</b>")
re.Pattern="\[size=([1-4])\](.[^\[]*)\[\/size\]"
strContent=re.Replace(strContent,"<font size=$1>$2</font>")
strContent=replace(strContent,"<I></I>","")
set re=Nothing
Ubbcode=strContent
end function


    Public sub Jmail(YouMail,SendEmail,topic,mailbody)
	on error resume next
	dim JMail

	Set JMail=Server.CreateObject("JMail.SMTPMail")
	JMail.Logging=True
	JMail.Charset="gb2312"
	JMail.ContentType = "text/html"
	JMail.ServerAddress=Smtp
	JMail.Sender=YouMail
	JMail.Subject=topic
	JMail.Body=mailbody
	JMail.AddRecipient SendEmail
	JMail.Priority=1
	'JMail.MailServerUserName = "[e-mail]" '您的邮件服务器登录名
	'JMail.MailServerPassword = "admin" '登录密码
	JMail.Execute 
	Set JMail=nothing 
	if err then 
	MailStr=err.description
	err.clear
	else
	MailStr="OK"
	end if
    end sub

    Public sub Cdonts(YouMail,SendEmail,topic,mailbody)
	on error resume next
	dim  objCDOMail
	Set objCDOMail = Server.CreateObject("CDONTS.NewMail")
	objCDOMail.From =YouMail
	objCDOMail.To =SendEmail
	objCDOMail.Subject =topic
	objCDOMail.BodyFormat = 0 
	objCDOMail.MailFormat = 0 
	objCDOMail.Body =mailbody
	objCDOMail.Send
	Set objCDOMail = Nothing
	if err then 
	MailStr=err.description
	err.clear
	else
	MailStr="OK"
	end if
    end sub

    Public sub aspemail(YouMail,SendEmail,topic,mailbody)
	on error resume next
	dim mailer,recipient,sender,subject,message
	dim mailserver,result
	Set mailer=Server.CreateObject("ASPMAIL.ASPMailCtrl.1")  
	recipient=SendEmail
	sender=YouMail
	subject=topic
	message=mailbody
	mailserver=Forum_info(4)
	result=mailer.SendMail(mailserver, recipient, sender, subject, message)
	if err then 
	MailStr=err.description
	err.clear
	else
	MailStr="OK"
	end if
    end sub

Public function IsValidEmail(email)

dim names, name, i, c

	IsValidEmail = true
	names = Split(email, "@")
	if UBound(names) <> 1 then
	   IsValidEmail = false
	   exit function
	end if
	for each name in names
	   if Len(name) <= 0 then
		 IsValidEmail = false
	     exit function
	   end if
	   for i = 1 to Len(name)
		 c = Lcase(Mid(name, i, 1))
	     if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
	       IsValidEmail = false
		   exit function
	     end if
	   next
	   if Left(name, 1) = "." or Right(name, 1) = "." then
		  IsValidEmail = false
	      exit function
	   end if
	next
	if InStr(names(1), ".") <= 0 then
	   IsValidEmail = false
	   exit function
	end if
	i = Len(names(1)) - InStrRev(names(1), ".")
	if i <> 2 and i <> 3 then
	   IsValidEmail = false
	   exit function
	end if
	if InStr(email, "..") > 0 then
	   IsValidEmail = false
	end if
end function

public Sub MenuJsList()
	Response.write "<script language=javascript1.2>"
	Sql = "SELECT flag from article_class where flag<>0 group by flag "
	Set Rs = conn.execute(Sql)
	if not rs.eof then
		do while not rs.eof
			Response.write "linkset["& Rs(0) &"]=new Array()" & vbcrlf
			SqlStr = "Select Unid,Classname from article_class where flag = "& Rs(0) &" order by orderflag asc"
			Set RsStr = conn.execute(SqlStr)
			if not RsStr.eof then
				dim i 
				i = 0
				do while not RsStr.eof
					Response.write "linkset["& Rs(0) &"]["& i &"]='<div class=""menuitems""><a href=""2j.asp?id="& Rs(0) &"&cid="& RsStr(0) &""">"& RsStr(1) &"</a></div>'" & vbcrlf
				RsStr.movenext
				i = i + 1
				loop
			end if
			RsStr.close
		rs.movenext
		loop
	end if
	rs.close
	Response.write "</script>"
end Sub


Public Function FormatTime(str)
	dim s,t
	s = Month(str)
	if len(s)<2 then
		s = "0" & s
	end if
	t = Day(str)
	if len(t)<2 then
		t = "0" & t
	end if
	FormatTime = s & "-" & t
end function

Public 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
				End If
			Next
			strLength=t
		Else 
			strLength=Len(str)
		End If
	End Function

Public Function UnFixStrs(Vari)
    If Vari = "" Then
      UnFixStrs = ""
      Exit Function
   End If
     UnFixStrs = Replace(Vari, "&quot;","""" )
     UnFixStrs = Replace(UnFixStrs, "&#39","'" )
     UnFixStrs = Replace(UnFixStrs, "&lt","<" )
     UnFixStrs = Replace(UnFixStrs, "&gt",">" )
     UnFixStrs = Replace(UnFixStrs, "&#124","|" )
     UnFixStrs = Replace(UnFixStrs,"&#44" ,"," )
     UnFixStrs = Replace(UnFixStrs,"&nbsp;" ," " )
     UnFixStrs = Replace(UnFixStrs,"&#40;" ,"(" ) 
     UnFixStrs = Replace(UnFixStrs,"&#41;" ,")" )
     UnFixStrs = Replace(UnFixStrs,"<BR>" ,CHR(13))
	 UnFixStrs = Replace(UnFixStrs,"</P><P>" ,CHR(10) & CHR(10))
End Function

Public Function RemarkCount(userstr)
	sqlus = "Select count(Unid) from article_remark where username = '"& userstr &"'"
	set rsus = conn.execute(sqlus)
	if rsus.eof and rsus.bof then
		RemarkCount = 0
	else
		RemarkCount = rsus(0)
	end if
	rsus.close : set rsus = nothing
End Function

End Class
%>