ASP

下载远程文件保存到本地过程

作者:JTee 日期:2009-10-25 14:31:03

字体大小: 小 中 大

分享一段过程，这过程是我最近做网站时用到的。还挺好用的，特来分享给大家！

废话不多说，直接上代码

ASP/Visual Basic 代码
 
  1. <%   
  2. '**************************************************   
  3.     '函数名：SaveBeyondFile   
  4.     '作  用：保存远程文件到本地   
  5.     '参  数：LocalFile 本地文件,BFU远程文件   
  6.     '返回值：无   
  7.     '**************************************************   
  8.     Public Function ReplaceBeyondUrl(ReplaceContent, SaveFilePath)   
  9.         Dim re, BeyondFile, BFU, SaveFileName,SaveFileList   
  10.         Set re = New RegExp   
  11.         re.IgnoreCase = True  
  12.         re.Global = True  
  13.         re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}((\w)+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(gif|jpg|png|bmp)))"  
  14.         Set BeyondFile = re.Execute(ReplaceContent)   
  15.         Set re = Nothing  
  16.         For Each BFU In BeyondFile   
  17.           If Instr(SaveFileList,BFU)=0 Then  
  18.             SaveFileName = Year(Now()) & Month(Now()) & Day(Now()) & MakeRandom(10) & Mid(BFU, InStrRev(BFU, "."))   
  19.             If Instr(BFU,"http://localhost")<=0 Then  
  20.                 'FsoBegin()   
  21.                 'If FsoIsTrue("dir",SaveFilePath)=False Then '检测本机文件夹是否存在   
  22.                  '  CreFolder(SaveFilePath)'如果不存在创建文件夹   
  23.                 'End If    
  24.                ' FsoEnd()   
  25.             Call SaveBeyondFile(SaveFilePath&SaveFileName,BFU)   
  26.             'ReplaceContent = Replace(ReplaceContent, BFU, "http://localhost" & SaveFilePath & SaveFileName)   
  27.             ReplaceContent = SaveFilePath & SaveFileName   
  28.             End If  
  29.           End If  
  30.            SaveFileList=SaveFileList & "," & BFU   
  31.         Next  
  32.         ReplaceBeyondUrl = ReplaceContent   
  33.     End Function  
  34.   
  35.     '==================================================   
  36.     '过程名：SaveBeyondFile   
  37.     '作  用：保存远程的文件到本地   
  38.     '参  数：LocalFileName ------ 本地文件名   
  39.     '参  数：RemoteFileUrl ------ 远程文件URL   
  40.     '==================================================   
  41.     Function SaveBeyondFile(LocalFileName,RemoteFileUrl)   
  42.         on error resume next   
  43.         Dim SaveRemoteFile:SaveRemoteFile=True  
  44.         dim Ads,Retrieval,GetRemoteData   
  45.         Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")   
  46.         With Retrieval   
  47.             .Open "Get", RemoteFileUrl, False, "", ""  
  48.             .Send   
  49.             If .Readystate<>4 then   
  50.                 SaveRemoteFile=False  
  51.                 Exit Function  
  52.             End If  
  53.             GetRemoteData = .ResponseBody   
  54.         End With  
  55.         Set Retrieval = Nothing  
  56.         Set Ads = Server.CreateObject("Adodb.Stream")   
  57.         With Ads   
  58.             .Type = 1   
  59.             .Open   
  60.             .Write GetRemoteData   
  61.             .SaveToFile server.MapPath(LocalFileName),2   
  62.             .Cancel()   
  63.             .Close()   
  64.         End With  
  65.         Set Ads=nothing   
  66.         SaveBeyondFile=SaveRemoteFile   
  67.         '加水印   
  68.         '此处可以引用个添加水印的过程   
  69.     end Function  
  70. %>  

 



文章来自: 本站原创
引用通告地址: http://www.5w5w.net/trackback.aspx?id=81
Tags: 下载 远程 文件 保存 本地 过程
评论: 0 | 引用: 0 | 查看次数: 615 | 返回顶部
发表评论
昵　称:  
验证码:  
内　容: