CreateKeyWordasp实现的由给定的字符串生成关键字的代码

'**************************************************
'函数名：CreateKeyWord
'作  用：由给定的字符串生成关键字
'参  数：Constr---要生成关键字的原字符串
'返回值：生成的关键字
'**************************************************
Function CreateKeyWord(byval Constr,Num)
   If COnstr="" or IsNull(Constr)=True or COnstr="$False$" Then
      CreateKeyWord="$False$"
      Exit Function
   End If
   If Num="" or IsNumeric(Num)=False Then
      Num=2
   End If
   COnstr=Replace(Constr,CHR(32),"")
   COnstr=Replace(Constr,CHR(9),"")
   COnstr=Replace(Constr," ","")
   COnstr=Replace(Constr," ","")
   COnstr=Replace(Constr,"(","")
   COnstr=Replace(Constr,")","")
   COnstr=Replace(Constr,"<","")
   COnstr=Replace(Constr,">","")
   COnstr=Replace(Constr,"""","")
   COnstr=Replace(Constr,"?","")
   COnstr=Replace(Constr,"*","")
   COnstr=Replace(Constr,"|","")
   COnstr=Replace(Constr,",","")
   COnstr=Replace(Constr,".","")
   COnstr=Replace(Constr,"/","")
   COnstr=Replace(Constr,"\","")
   COnstr=Replace(Constr,"-","")
   COnstr=Replace(Constr,"@","")
   COnstr=Replace(Constr,"#","")
   COnstr=Replace(Constr,"$","")
   COnstr=Replace(Constr,"%","")
   COnstr=Replace(Constr,"&","")
   COnstr=Replace(Constr,"+","")
   COnstr=Replace(Constr,":","")
   COnstr=Replace(Constr,"：","")   
   COnstr=Replace(Constr,"‘","")
   COnstr=Replace(Constr,"“","")
   COnstr=Replace(Constr,"”","")
   COnstr=Replace(Constr,"&","")  
   COnstr=Replace(Constr,"gt;","")      
   Dim i,ConstrTemp
   For i=1 To Len(Constr)
      COnstrTemp=ConstrTemp & "|" & Mid(Constr,i,Num)
   Next
   If Len(ConstrTemp)<254 Then
      COnstrTemp=ConstrTemp & "|"
   Else
      COnstrTemp=Left(ConstrTemp,254) & "|"
   End If
   COnstrTemp=left(ConstrTemp,len(ConstrTemp)-1)
   COnstrTemp= Right(ConstrTemp,len(ConstrTemp)-1)
   CreateKeyWord=ConstrTemp
End Function 内容推荐：免费高清PNG素材下载