用asp+xmlhttp编写web采集程序(4)

    re.Pattern = "((http):(?:\/\/){1}(?:(?:\w)+[.])+(net|com|cn|org|cc|tv|[0-9]{1,4})(\S*\/)((?:\S)+[.]{1}(gif|jpg|jpeg|png|bmp)))"

    Set RemoteFile = re.Execute(sContent)

    Dim SaveFileName
    'RemoteFile     正则表达式Match对象的集合
    'RemoteFileUrl  正则表达式Match对象
    For Each RemoteFileUrl in RemoteFile
        SaveFileName = RemoteFileUrl.SubMatches(4)
        Call Save2File(myHttpGet(RemoteFileUrl,False),sSavePath&"/"&SaveFileName,False,True)
        sContent=Replace(sContent,RemoteFileUrl,sPreceding&SaveFileName)
    Next

    ProcessRemoteUrl=sContent
End Function 
改进：探测真实URL
上面的ProcessRemoteUrl函数不能正确处理形如<img src="upload/abc.jpg" />和<a href="/upload/abc.gif" ...的内容，要处理这些相对链接，我们可以先用下面的函数把网页中的相对链接都转换成绝对链接
'函数： DetectUrl
'功能： 替换字符串中的远程文件相对路径为以http://..开头的绝对路径
'参数： sContent    要处理的含相对路径的网页的文本内容
'       sUrl        所处理的远程网页自身的URL，用于分析相对路径
'返回： 替换相对链接为绝对链接之后的新的网页文本内容
Function DetectUrl(sContent,sUrl)
    Call D("DetectUrl:"&sUrl)

    '分析URL
    Dim re,sMatch
    Set re=new RegExp
    re.Multiline=True
    re.IgnoreCase =true
    re.Global=True

    re.Pattern = "(http://[-A-Z0-9.]+)/[-A-Z0-9+&@#%~_|!:,.;/]+/"
    Dim sHost,sPath
    'http://localhost/get/sample.asp
    Set sMatch=re.Execute(sUrl)
    'http://localhost
    sHost=sMatch(0).SubMatches(0)
    'http://localhost/get/
    sPath=sMatch(0)

    re.Pattern = "(src|href)=""?((?!http://)[-A-Z0-9+&@#%=~_|!:,.;/]+)""?"
    Set RemoteFile = re.Execute(sContent)

    'RemoteFile 正则表达式Match对象的集合
    'RemoteFileUrl 正则表达式Match对象,形如src="Upload/a.jpg"