实例为最新版本的。进入demo查看示例,可以调用,带图片上传自动添加水印功能。
<% Const sFileExt="jpg|gif|bmp|png" Function ReplaceRemoteUrl(sHTML, sSaveFilePath, sFileExt) Dim s_Content s_Content = sHTML If IsObjInstalled("Microsof" & "t.X" & "MLHTTP") = False then ReplaceRemoteUrl = s_Content Exit Function End If Dim re, RemoteFile, RemoteFileurl,SaveFileName,SaveFileType,arrSaveFileNameS,arrSaveFileName,sSaveFilePaths 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}(" & sFileExt & ")))" Set RemoteFile = re.Execute(s_Content) For Each RemoteFileurl in RemoteFile arrSaveFileName = Split(RemoteFileurl,".") SaveFileType=arrSaveFileName(UBound(arrSaveFileName)) RanNum=Int(900*Rnd)+100 arrSaveFileName = Year(Now()) & Right("0" & Month(Now()),2)& Right("0" & Day(Now()),2) & Right("0" & Hour(Now()),2) & Right("0" & Minute(Now()),2) & Right("0" & Second(Now()),2) &ranNum&"."&SaveFileType sSaveFilePaths= sSaveFilePath SaveFileName = sSaveFilePaths & arrSaveFileName if SaveRemoteFile(""&SaveFileName&"",""&RemoteFileurl&"") then response.Write ""&SaveFileName&" 图片保存成功. <br />" s_Content = Replace(s_Content,RemoteFileurl,SaveFileName) else Response.write ""&RemoteFileurl&" 图片保存<font color='#FF0000'>失败</font>.<br />" end if Next ReplaceRemoteUrl = s_Content End Function function SaveRemoteFile(s_LocalFileName,s_RemoteFileUrl) Dim Ads, Retrieval, GetRemoteData On Error Resume Next Set Retrieval = Server.CreateObject("Microso" & "ft.XM" & "LHTTP") With Retrieval .Open "Get", s_RemoteFileUrl, False, "", "" .Send GetRemoteData = .ResponseBody End With Set Retrieval = Nothing Set Ads = Server.CreateObject("Ado" & "db.Str" & "eam") With Ads .Type = 1 .Open .Write GetRemoteData .SaveToFile Server.MapPath(s_LocalFileName), 2 .Cancel() .Close() End With Set Ads=nothing if err <> 0 then SaveRemoteFile = false err.clear else SaveRemoteFile = true end if End Function Function IsObjInstalled(s_ClassString) On Error Resume Next IsObjInstalled = False Err = 0 Dim xTestObj Set xTestObj = Server.CreateObject(s_ClassString) If 0 = Err Then IsObjInstalled = True Set xTestObj = Nothing Err = 0 End Function %> 在编辑框下加入代码: <input name="sSaveFileSelect" type="checkbox" id="sSaveFileSelect" value="1">保存远程图片到本地 提交保存代码: <% sSaveFileSelect=request.Form("sSaveFileSelect") sub_content=request.form("content") if sSaveFileSelect=1 then Set fso=Server.CreateObject("Scripting.FileSystemObject") yy=right(year(date),4) mm=right("00"&month(date),2) dd=right("00"&day(date),2) uploaddate=yy&mm&dd uploadpath="../uploadfiles/image/"&uploaddate&"/" If Not fso.FolderExists(Server.mappath(uploadpath)) Then fso.CreateFolder(Server.mappath(uploadpath)) End If content=ReplaceRemoteUrl(sub_content,uploadpath,sFileExt) else content=sub_content end if %>