<%
Server.ScriptTimeOut = 1000
'远程图片保存允许类型
Const ttkj_FileExt="jpg|gif|bmp|png"
'*****************************************************
'函数功能：保存远程文件并替换字符串中的远程文件地址为本地
'参数：
'      ttkj_HTML         : 要替换的字符串
'      ttkj_SaveFilePath : 保存文件的路径
'      ttkj_AspJpeg      : 是否给图片加水印，1加水印，0不加   
'*****************************************************
Function ReplaceRemoteUrl(ttkj_HTML,ttkj_SaveFilePath,ttkj_AspJpeg)
     Dim ttkj_Content
     ttkj_Content = ttkj_HTML
     If IsObjInstalled("Microsoft"&".XMLHTTP") = False then
         ReplaceRemoteUrl = ttkj_Content
         Exit Function
     End If     
     Dim re,RemoteFile,RemoteFileurl,SaveFileName,SaveFileType,arrSaveFileNameS,arrSaveFileName,ranNum,dtNow
     Set re = new RegExp
     re.IgnoreCase = True
     re.Global = True
     re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}((\w)+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(" & ttkj_FileExt & ")))"
     Set RemoteFile = re.Execute(ttkj_Content)
     For Each RemoteFileurl in RemoteFile
		 arrSaveFileName = Split(RemoteFileurl,".")
  		 SaveFileType=arrSaveFileName(UBound(arrSaveFileName))
		 dtNow=Now()
		 randomize
		 ranNum=int(90000*rnd)+10000
		 arrSaveFileName=year(dtNow) & right("0" & month(dtNow),2) & right("0" & day(dtNow),2) & right("0" & hour(dtNow),2) & right("0" & minute(dtNow),2) & right("0" & second(dtNow),2) & ranNum&"."&SaveFileType
         SaveFileName = ttkj_SaveFilePath & arrSaveFileName
         Call SaveRemoteFile(SaveFileName,RemoteFileurl)
		 
		 '给远程图片加水印		 
		  If Watermark_Type>0 And ttkj_AspJpeg=1 then
		 	Call PicAspJpeg(SaveFileName)
		  End If

         ttkj_Content = Replace(ttkj_Content,RemoteFileurl,SaveFileName)
     Next
     ReplaceRemoteUrl = ttkj_Content
End Function

'*********************************************
'函数功能：操作保存远程的文件到本地
'参 数：
'       ttkj_LocalFileName：本地文件名
'       ttkj_RemoteFileUrl：远程文件URL
'返回值：
'True   成功
'False  失败
'*********************************************
Sub SaveRemoteFile(ttkj_LocalFileName,ttkj_RemoteFileUrl)
     Dim Ads, Retrieval, GetRemoteData
     On Error Resume Next
     Set Retrieval = Server.CreateObject("Microsoft"&".XMLHTTP")
     With Retrieval
         .Open "Get",ttkj_RemoteFileUrl,False,"",""
         .Send
         GetRemoteData = .ResponseBody
     End With
     Set Retrieval = Nothing
     Set Ads = Server.CreateObject("Adodb"&".Stream")
     With Ads
         .Type = 1
         .Open
         .Write GetRemoteData
         .SaveToFile Server.MapPath(ttkj_LocalFileName),2
         .Cancel()
         .Close()
     End With
     Set Ads=nothing
End Sub
%>