Asp获取字符串中的图片地址

 

' ===========================================================
' 获取字符串中的本地图片地址
' Typ 1 所有图片；2本地图片；3本地图片
' ===========================================================
Function  GetLocalPic_Url(str,Typ)
     Dim  Pic_Url,Temp_Url
     do   while  ContentInnerPicTF(str, " TF " )
        Temp_Url = ContentInnerPicTF(str, " PicUrl " )
        str = Replace (str,Temp_Url, "" )
        
         Select   Case  Typ
             Case   1
                Pic_Url = Pic_Url & " | " & Temp_Url
             Case   2
                 If   instr (Temp_Url, " http:// " ) = 0   then  Pic_Url = Pic_Url & " | " & Temp_Url
             Case   3
                 If   instr (Temp_Url, " http:// " ) <> 0   then  Pic_Url = Pic_Url & " | " & Temp_Url
         End   Select
        
         If   left ( trim (Pic_Url), 1 ) = " | "   then  Pic_Url = right (Pic_Url, len (Pic_Url) - 1 )
        
     loop
    GetLocalPic_Url = Pic_Url
End Function

 

Code
'===========================================================
'判断传入的字符传中是否包含本地图片并取得此图片地址
'===========================================================
Function ContentInnerPicTF(StrCon,ReturnTF)
    Dim ConStr,Re,InnerPicAll,FistPicUrl,PicUrlStr
    ConStr = StrCon & ""
    Set Re = New RegExp
    Re.IgnoreCase = True
    Re.Global = True
    Re.Pattern = "(src\S+\.{1}(gif|jpg|png)(""|\'|>|\s)?)"
    InnerPicAll = ""
    Set InnerPicAll = Re.Execute(ConStr)
    Set Re = Nothing
    
    FistPicUrl = ""
    
    For Each PicUrlStr in InnerPicAll
        FistPicUrl = Replace(Replace(Replace(PicUrlStr,"src=",""),"'",""),"""","")
        If LCase(Left(FistPicUrl,Len(sRootDir))) = LCase(sRootDir) Then
            FistPicUrl = Mid(FistPicUrl,Len(sRootDir)+1)
        End If
        Exit For
    Next
    
    If ReturnTF = "TF" Then
        If FistPicUrl <> "" And (Not IsNull(FistPicUrl)) then
            ContentInnerPicTF = True
        Else
            ContentInnerPicTF = False 
        End If
    ElseIf ReturnTF = "PicUrl" Then
        If FistPicUrl <> "" And (Not IsNull(FistPicUrl)) then
            ContentInnerPicTF = FistPicUrl
        End If
    End If     

End Function

转载于:https://www.cnblogs.com/chthp/archive/2008/10/06/1304717.html