<%
Function HtmlFormcode(ByVal fString)
    if Not IsNull(fString) Then
        fString = Replace(fString, ">", "&gt;")
        fString = Replace(fString, "<", "&lt;")
        fString = Replace(fString, Chr(34), "&quot;")
        HtmlFormcode = fString
	else
        HtmlFormcode = fString
    end if
End Function

Function LoseHtml(ContentStr)
	Dim ClsTempLoseStr,regEx
	ClsTempLoseStr = Cstr(ContentStr)
	Set regEx = New RegExp
	regEx.Pattern = "<\/*[^<>]*>"
	regEx.IgnoreCase = True
	regEx.Global = True
	ClsTempLoseStr = regEx.Replace(ClsTempLoseStr,"")
	LoseHtml = ClsTempLoseStr
End function
Function ListTitle(TitleStr,TitleNum)
   Dim ClsTitleStr,ClsTitleNum,i,j,ClsTempNum,k,ClsTitleStrResult,LeftStr,RightStr
	   ClsTitleNum = Cint(TitleNum)
	   ClsTempNum = Len(Cstr(TitleStr))
	   if ClsTitleNum > ClsTempNum then
		   ClsTitleNum = ClsTempNum
	   end if
	   ClsTitleStr = Left(Cstr(TitleStr),ClsTitleNum)
	   Dim TempStr
	   For i = 1 to ClsTitleNum - 1
		   TempStr = TempStr & Mid(ClsTitleStr,i,1) & "<br>"
       Next
	   TempStr = TempStr & Right(ClsTitleStr,1)
	   ListTitle = TempStr
End Function
Function  DateFormat(DateStr,Types)
    Dim DateString
	if IsDate(DateStr) = False then
		DateString = ""
	end if
	Select Case Types
	  Case "1" 
		  DateString = Year(DateStr)&"-"&Month(DateStr)&"-"&Day(DateStr)
	  Case "2"
		  DateString = Year(DateStr)&"."&Month(DateStr)&"."&Day(DateStr)
	  Case "3"
		  DateString = Year(DateStr)&"/"&Month(DateStr)&"/"&Day(DateStr)
	  Case "4"
		  DateString = Month(DateStr)&"/"&Day(DateStr)&"/"&Year(DateStr)
	  Case "5"
		  DateString = Day(DateStr)&"/"&Month(DateStr)&"/"&Year(DateStr)
	  Case "6"
		  DateString = Month(DateStr)&"-"&Day(DateStr)&"-"&Year(DateStr)
	  Case "7"
		  DateString = Month(DateStr)&"."&Day(DateStr)&"."&Year(DateStr)
	  Case "8"
		  DateString = Month(DateStr)&"-"&Day(DateStr)
	  Case "9"
		  DateString = Month(DateStr)&"/"&Day(DateStr)
	  Case "10"
		  DateString = Month(DateStr)&"."&Day(DateStr)
	  Case "11"
		  DateString = Month(DateStr)&"月"&Day(DateStr)&"日"
	  Case "12"
		  DateString = Day(DateStr)&"日"&Hour(DateStr)&"时"
	  case "13"
		  DateString = Day(DateStr)&"日"&Hour(DateStr)&"点"
	  Case "14"
		  DateString = Hour(DateStr)&"时"&Minute(DateStr)&"分"
	  Case "15"
		  DateString = Hour(DateStr)&":"&Minute(DateStr)
	  Case "16"
		  DateString = Year(DateStr)&"年"&Month(DateStr)&"月"&Day(DateStr)&"日"
	  Case Else
	  	  DateString = DateStr
	 End Select
	 DateFormat = DateString
 End Function
