function.asp

电子商城代码

'****  End   *************************************************************************************************************************


'检测用户名的合法性
'****  Start  ************************************************************************************************************************
Public function check_name(str)
check_name=true
if Instr(str,"=")>0  or Instr(str,"%")>0 or Instr(str,"?")>0 or Instr(str,"&")>0 or Instr(str,";")>0 or Instr(str,",")>0  or Instr(str,"'")>0 or Instr(str,".")>0 or Instr(str,"$")>0 or Instr(str,chr(255))>0 or Instr(str,":") or instr(str,"|")>0  or instr(str,"#")>0 or instr(str,"\")>0 or instr(str,"(")>0 or instr(str,"[")>0 or instr(str,"-")>0 or instr(str,"~") then
check_name=false
end if
end function

'****  End   *************************************************************************************************************************


'小数处理
'****  Start  ************************************************************************************************************************
Public function formatnumber2(num)
	    num = formatnumber(num,2)
	    if num <1 then 
	            num= 0&num
	            num = replace(num,"00.","0.")	
	    end if
	    formatnumber2 = num
end Function
'****  End   *************************************************************************************************************************

'****  Start  ************************************************************************************************************************
Public function outhtml(fString)
		fString=replace(fString,";","&#59;")
		fString=replace(fString,"<","&lt;")
		fString=replace(fString,">","&gt;")
		fString=replace(fString,"\","&#92;")
		fString=replace(fString,"--","&#45;&#45;")
		fString=replace(fString,"'","&#39;")
		fString=replace(fString,CHR(34),"&quot;")
		fString=replace(fString,vbCrlf,"<br>")
		Safereplace=fString
end Function
'****  End   *************************************************************************************************************************

'****  Start  ************************************************************************************************************************
Public Function ChkLoginIP(AcceptIP,ChkIp)
		Dim i,LoginIP,TempIP
		ChkLoginIP = False
		If Instr("|"&AcceptIP&"|","|"&ChkIp&"|") Then ChkLoginIP = True : Exit Function
		LoginIP = Split(ChkIp,".")
		TempIP = LoginIP(0)&"."&LoginIP(1)&"."&LoginIP(2)&".*"
		If Instr("|"&AcceptIP&"|","|"&TempIP&"|") Then ChkLoginIP = True : Exit Function
		TempIP = LoginIP(0)&"."&LoginIP(1)&".*.*"
		If Instr("|"&AcceptIP&"|","|"&TempIP&"|") Then ChkLoginIP = True : Exit Function
		TempIP = LoginIP(0)&".*.*.*"
		If Instr("|"&AcceptIP&"|","|"&TempIP&"|") Then ChkLoginIP = True : Exit Function
End Function
'****  End   *************************************************************************************************************************


'判断会员等级 取得等级名称
'****  Start  ************************************************************************************************************************
Public function user_grade(str)
		select case str
				Case 1 strgrade=gradename1
				Case 2 strgrade=gradename2
				Case 3 strgrade=gradename3
		end select
		response.write strgrade
end function
'****  End   *************************************************************************************************************************

Public function judge(a,b)
  dim res 
  if instr(a,b)>0 then
   res ="checked"
  end if
  judge = res
end Function

'处理商品节省价格为负值的情况 2005-12-22 by 56770.kingdge
'****  Start  ************************************************************************************************************************
Public function js_price(str,str1)
        Dim str2 
		str2=formatnumber2(str1-str)
		If Left(str2,2)="0-" Then
		         str2=formatnumber2(str-str1)
        End If 
		js_price=str2
end function
'****  End   *************************************************************************************************************************

'价格首位数字体放大 2005-12-22 by 56770.kingdge
'****  Start  ************************************************************************************************************************
Public function font_price(str)
        Dim str_1,str_2
        str_1=Left(formatnumber2(str),1)
		str_2=Right(formatnumber2(str),Len(formatnumber2(str))-1)
		str="<font size=4px color=red>"&str_1&"</font><font size=2px>"&str_2&"</font>"
		font_price=str
end function
'****  End   *************************************************************************************************************************

'图片按比例缩放函数 2006-1-18 56770.kingdge
'****  Start  ************************************************************************************************************************
Public Function showpicsize(str,str1,str2)
       'On Error Resume Next 
       If str="" Then 
	   showpicsize="0|||0"
	   Exit Function 
	   End If 
	   real_width=qhd_56770.readX(Server.mappath(str))
	   real_height=qhd_56770.readY(Server.mappath(str))
	        If CInt(real_width)>=CInt(str1) And CInt(real_height)>=CInt(str2) Then 
			       If real_width>real_height Then 
	                     str_1=CInt(real_width*(str1/real_width))
	                     str_2=CInt(real_height*(str1/real_width))
				   Else
				   	     str_1=CInt(real_width*(str2/real_height))
	                     str_2=CInt(real_height*(str2/real_height))
				   End If 
	        ElseIf CInt(real_width)>=CInt(str1) And CInt(real_height)<=CInt(str2) Then 
	             str_1=CInt(real_width*(str1/real_width))
	             str_2=CInt(real_height*(str1/real_width))
		    ElseIf CInt(real_width)<=CInt(str1) And CInt(real_height)>=CInt(str2) Then 
	             str_1=CInt(real_width*(str2/real_height))
	             str_2=CInt(real_height*(str2/real_height))
		    Else
	             str_1=CInt(real_width)
	             str_2=CInt(real_height)
			End If 
	   showpicsize=str_1&"|||"&str_2
End Function 
'****  End   *************************************************************************************************************************
rem 截取字符串长度函数 
rem UTF-8编码下 截取中英文混排长度
rem 2006-1-27 56770.kingdge
rem 2006-2-3 修正 56770.kingdge
Public Function cutchar(str,num)
    If str="" Then 
	     cutchar=""
		 Exit Function 
	End If 
    Dim c_num,c_s,c_ss,c_s_num,cs_num,ct_num,ct_c_num,str_cs_num
	c_num=Len(str)
	c_s="0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,-,_,%,#,@,),(,*"
	c_ss=Split(c_s,",")
	If c_num>num Then 
		For i = 0 To UBound(c_ss)
	    	c_s_num=num-Len(replace(left(ucase(str),num),""&c_ss(i)&"",""))
			cs_num=CLng(cs_num+c_s_num)
            
			If c_num>cs_num Then 
			     ct_num=cs_num+num-Len(replace(left(ucase(str),num+cs_num),""&c_ss(i)&"",""))
				 rem 计算多出的字符中上述字符的数量
				 ct_c_num=CLng(ct_c_num+ct_num)
			End If 
		Next 
		If ct_c_num=cs_num Then 
	     	 str_cs_num=(cs_num/2)+num
		ElseIf cs_num=num Then 
		     str_cs_num=num*2
    	Else 
		 	 str_cs_num=cs_num+num
		End If 
		If c_num>num And c_num>str_cs_num Then 
		     cutchar=Left(str,str_cs_num)&".."
		Else
		     cutchar=Left(str,str_cs_num)
	    End If 
	Else
		cutchar=str
	End If 
End Function 

rem 日期格式化函数
rem 2006-2-3 56770.kingdge
Public Function sort_date(str,str1)
       If str="" Then 
	        Exit Function 
	   End If 
	   news_year=year(str)
       news_month=month(str)
       If Len(news_month)=1 Then news_month="0"&news_month
       news_day=day(str)
       If Len(news_day)=1 Then news_day="0"&news_day
	   If str1=0 Then 
       sort_date=news_month&"-"&news_day
	   Else
	   sort_date=news_year&"-"&news_month&"-"&news_day
	   End If 
End Function 

Public Function connerror
        
End Function 

rem 取一个字符串在一个数组中的位置
rem 2006-2-12 56770.kingdge
Function online_num(str,str1)
        If str="" Then 
		      Exit Function 
		End If 
		B=Split(str1,":")
		For I = 0 To UBound(B)
		If InStr(B(i),STR)>0 Then
		 online_num=i
		End If 
		Next 
End Function 

rem 去掉最后一位
rem 2006-2-13 56770.kingdge
Function cut_Right(str)
        If str="" Then 
		       Exit Function 
	    End If 
        cut_Right=Left(str,(Len(str)-1))
End Function 

%>