ASP开发中有用的函数（function）集合(3)

  
'*************************************   
'计算随机数   
'*************************************   
function randomStr(intLength)   
    dim strSeed,seedLength,pos,str,i   
    strSeed = "abcdefghijklmnopqrstuvwxyz1234567890"  
    seedLength=len(strSeed)   
    str=""  
    Randomize   
    for i=1 to intLength   
     str=str+mid(strSeed,int(seedLength*rnd)+1,1)   
    next   
    randomStr=str   
end function   
  
'*************************************   
'自动闭合UBB   
'*************************************    字串9
function closeUBB(strContent)   
  dim arrTags,i,OpenPos,ClosePos,re,strMatchs,j,Match   
    Set re=new RegExp   
    re.IgnoreCase =True  
    re.Global=True  
    arrTags=array("code","quote","list","color","align","font","size","b","i","u","html")   
  for i=0 to ubound(arrTags)   
   OpenPos=0   
   ClosePos=0   
      
   re.Pattern="\["+arrTags(i)+"(=[^\[\]]+|)\]"  
   Set strMatchs=re.Execute(strContent)   
   For Each Match in strMatchs   
    OpenPos=OpenPos+1   

字串6

   next   
   re.Pattern="\[/"+arrTags(i)+"\]"  
   Set strMatchs=re.Execute(strContent)   
   For Each Match in strMatchs   
    ClosePos=ClosePos+1   
   next   
   for j=1 to OpenPos-ClosePos   
      strContent=strContent+"[/"+arrTags(i)+"]"  
   next   
  next   
closeUBB=strContent   
end function   
  
'*************************************   
'自动闭合HTML   
'*************************************   
function closeHTML(strContent)   
  dim arrTags,i,OpenPos,ClosePos,re,strMatchs,j,Match   
    Set re=new RegExp   
    re.IgnoreCase =True  
    re.Global=True  
    arrTags=array("p","div","span","table","ul","font","b","u","i","h1","h2","h3","h4","h5","h6")   
  for i=0 to ubound(arrTags)   
   OpenPos=0   
   ClosePos=0   
      
   re.Pattern="\<"+arrTags(i)+"( [^\<\>]+|)\>"  
   Set strMatchs=re.Execute(strContent)   
   For Each Match in strMatchs   
    OpenPos=OpenPos+1   
   next   
   re.Pattern="\</"+arrTags(i)+"\>"   月落网
   Set strMatchs=re.Execute(strContent)   
   For Each Match in strMatchs   
    ClosePos=ClosePos+1   
   next   
   for j=1 to OpenPos-ClosePos   
      strContent=strContent+"</"+arrTags(i)+">"  
   next   
  next   
closeHTML=strContent   
end function   
  
'*************************************   
'读取文件   
'*************************************   
Function LoadFromFile(ByVal File)   
    Dim objStream   
    Dim RText   
    RText=array(0,"")   
    On Error Resume Next   字串5
    Set objStream = Server.CreateObject("ADODB.Stream")   
    If Err Then    
        RText=array(Err.Number,Err.Description)   
        LoadFromFile=RText   
        Err.Clear   
        exit function   
    End If  
    With objStream   
        .Type = 2   
        .Mode = 3   
        .Open   
        .Charset = "utf-8"  
        .Position = objStream.Size   

字串5

        .LoadFromFile Server.MapPath(File)   
        If Err.Number<>0 Then  
           RText=array(Err.Number,Err.Description)   
           LoadFromFile=RText   
           Err.Clear   
           exit function   
        End If  
        RText=array(0,.ReadText)   
        .Close   
    End With  
    LoadFromFile=RText   
    Set objStream = Nothing  
End Function   月落网
  
'*************************************   
'保存文件   
'*************************************   
Function SaveToFile(ByVal strBody,ByVal File)   
    Dim objStream   
    Dim RText   
    RText=array(0,"")   
    On Error Resume Next  
    Set objStream = Server.CreateObject("ADODB.Stream")   
    If Err Then    
        RText=array(Err.Number,Err.Description)   
        Err.Clear   
        exit function   
    End If  
    With objStream   
        .Type = 2    www.yueluo.net
        .Open   
        .Charset = "utf-8"  
        .Position = objStream.Size   
        .WriteText = strBody   
        .SaveToFile Server.MapPath(File),2   
        .Close   
    End With  
    RText=array(0,"保存文件成功!")   
    SaveToFile=RText   
    Set objStream = Nothing  
End Function  
  
'*************************************   
'数据库添加修改操作   
'*************************************   
function DBQuest(table,DBArray,Action)    字串8
 dim AddCount,TempDB,i,v   
 if Action<>"insert" or Action<>"update" then Action="insert"  
 if Action="insert" then v=2 else v=3   
 if not IsArray(DBArray) then   
   DBQuest=-1   
   exit function   
 else   
   Set TempDB=Server.CreateObject("ADODB.RecordSet")   
   On Error Resume Next  
   TempDB.Open table,Conn,1,v   
   if err then   
    DBQuest=-2   
    exit function   
   end if   
   if Action="insert" then TempDB.addNew   
   AddCount=UBound(DBArray,1)   
   for i=0 to AddCount    字串6
    TempDB(DBArray(i)(0))=DBArray(i)(1)   
   next   
   TempDB.update   
   TempDB.close   
   set TempDB=nothing   
   DBQuest=0   
 end if   
end Function  
共3页: 上一页 [1] 2 [3] 下一页