Function GetRandomID18()
	Dim TempYear,TempMonth,TempDay,TempHour,TempMinute,TempSecond,RandomFigure
	Dim TempStr,NowTime
	NowTime = Now()
	TempYear =  Right(CStr(Year(NowTime)),2)
	TempMonth =  CStr(Month(NowTime))
	if Len(TempMonth) = 1 then
		TempHour = "0" & TempMonth
	end if
	TempDay =  CStr(Day(NowTime))
	if Len(TempDay) = 1 then
		TempHour = "0" & TempDay
	end if
	TempHour = CStr(Hour(NowTime))
	if Len(TempHour) = 1 then
		TempHour = "0" & TempHour
	end if
	TempMinute = CStr(Minute(NowTime))
	if Len(TempMinute) = 1 then
		TempMinute = "0" & TempMinute
	end if
	TempSecond = CStr(Second(NowTime))
	if Len(TempSecond) = 1 then
		TempSecond = "0" & TempSecond
	end if
	Randomize 
	RandomFigure = CStr(Int((99999 * Rnd) + 1))
	GetRandomID18 = TempYear & TempMonth & TempDay & TempHour & TempMinute & TempSecond & RandomFigure
End Function


Function NewsFileName(NewsFileNameStr,IClassID,INewsID)
		NewsFileName = ""
		If NewsFileNameStr="" or isnull(NewsFileNameStr) then
			NewsFileName = Hour(Now()) & Minute(Now()) & Second(Now()) & CStr(Int((999 * Rnd) + 1))
		Else
			If Instr(1,NewsFileNameStr,"U",1)<>0 then
				If Instr(1,NewsFileNameStr,"Y",1)<>0 then
					NewsFileName = NewsFileName & Year(Now())
				End If
				If Instr(1,NewsFileNameStr,"M",1)<>0 then
					If Len(Cstr(Month(Now()))) < 2 then
						NewsFileName = NewsFileName &"_0"& Month(Now())
					Else
						NewsFileName = NewsFileName &"_"& Month(Now())
					End If
				End If
				If Instr(1,NewsFileNameStr,"D",1)<>0 then
					If Len(Cstr(Day(Now())))<2 then
						NewsFileName = NewsFileName &"_0"& Day(Now())
					Else
						NewsFileName = NewsFileName &"_"& Day(Now())
					End if
				End If
				If Instr(1,NewsFileNameStr,"H",1)<>0 then
					If Len(Cstr(Hour(Now())))<2 then
						NewsFileName = NewsFileName &"_0"& Hour(Now())
					Else
						NewsFileName = NewsFileName &"_"& Hour(Now())
					End If
				End If
				If Instr(1,NewsFileNameStr,"I",1)<>0 then
					If Len(Cstr(Minute(Now())))<2 then
						NewsFileName = NewsFileName &"_0"& Minute(Now())
					Else
						NewsFileName = NewsFileName &"_"& Minute(Now())
					End If
				End If
				If Instr(1,NewsFileNameStr,"S",1)<>0 then
					If Len(Cstr(Second(Now())))<2 then
						NewsFileName = NewsFileName &"_0"& Second(Now())
					Else
						NewsFileName = NewsFileName &"_"& Second(Now())
					End If
				End If
				If Instr(1,NewsFileNameStr,"A",1)<>0 then
					NewsFileName = NewsFileName &"_"& IClassID
				End If
				If Instr(1,NewsFileNameStr,"N",1)<>0 then
					NewsFileName = NewsFileName &"_"& INewsID
				End If
				If Instr(1,NewsFileNameStr,"Z",1)<>0 then
					NewsFileName = NewsFileName &"_"& CStr(Int((99 * Rnd) + 1))
				End If
				If Instr(1,NewsFileNameStr,"X",1)<>0 then
					NewsFileName = NewsFileName &"_"& CStr(Int((999 * Rnd) + 1))
				End If
				If Instr(1,NewsFileNameStr,"C",1)<>0 then
					NewsFileName = NewsFileName &"_"& CStr(Int((9999 * Rnd) + 1))
				End If
				If Instr(1,NewsFileNameStr,"V",1)<>0 then
					NewsFileName = NewsFileName &"_"& CStr(Int((99999 * Rnd) + 1))
				End If
			Else
				If Instr(1,NewsFileNameStr,"Y",1)<>0 then
					NewsFileName = NewsFileName & Year(Now())
				End If
				If Instr(1,NewsFileNameStr,"M",1)<>0 then
					If Len(Cstr(Month(Now()))) < 2 then
						NewsFileName = NewsFileName &"0"& Month(Now())
					Else
						NewsFileName = NewsFileName & Month(Now())
					End If
				End If
				If Instr(1,NewsFileNameStr,"D",1)<>0 then
					If Len(Cstr(Day(Now())))<2 then
						NewsFileName = NewsFileName &"0"& Day(Now())
					Else
						NewsFileName = NewsFileName & Day(Now())
					End if
				End If
				If Instr(1,NewsFileNameStr,"H",1)<>0 then
					If Len(Cstr(Hour(Now())))<2 then
						NewsFileName = NewsFileName &"0"& Hour(Now())
					Else
						NewsFileName = NewsFileName & Hour(Now())
					End If
				End If
				If Instr(1,NewsFileNameStr,"I",1)<>0 then
					If Len(Cstr(Minute(Now())))<2 then
						NewsFileName = NewsFileName &"0"& Minute(Now())
					Else
						NewsFileName = NewsFileName & Minute(Now())
					End If
				End If
				If Instr(1,NewsFileNameStr,"S",1)<>0 then
					If Len(Cstr(Second(Now())))<2 then
						NewsFileName = NewsFileName &"0"& Second(Now())
					Else
						NewsFileName = NewsFileName & Second(Now())
					End If
				End If
				If Instr(1,NewsFileNameStr,"A",1)<>0 then
					NewsFileName = NewsFileName & IClassID
				End If
				If Instr(1,NewsFileNameStr,"N",1)<>0 then
					NewsFileName = NewsFileName & INewsID
				End If
				If Instr(1,NewsFileNameStr,"Z",1)<>0 then
					NewsFileName = NewsFileName & CStr(Int((99 * Rnd) + 1))
				End If
				If Instr(1,NewsFileNameStr,"X",1)<>0 then
					NewsFileName = NewsFileName & CStr(Int((999 * Rnd) + 1))
				End If
				If Instr(1,NewsFileNameStr,"C",1)<>0 then
					NewsFileName = NewsFileName & CStr(Int((9999 * Rnd) + 1))
				End If
				If Instr(1,NewsFileNameStr,"V",1)<>0 then
					NewsFileName = NewsFileName & CStr(Int((99999 * Rnd) + 1))
				End If
			End If
		End If
		If Left(NewsFileName,1)="_" then
			NewsFileName = Right(NewsFileName,Len(Cstr(NewsFileName))-1)
		End If
		NewsFileName = NewsFileName
