string.asp

功能齐全的oa系统

<%
	'FixSQL		使输入的字符串变为不含危险代码的SQL语句
	'FixStr		对输入的字符串进行HTML格式化并判断是否为空（应用于标题，也可
	'           应用于其他。因为标题不可为空，但其他可以为空.）
	'FixBody	对输入的字符串(内容)进行HTML格式化
	'FixStrLen	对输入的字符串进行截长


	Function FixSQL(StrSQL)
		Dim Str
		Str = StrSQL
		str=Replace(str,"'","''")
		str=replace(str,"%","")
		str=replace(str,";","")
		FixSQL=str
	End Function
	
	Function FixStr(StrIn)
		Dim Str
		Str = StrIn
		If IsNull(Str) Then Str = ""
		If Str<>"" Then Str = Server.HTMLEncode(Str)
		FixStr = Str
	End Function
	   
	Function FixBody(StrIn)
		Dim Str
		Dim Spos,Epos,strURL,tmpStr,tmpPos
		Str = StrIn
		Spos=1
		str=Replace(str,chr(34),"&quot;")
		str=Replace(str,"<","&lt")
		str=Replace(str,">","&gt")
		str=Replace(str,chr(9),"&nbsp;&nbsp;&nbsp;&nbsp;")
		Spos=instr(Spos,str,"http://")
		if sPos>0 then 
			str=str+"∧"
			str=Replace(str,"http://","∧http://")
			str=Replace(str,chr(13),"∧<br>")
			str=Replace(str," ","∧")
			while (Spos>0)
				Spos=instr(Spos,str,"∧http://")
				if Spos>0 then
				   Epos=instr(Spos+1,str,"∧")
				   if Epos>0 then
					  strURL=mid(str,Spos+1,Epos-Spos-1)
					  strURL=trim(strURL)
					  strURL=lcase(strURL)
					  if instr(strURL,"gif")>0 or instr(strURL,"jpg")>0 then
						strURL="<img src='"+strURL+"' >"
					  else
						strURL=" <a target=_blank href="+chr(34)+strURL+chr(34)+" > "+strURL+" </a> "
					  end if
	   				  tmpStr=left(str,Spos-1)+strURL+right(str,len(str)-Epos)
					  str=tmpstr	

				   end if
				   spos=spos+5
				end if
			wend
			str=Replace(str,"∧","&nbsp;")
		else
	 		str=Replace(str," ","&nbsp;")
		end if
		str=Replace(str,chr(13)+chr(10),"<br>")
		str = Replace (str,"{red:","<font color=#996666>")
		str = Replace (str,":}","</font>")
		str = Replace (str,"{{","<img src=")
		str = Replace (str,"}}",">")
			
		FixBody = str
	End function
	   

	Function FixStrLen(Str,Length)
		Dim TempStr
		If Str = "" Or IsNull(Str) Then
			FixStrLen = ""
			Exit Function
		End If
		TempStr		= Trim(Server.HTMLEncode(Str))
		If TempStr	<> "" Then
			If lenX(TempStr) > Length Then
				TempStr	= Leftx(TempStr,Length - 2) & ".."
			End If 
		End IF
		'TempStr	=	Replace(TempStr,"'","")
		FixStrLen	= TempStr
	End Function

	'--------------------------------------------------------
	'Name:        lenX
	'Argument:        uStr
	'Return:
	'Description:    返回字符串的长度，1个中文字符长度为2
	'--------------------------------------------------------

	Function lenX(byval uStr)
	    dim theLen,x,testuStr
	    theLen = 0

	    for x = 1 to len(uStr)
	        testuStr = mid(uStr,x,1)
	        if asc(testuStr) < 0 then
	            theLen = theLen + 2
	        else
	            theLen = theLen + 1
	        end if
	    next
	    lenX = theLen
	End function

	'--------------------------------------------------------
	'Name:        leftX
	'Argument:        uStr        待处理的字符串
	'        uLen        要截取的长度
	'Return:
	'Description:    返回指定长度的字符串，1个中文字符长度为2
	'--------------------------------------------------------

	Function leftX(byval uStr,byval uLen)
	    dim i,j,uTestStr,theStr

	    leftX = ""
	    j = 0

	    for i = 1 to len(uStr)
	        uTestStr= mid(uStr,i,1)
	        theStr    = theStr & uTestStr
	        if asc(uTestStr) < 0 then
	            j = j + 2
	        else
	            j = j + 1
	        end if
	        if j >= uLen then exit for
	    next
	    leftX = theStr
	End function

	'--------------------------------------------------------
	'Name:        rightX
	'Argument:        uStr        待处理的字符串
	'        uLen        要截取的长度
	'Return:
	'Description:    返回指定长度的字符串，1个中文字符长度为2
	'--------------------------------------------------------

	Function rightX(byval uStr,byval uLen)
	    dim i,j,uTestStr

	    rightX = ""
	    j = 0

	    for i = len(uStr) to 1 step -1
	        uTestStr = mid(uStr,i,1)
	        rightX = rightX & uTestStr
	        if asc(uTestStr) < 0 then
	            j = j + 2
	        else
	            j = j + 1
	        end if
	        if j >= uLen then exit for
	    next
	End function
%>