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

 

'判断传入的字符传中是否包含本地图片并取得此图片地址
'===========================================================
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