End Function
Function GotTopic(Str,StrLen)
	Dim l,t,c, i,LableStr,regEx,Match,Matches
	if IsNull(Str) then 
		GotTopic = ""
		Exit Function
	end if
	if Str = "" then
		GotTopic=""
		Exit Function
	end if
	Set regEx = New RegExp
	regEx.Pattern = "\[[^\[\]]*\]"
	regEx.IgnoreCase = True
	regEx.Global = True
	Set Matches = regEx.Execute(Str)
	For Each Match in Matches
		LableStr = LableStr & Match.Value
	Next
	Str = regEx.Replace(Str,"")
	Str=Replace(Replace(Replace(Replace(Str,"&nbsp;"," "),"&quot;",Chr(34)),"&gt;",">"),"&lt;","<")
	l=len(str)
	t=0
	strlen=Clng(strLen)
	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
			GotTopic=left(str,i)
			exit for
		else
			GotTopic=str
		end if
	next
	GotTopic =LableStr & Replace(Replace(Replace(Replace(GotTopic," ","&nbsp;"),Chr(34),"&quot;"),">","&gt;"),"<","&lt;") 
end function

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
Sub ReturnRefreshError()
	Response.Write("<script>alert(""Fearful Error!"&Copyright&""");window.close();</script>")
	Response.End 
End Sub
Function IsObjInstalled(strClassString)
	On Error Resume Next
	IsObjInstalled = False
	Err = 0
	Dim xTestObj
	Set xTestObj = Server.CreateObject(strClassString)
	If 0 = Err Then IsObjInstalled = True
	Set xTestObj = Nothing
	Err = 0
End Function
function SendMail(MailtoAddress,MailtoName,Subject,MailBody,FromName,MailFrom,Priority)
	on error resume next
	Dim JMail
	Set JMail=Server.CreateObject("JMail.Message")
	if err then
		SendMail= "<br><li>没有安装JMail组件</li>"
		err.clear
		exit function
	end if
	JMail.Charset="gb2312"      
	JMail.silent=true
	JMail.ContentType = "text/html"  
	JMail.MailServerUserName = MailServerUserName  
   	JMail.MailServerPassWord = MailServerPassword      
  	JMail.MailDomain = MailDomain      
	JMail.AddRecipient MailtoAddress,MailtoName   
	JMail.Subject=Subject        
	JMail.HMTLBody=MailBody   
	JMail.Body=MailBody         
	JMail.FromName=FromName      
	JMail.From = MailFrom       
	JMail.Priority=Priority          
	JMail.Send(MailServer)
	SendMail =JMail.ErrorMessage
	JMail.Close
	Set JMail=nothing
end function

function ReplaceBadChar(strChar)
	if strChar="" then
		ReplaceBadChar=""
	else
		ReplaceBadChar=replace(replace(replace(replace(replace(replace(replace(strChar,"'",""),"*",""),"?",""),"(",""),")",""),"<",""),".","")
	end if
end function

Function ReplaceRemoteUrl(NewsContent,SaveFilePath,FunDoMain,DummyPath)
	Dim re,RemoteFile,RemoteFileurl,SaveFileName,FileName,FileExtName,SaveImagePath
	Set re = New RegExp
	re.IgnoreCase = True
	re.Global=True
	re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}((\w)+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(gif|jpg|png|bmp)))"
	Set RemoteFile = re.Execute(NewsContent)
	Set re = Nothing
	For Each RemoteFileurl in RemoteFile
		SaveFileName = Mid(RemoteFileurl,InstrRev(RemoteFileurl,"/")+1)
		FileExtName = Mid(SaveFileName,InstrRev(SaveFileName,".")+1)
		Call SaveRemoteFile(DummyPath & SaveFilePath & "/" & SaveFileName,RemoteFileurl)
		NewsContent = Replace(NewsContent,RemoteFileurl,FunDoMain & SaveFilePath & "/" & SaveFileName)
	Next
	ReplaceRemoteUrl = NewsContent
End Function

Sub SaveRemoteFile(LocalFileName,RemoteFileUrl)
	Dim StreamObj,Retrieval,GetRemoteData
	Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
	With Retrieval
		.Open "Get", RemoteFileUrl, False, "", ""
		.Send
		GetRemoteData = .ResponseBody
	End With
	Set Retrieval = Nothing
	Set StreamObj = Server.CreateObject("Adodb.Stream")
	With StreamObj
		.Type = 1
		.Open
		.Write GetRemoteData
		.SaveToFile Server.MapPath(LocalFileName),2
		.Cancel()
		.Close()
	End With
	Set StreamObj = Nothing
End Sub

function JoinChar(strUrl)
	if strUrl="" then
		JoinChar=""
		exit function
	end if
	if InStr(strUrl,"?")<len(strUrl) then 
		if InStr(strUrl,"?")>1 then
			if InStr(strUrl,"&")<len(strUrl) then 
				JoinChar=strUrl & "&"
			else
				JoinChar=strUrl
			end if
		else
			JoinChar=strUrl & "?"
		end if
	else
		JoinChar=strUrl
	end if
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 InterceptStr(SourceStr,StrLen,AnnexStr)   
	InterceptStr = GotTopic(SourceStr,StrLen)
	if Not IsNull(AnnexStr) then
		 InterceptStr = InterceptStr & CStr(AnnexStr)
	end if
End Function
Function GetDoMain()
	Dim TempPath
	if Request.ServerVariables("SERVER_PORT")="80" then
		GetDoMain = Request.ServerVariables("SERVER_NAME")
	else
		GetDoMain = Request.ServerVariables("SERVER_NAME") & ":" & Request.ServerVariables("SERVER_PORT")
	end if
	TempPath = Request.ServerVariables("APPL_MD_PATH")
	TempPath = Right(TempPath,Len(TempPath)-InStr(TempPath,"Root")-3)
	GetDoMain = "http://" & GetDoMain & TempPath
End Function
Function GetConfigDoMain()
	Dim ConfigSql,RsConfigObj
	ConfigSql = "Select DoMain,MakeType from Config"
	Set RsConfigObj = Conn.Execute(ConfigSql)
	if Not RsConfigObj.Eof then
		GetConfigDoMain = RsConfigObj("DoMain")
	else
		GetConfigDoMain = GetDoMain
	end if
	Set RsConfigObj = Nothing
End Function

Function GetCurrentPath()
	Dim TempPath,Path
	TempPath = Request.ServerVariables("Path_info")
	Path = Left(TempPath,InstrRev(TempPath,"/"))
	GetCurrentPath = GetDoMain & Path
End Function
Function GetNewsTitlePara(Para)
	Dim TempArray
	if Len(Para) <> 9 then
		TempArray = Array("","","")
	else
		TempArray = Array(Left(Para,7),Mid(Para,8,1),Right(Para,1))
	end if
	GetNewsTitlePara = TempArray
End Function

Function GetHTMLTitle(StylePara,Title)
	Dim TempArray
	TempArray = GetNewsTitlePara(StylePara)
	if TempArray(0)<>"#UUUUUU" then
		GetHTMLTitle = "<font color=""" & TempArray(0) & """>" & Title & "</font>"
	else
		GetHTMLTitle =  Title
	end if
	if TempArray(1) = "1" then
		GetHTMLTitle = "<strong>" & GetHTMLTitle & "</strong>"
	end if
	if TempArray(2) = "1" then
		GetHTMLTitle = "<em>" & GetHTMLTitle & "</em>"
	end if
End Function
Function RemoveVirtualPath(Path)
	Dim PathInfo
	if Path <> "" then  
		if SysRootDir <> ""   then 
			PathInfo = Mid(Path,InStr(Path,SysRootDir)+Len(SysRootDir)+1)
		else
			PathInfo = Path
		end if
	else
		PathInfo = Path
	end if
	RemoveVirtualPath = PathInfo
End Function
Function RemoveSpecialStr(Path)
	Dim PathInfo
	if Path <> "" then  
		if SysRootDir <> ""   then 
			PathInfo = Mid(Path,InStr(Path,SysRootDir)+Len(SysRootDir))
		else
			PathInfo = Path
		end if
	else
		PathInfo = Path
	end if
	RemoveSpecialStr = PathInfo
End Function
Function GetVirtualPath()
	GetVirtualPath = Request.ServerVariables("APPL_MD_PATH")
	GetVirtualPath = Right(GetVirtualPath,Len(GetVirtualPath)-InStr(GetVirtualPath,"Root")-3)
End Function

'===========================================================
'修改：2005-3-29 Olin
'说明：1. 处理非法登陆，非法访问页面的情况
'      2. 判断依据登陆用户session("name")为空
'      3. 为空则提示并返回前一页面
'-----------------------------------------------------------
Sub limitUserNotLogin(sessionName)
	If trim(sessionName) = "" Then
		Response.Write("<script>alert(""[系统错误]\n\n您的权限不足，请与系统管理员联系！\n"");history.go(-1);</script>")
		Response.End	
	End If
End Sub
'===========================================================

'===========================================================
'修改：2005-4-15 Olin
'防止SQL注入
'-----------------------------------------------------------
public sub avoidSQLImmit()
	Dim LostPost,LostGet,Lost_flag,Lost_flagf,LostErs,Losdb,Losdbstr
	Lost_flag = "'|;|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare"
	Lost_flagf = split(Lost_flag,"|")
	If Request.Form<>"" Then
		For Each LostPost In Request.Form
			For LostErs=0 To Ubound(Lost_flagf)
				If Instr(LCase(Request.Form(LostPost)),Lost_flagf(LostErs))<>0 Then
					Response.Write "<Script Language=JavaScript>alert(""参数错误！"");</Script>"
					Response.End
				End If
			Next
		Next
	End If
	If Request.QueryString<>"" Then
		For Each LostGet In Request.QueryString
			For LostErs=0 To Ubound(Lost_flagf)
				If Instr(LCase(Request.QueryString(LostGet)),Lost_flagf(LostErs))<>0 Then
					Response.Write "<Script Language=JavaScript>alert(""参数错误！"");</Script>"
					Response.End
				End If
			Next
		Next
	End If
end sub
'==========================================================
%>