commoncode.asp

嘉缘人才6.0精简 ,很好用的人才系统

function ChangeStrbox(str)
 if str<>"" and not isnull(str) then 
   ChangeStrbox=replace(str,"<br>" ,chr(13))
 end if
end function
function lenmix(checkstr)
   lenTotal = 0
   for i=1 to Len(checkstr)
   strWord = mid(checkstr,i,1)
   if asc(strWord) < 0 or asc(strWord) > 127 then
    lenTotal = lenTotal + 2
   else
    lenTotal = lenTotal + 1
   end if
   next
   lenmix = lentotal
end function
function CheckStrHTML(str)
 if str<>"" and not isnull(str) then 
	CheckStrHTML=trim(str)
	CheckStrHTML=replace(CheckStrHTML, "&nbsp;", " ")
	CheckStrHTML=RemoveHTML(CheckStrHTML)
 end if
end function
'**************************************************
'函数名：RemoveHTML
'作  用：过滤HTML
'参  数：strHTML
'返回值：
'**************************************************
Function RemoveHTML(strHTML) 
Dim objRegExp, Match, Matches 
Set objRegExp = New Regexp 
objRegExp.IgnoreCase = True 
objRegExp.Global = True 
'取闭合的<> 
objRegExp.Pattern = "<.+?>" 
'进行匹配 
Set Matches = objRegExp.Execute(strHTML) 
' 遍历匹配集合，并替换掉匹配的项目 
For Each Match in Matches 
strHtml=Replace(strHTML,Match.Value,"") 
Next 
RemoveHTML=strHTML 
Set objRegExp = Nothing 
End Function
'**************************************************
'函数名：Encode,HTMLDecode
'作  用：转换字符
'参  数：fString
'返回值：
'**************************************************
function Encode(fString)
if not isnull(fString) then
    fString = replace(fString, ">", "&gt;")
    fString = replace(fString, "<", "&lt;")
    fString = Replace(fString, " ", "&nbsp;")
    fString = Replace(fString, CHR(32), "&nbsp;")
    fString = Replace(fString, CHR(34), "&quot;")
    fString = Replace(fString, CHR(39), "&#39;")
    fString = Replace(fString, CHR(13), "")
    fString = Replace(fString, CHR(10) & CHR(10), "</P><P>")
    fString = Replace(fString, CHR(10), "<BR>")
    Encode = fString
end if
end function

function HTMLDecode(fString)
if not isnull(fString) then
    fString = replace(fString, "&gt;", ">")
    fString = replace(fString, "&lt;", "<")
    fString = replace(fString, "&nbsp;", " ")
    fString = Replace(fString, "", CHR(13))
    fString = Replace(fString, "</P><P>", CHR(10) & CHR(10))
    fString = Replace(fString, "<BR>", CHR(10))
    HTMLDecode = fString
end if
end function
'**************************************************
'函数名：Buffer()
'作  用：是否缓存输出
'参  数：NumStr
'返回值：1
'**************************************************
Function Buffer(NumStr)
    If NumStr=True then
	Response.Buffer = True 
	Response.Expires = -1
	Response.ExpiresAbsolute = Now() - 1 
	Response.Expires = 0 
	Response.CacheControl = "no-cache" 
    End if
End Function
'**************************************************
'函数名：encrypt()
'作  用：加密字符串
'参  数：ecode
'返回值：
'**************************************************
function encrypt(ecode)
	Dim texts
	dim i
	for i=1 to len(ecode)
	texts=texts & chr(asc(mid(ecode,i,1))+i)
	next
	encrypt = texts
	end function 
'**************************************************
'函数名：decrypt()
'作  用：解密字符串
'参  数：dcode
'返回值：
'**************************************************
function decrypt(dcode)	
  	dim texts
	dim i
	for i=1 to len(dcode)
		texts=texts & chr(asc(mid(dcode,i,1))-i)
	next
	decrypt=texts
end function 
'********************************************************
'检查是否外部提交数据
'********************************************************
Function ChkPost()
dim Server_v1,Server_v2
	ChkPost=False
	Server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
	Server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
	IF mid(Server_v1,8,len(Server_v2))<>Server_v2 then
		 ChkPost=False
	Else
		 ChkPost=True
	End IF	
End Function

'********************************************************
'过滤SQL非法字符并格式化html代码
'********************************************************
function Replace_Text(fString)
if isnull(fString) then
Replace_Text=""
exit function
else
fString=trim(fString)
fString=replace(fString,"'","''")
fString=replace(fString,";","；")
fString=replace(fString,"--","—")
fString=server.htmlencode(fString)
Replace_Text=fString
end if	
end function

'********************************************************
'判断是否为数字
'********************************************************
Function my_request(ParaName,ParaType)
  Dim ParaValue
  ParaValue=Request(ParaName)
  If ParaType=1 Then
    If Not isNumeric(ParaValue) Then
       response.write "非法操作"
	   response.End()
    end if
  Else
    ParaValue=replace(ParaValue,"'","''")
  End if
  my_request=ParaValue
End function
'********************************************************
'监测输入是否正确
'********************************************************
Function YesorNo(fString)
if fstring=1 or fstring=0 then
yesorno=true
else
yesorno=false
end if
End function

'********************************************************
'检测传递的参数是否为数字型 主要用于检测id
'********************************************************
Function Chkrequest(Para)
Chkrequest=False
If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then
   Chkrequest=True
