'远程存图函数
Function ReplaceRemoteUrl(t0,t1,t2,t3,t4)
 ddp_upfiledir="upload/"
 't0是内容。
 't1为限制文件大小,为0时不限制
 't2为限制的文件类型
 't3为是否水印,只有系统开启水印才生效
 't4用户id，考虑到安全，为空不允许上传。
 If t4="" Or Not IsNumeric(t4) Then
  ReplaceRemoteUrl = sHtml
  Exit Function
 End If
 sHtml = t0
 IF t2="" Then t2="gif|jpg|png|bmp"
 t6=ddp_upfiledir&Year(Now())&Right("0"&Month(Now()),2)&"/"

 Set objRegExp = New Regexp'设置配置对象 
 objRegExp.IgnoreCase = True'忽略大小写 
 objRegExp.Global = True'设置为全文搜索 
 objRegExp.Pattern = "\[img.*?\]http://([\s\S]*?)\[\/img\]"

 sHtml=trim(sHtml) 
 Set Matches =objRegExp.Execute(sHtml)'开始执行配置 
 baseUrl = "http://" & Request.ServerVariables("HTTP_HOST")
 For Each Match in Matches
 tPicUrl=""
 tPicUrl=Match.submatches(0)
 If tPicUrl<>"" Then
  tPicUrl="http://"&tPicUrl
  If InStr(RetStr,tPicUrl)=0 Then '去掉重复的。
   If InStr (tPicUrl,baseUrl)=0 Then '去掉本地的。
    RetStr = RetStr &tPicUrl&"||"
    SaveFileType = Mid(tPicUrl, InstrRev(tPicUrl, ".") + 1)
     '是否允许远程存图的格式。
    If InStr(t2,SaveFileType)>0 Then
     isSave=True
    Else
     isSave=False
     ReplaceRemoteUrl = sHtml
     Exit Function
    End If
    '获取大小
    'ReplaceRemoteUrl=tPicUrl

    Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    oXMLHTTP.open "GET",tPicUrl,False
    oXMLHTTP.send
    GetRemoteData=oXMLHTTP.responsebody
    Set oXMLHTTP=Nothing

    '判断大小
    IF Clng(t1)>0 Then
     If Clng(t1)>Clng(Round(LenB(GetRemoteData)/1024)) Then
      isSave=True
     Else
      isSave=False
      ReplaceRemoteUrl = sHtml
      Exit Function
     End If
    End If
    If isSave Then
     Randomize
     sRnd = Int(9000 * Rnd) + 1000
     '重新命名图片
     SaveFileName = DateToStr(Now(), "YmdHIS")&sRnd&"_"&t4&"."&SaveFileType
     '保存图片
     Set Ads=Server.CreateObject("a"&"do"&"db"&"."&"s"&"t"&"r"&"ea"&"m")
     With Ads
      .Type = 1
      .Open
      .Write GetRemoteData
      .SaveToFile Server.MapPath(t6&SaveFileName), 2
      .Cancel()
      .Close()
     End With
     Set Ads=Nothing
     If Err.Number=0 Then sHtml=replace(sHtml,tPicUrl,t6&SaveFileName)
    End If
   End If
  End If
 End If
 Next 
 ReplaceRemoteUrl = sHtml
End Function