function.asp

矮子多用户版客户管理系统2.0Bate2

<%
'================================================
'作  用：检查组件是否已经安装
'参  数：strClassString ----组件名
'返回值：True  ----已经安装
'        False ----没有安装
'================================================
Function IsObjInstalled(ByVal strClassString)
	Dim xTestObj,ClsString
	On Error Resume Next
	IsObjInstalled = False
	ClsString = strClassString
	Err = 0
	Set xTestObj = Server.CreateObject(ClsString)
	If Err = 0 Then IsObjInstalled = True
	If Err = -2147352567 Then IsObjInstalled = True
	Set xTestObj = Nothing
	Err = 0
	Exit Function
End Function
'=============================================================
'函数名：GetRandomCode
'作  用：系统分配随机代码
'=============================================================
Public Function GetRandomCode()
	Dim Ran, i, LengthNum
	LengthNum = 16
	GetRandomCode = ""
	For i = 1 To LengthNum
		Randomize
		Ran = CInt(Rnd * 2)
		Randomize
		If Ran = 0 Then
			Ran = CInt(Rnd * 25) + 97
			GetRandomCode = GetRandomCode & UCase(Chr(Ran))
		ElseIf Ran = 1 Then
			Ran = CInt(Rnd * 9)
			GetRandomCode = GetRandomCode & Ran
		ElseIf Ran = 2 Then
			Ran = CInt(Rnd * 25) + 97
			GetRandomCode = GetRandomCode & Chr(Ran)
		End If
	Next
End Function

'=============================================================
'函数名：getIP
'作  用：获取用户真实IP
'=============================================================
Function GetUserIP()
	Dim sIP
	If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
	    sIP = Request.ServerVariables("REMOTE_ADDR")
	ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
	    sIP = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
	ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
	    sIP = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
	Else
	    sIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
	End If			
	    GetUserIP = CheckIP(sIP)
	End Function

Function CheckIP(sIP)
	sIP=Trim(sIP)
	sIP=Replace(sIP,".",",")
	sIP=ChkIDs(sIP)
	If sIP<>"" Then sIP=Replace(sIP,",",".")
	CheckIP=sIP
End Function

Function ChkIDs(byval sIDs)
	Dim aIDs,i,sReturn
	sIDs=Trim(sIDs)
	If Len(sIDs)=0  Then Exit Function
	aIDs=Split(sIDs,",")
	For i=0 To Ubound(aIDs)
		'发现任意不符合的字符，直接跳出
		If Not IsNumeric(aIDs(i)) Then
			Exit Function
		Else
			sReturn=sReturn & "," & Int(aIDs(i))
		End If	
	Next
	If Left(sReturn,1)="," Then sReturn=Right(sReturn,Len(sReturn)-1)
	ChkIDs=sReturn	
	sReturn=""
End Function



'=============================================================
'函数名：CutStr
'作  用：取标题指定显示的字符数
'参  数：str,strLen
'=============================================================
Function CutStr(ByVal str,ByVal strlen)
	dim l,t,c
	l=len(str)
	t=0
	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
		CutStr=left(str,i)&".."
	exit for
	else
		CutStr=str
	end if
	next
	CutStr=replace(CutStr,chr(10),"")
end Function

'=============================================================
'函数作用：带脏话过滤
'=============================================================
Public Function ChkBadWords(ByVal str)
	If IsNull(str) Then Exit Function
	Dim i, Bwords, Bwordr
	Bwords = Split(Badwords, "|")
	Bwordr = Split(Badwordr, "|")
	For i = 0 To UBound(Bwords)
		If i > UBound(Bwordr) Then
			str = Replace(str, Bwords(i), "*")
		Else
			str = Replace(str, Bwords(i), Bwordr(i))
		End If
	Next
	ChkBadWords = str
End Function
'=============================================================
'函数作用：过滤HTML代码，带脏话过滤
'=============================================================
Public Function HTMLEncode(ByVal fString)
	If Not IsNull(fString) Then
		fString = Replace(fString, "&", "&amp;")
		fString = Replace(fString, ">", "&gt;")
		fString = Replace(fString, "<", "&lt;")
		fString = Replace(fString, Chr(32), " ")
		fString = Replace(fString, Chr(9), " ")
		fString = Replace(fString, Chr(34), "&quot;")
		fString = Replace(fString, Chr(39), "&#39;")
		fString = Replace(fString, Chr(13), "")
		fString = Replace(fString, " ", "&nbsp;")
		fString = Replace(fString, Chr(10), "<br />")
		fString = ChkBadWords(fString)
		HTMLEncode = fString
	End If
End Function