char.inc

一套很早的多用户电子商务程序

<%
  ' file char.inc 中文处理函数

   const iis3onchsys=false
   const TIME_ADJUST=0  'hour    '如果服务器远在海外，用于调整帖子加贴时间（调整为北京时间），其值您自定

   function isInteger(para)
       dim str
       dim l,i
       if isNUll(para) then 
          isInteger=false
          exit function
       end if
       str=cstr(para)
       if trim(str)="" then
          isInteger=false
          exit function
       end if
       l=len(str)
       for i=1 to l
           if mid(str,i,1)>"9" or mid(str,i,1)<"0" then
              isInteger=false 
              exit function
           end if
       next
       isInteger=true
   end function

   Function HTMLCharacter(ByVal str)
        dim strHTML
        dim nLen,i,j,k,strC
        strHTML = ""
        nLen = Len(str)

        j = 0
        i = 0
        k = 1
        Do While (i < nLen)
          strC = Mid(str, k, 1)
          If (Asc(strC) < 0) Or (Asc(strC) > 127) Then
             j = j + 1
             i = i + 1
          End If
          i = i + 1
          k = k + 1
        Loop

        nLen = nLen - j

        For i = 1 To nLen
                strC = Mid(str, i, 1)
                If Asc(strC) >= 128 Then
                        strHTML = strHTML + "&#" + CStr(Asc(strC)) + ";"
                Else
                        strHTML = strHTML + strC
                End If
        Next
        HTMLCharacter = strHTML
   End Function

   function htmlencode(str)
    dim result
    dim l
    if isNULL(str) then 
       htmlencode=""
       exit function
    end if
    l=len(str)
    result=""
	dim i
	for i = 1 to l
	    select case mid(str,i,1)
	           case "<"
	                result=result+"&lt;"
	           case ">"
	                result=result+"&gt;"
	           case chr(34)
	                result=result+"&quot;"
	           case "&"
	                result=result+"&amp;"
	           case chr(13)
	                result=result+"<br>"
	           case chr(9)
	                result=result+"&nbsp;&nbsp;&nbsp;&nbsp;"
	           case chr(32)	           
	                'result=result+"&nbsp;"
	                if i+1<=l and i-1>0 then
	                   if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9)  then	                      
	                      result=result+"&nbsp;"
	                   else
	                      result=result+" "
	                   end if
	                else
	                   result=result+"&nbsp;"	                    
	                end if
	           case else
	                result=result+mid(str,i,1)
         end select
       next 
       htmlencode=result
   end function

   function htmlencode2(str)
    dim result
    dim l
    if isNULL(str) then 
       htmlencode2=""
       exit function
    end if
    l=len(str)
    result=""
	dim i
	for i = 1 to l
	    select case mid(str,i,1)
	           case "<"
	                result=result+"&lt;"
	           case ">"
	                result=result+"&gt;"
	           case chr(34)
	                result=result+"&quot;"
	           case "&"
	                result=result+"&amp;"
	           case chr(9)
	                result=result+"    "
	           case else
	                result=result+mid(str,i,1)
         end select
       next 
       htmlencode2=result
   end function


   sub ShowBody(Str)
    dim result
    dim l    
    l=len(str)
    result=""
    dim i
    for i = 1 to l
    select case mid(str,i,1)
               case chr(32)	           '处理空格符
                        if i+1<=l and i-1>0 then
                           if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9)  then
                              result=result+"&nbsp;"
                           else
                              result=result+" "
                           end if
                        else
                           result=result+"&nbsp;"	                    
                        end if
               case chr(9)                        '处理空格符
                        result=result+"&nbsp;&nbsp;&nbsp;&nbsp;"
               case chr(13)                      '处理回车符
                        result=result+"<br>"
               case else
                        result=result+mid(str,i,1)
    end select
    next 
       response.write result
   end sub

   sub display(str)
     if not isNULL(str) then 
           showbody str
     end if
   end sub


%>