End If
End Function

'********************************************************
'检测传递的参数是否为日期型
'********************************************************
Function Chkrequestdate(Para)
Chkrequestdate=False
If Not (IsNull(Para) Or Trim(Para)="" Or Not IsDate(Para)) Then
   Chkrequestdate=True
End If
End Function
'********************************************************
'转换IP   IP--LNG
'********************************************************
Function CLngIP(ByVal asNewIP)
Dim lnResults
Dim lnIndex
Dim lnIpAry
lnIpAry = Split(asNewIP, ".", 4)
For lnIndex = 0 To 3
If Not lnIndex = 3 Then
lnIpAry(lnIndex) = lnIpAry(lnIndex) * (256 ^ (3 - lnIndex))
End If
lnResults = lnResults + lnIpAry(lnIndex)
Next
CLngIP = lnResults
End Function 

'********************************************************
'转换IP   STR--IP
'********************************************************
Function CStrIP(ByVal anNewIP)
Dim lsResults
Dim lnTemp
Dim lnIndex

For lnIndex = 3 To 0 Step -1
lnTemp = Int(anNewIP / (256 ^ lnIndex))
lsResults = lsResults & lnTemp & "."
anNewIP = anNewIP - (lnTemp * (256 ^ lnIndex))
Next
lsResults = Left(lsResults, Len(lsResults) - 1)
CStrIP = lsResults
End Function
'********************************************************
'检测广告信息   网站机器人
'********************************************************
Function IsAdsContent(Str)
IsAdsContent=False
If Not IsNull(Str) Then
	If InStr(Str,"http://")>0 then IsAdsContent=True
	If InStr(Str,"QQ")>0 then IsAdsContent=True
	If InStr(Str,"qq")>0 then IsAdsContent=True
	If InStr(Str,"电话")>0 then IsAdsContent=True
	If InStr(Str,"@")>0 then IsAdsContent=True
	If InStr(Str,"www.")>0 then IsAdsContent=True
	If InStr(Str,".com")>0 then IsAdsContent=True
	If InStr(Str,".net")>0 then IsAdsContent=True
	If InStr(Str,".cn")>0 then IsAdsContent=True
End If
End Function
'********************************************************
'Email检测
'********************************************************
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

Function capitalization(tempstr) 
if left(tempstr,2)="一十" then
tempstr= "十" & right(tempstr,len(tempstr)-2)
end if
capitalization=tempstr
end Function

Function small(x)
Dim xlenght, xunit,xstr, x1, x2
xlenght=len(x)
if xlenght>8 then
x1=left(x,xlenght-8)
x2=right(x,8)
xunit="亿"
if small(x1)="" then
small=small(x2)
else
small=small(x1) & xunit & small(x2)
end if
elseif xlenght>4 then
x1=left(x,xlenght-4)
x2=right(x,4)
xunit="万"
if small(x1)="" then
small=small(x2)
else
small=small(x1) & xunit & small(x2)
end if
elseif xlenght=4 then
xstr=""
if int(left(x,1))=0 then
xstr=xstr & "零"
else 
xstr= xstr & CovNumber(left(x,1)) & "千"
end if
if int(mid(x,2,1))=0 then
xstr= xstr & "零"
else 
xstr= xstr & CovNumber(mid(x,2,1)) & "百"
end if
if int(mid(x,3,1))=0 then
xstr=xstr & "零"
else 
xstr=xstr & CovNumber(mid(x,3,1)) & "十"
end if
xstr=xstr & CovNumber(right(x,1))
while instr(xstr,"零零")>0 
xstr=replace(xstr,"零零","零")
wend
if xstr="零" then
xstr=""
elseif right(xstr,1)="零" then
xstr=left(xstr,len(xstr)-1)
end if
small=xstr
elseif xlenght=3 then
xstr=""
if int(left(x,1))=0 then
xstr=xstr & "零"
else 
xstr= xstr & CovNumber(left(x,1)) & "百"
end if
if int(mid(x,2,1))=0 then
xstr= xstr & "零"
else 
xstr=xstr & CovNumber(mid(x,2,1)) & "十"
end if 
xstr=xstr & CovNumber(right(x,1))
while instr(xstr,"零零")>0 
xstr=replace(xstr,"零零","零")
wend
if xstr="零" then
xstr=""
elseif right(xstr,1)="零" then
xstr=left(xstr,len(xstr)-1)
end if 
small=xstr

elseif xlenght=2 then
xstr=""
if int(left(x,1))=0 then
xstr=xstr & "零"
else 
xstr=xstr & CovNumber(left(x,1)) & "十"
end if 
xstr=xstr & CovNumber(right(x,1))
while instr(xstr,"零零")>0 
xstr=replace(xstr,"零零","零")
wend
if xstr="零" then
xstr=""
elseif right(xstr,1)="零" then
xstr=left(xstr,len(xstr)-1)
end if
small=xstr
elseif xlenght=1 then
if int(x)=0 then
xstr="零"
else
xstr=CovNumber(x)
end if
small=xstr 
end if 
End Function
Function CovNumber(x)
select case x
case "1"
CovNumber="一"
case "2"
CovNumber="二"
case "3"
CovNumber="三" 
case "4"
CovNumber="四"
case "5"
CovNumber="五"
case "6"