将远程服务器上的图片保存在本地空间

欢迎您访问我爱IT技术网，今天小编为你分享的电脑教程是网络协议方面的经验知识教程：将远程服务器上的图片保存在本地空间，下面是详细的分享！

将远程服务器上的图片保存在本地空间

修改savepost.asp文件

找到mysessiondata(37)=Content

改为

mysessiondata(37)=ReplaceRemoteUrl(Content)

如果希望是管理员才能有这权限，则修改为

if dvbbs.master then

mysessiondata(37)=ReplaceRemoteUrl(Content)

else

mysessiondata(37)=Content

end if

在文件的最后一行End Function后面增加

==================================================
过程名：ReplaceRemoteUrl
作 用：替换字符串中的远程文件为本地文件并保存远程文件
参 数：strContent ------ 要替换的字符串
==================================================
function ReplaceRemoteUrl(strContent)
if IsObjInstalled("Microsoft.XMLHTTP")=False then
ReplaceRemoteUrl=strContent
exit function
end if

dim re,RemoteFile,RemoteFileurl,SaveFileName,SaveFileType,arrSaveFileName,ranNum,PreviousFile/net,FormPath
FormPath=CheckFolder&CreatePath() 上传目录路径
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}(gif|jpg|png|bmp)))"
Set RemoteFile=re.Execute(strContent)
For Each RemoteFileurl in RemoteFile
arrSaveFileName=split(RemoteFileurl,".")
SaveFileType=arrSaveFileName(ubound(arrSaveFileName))
ranNum=int(900*rnd)+100
SaveFileName=FormPath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&SaveFileType
call SaveRemoteFile(SaveFileName,RemoteFileurl)
strContent=Replace(strContent,RemoteFileurl,SaveFileName)
if PreviousFile/net="" then
PreviousFile/net=SaveFileName
else
PreviousFile/net=PreviousFile/net & "|" & SaveFileName
end if
Next
ReplaceRemoteUrl=strContent
end function

==================================================
过程名：SaveRemoteFile
作 用：保存远程的文件到本地
参 数：LocalFileName ------ 本地文件名
RemoteFileUrl ------ 远程文件URL
==================================================
sub SaveRemoteFile(LocalFileName,RemoteFileUrl)
dim Ads,Retrieval,GetRemoteData
Set Retrieval=Server.CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", 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(LocalFileName),2
.Cancel()
.Close()
End With
Set Ads=nothing
end sub

**************************************************
函数名：IsObjInstalled
作 用：检查组件是否已经安装
参 数：strClassString ----组件名
返回值：True ----已经安装
False ----没有安装
**************************************************
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled=False
Err=0
Dim xTestObj
Set xTestObj=Server.CreateObject(strClassString)
If 0=Err Then IsObjInstalled=True
Set xTestObj=Nothing
Err=0
End Function

按月份自动明名上传文件夹,需要ＦＳＯ组件支持。
Function CreatePath()
Dim objFSO,Fsofolder,uploadpath
uploadpath=year(now)&"-"&month(now) 以年月创建上传文件夹，格式：2003－8
On Error Resume Next
Set objFSO=Server.CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(Server.MapPath(CheckFolder&uploadpath))=False Then
objFSO.CreateFolder Server.MapPath(CheckFolder&uploadpath)
End If
If Err.Number=0 Then
CreatePath=uploadpath&"/"
Else
CreatePath=""
End If
Set objFSO=Nothing
End Function

读取上传目录
Function CheckFolder()
If Dvbbs.Forum_Setting(76)="" Or Dvbbs.Forum_Setting(76)="0" Then Dvbbs.Forum_Setting(76)="UploadFile/"
CheckFolder=Replace(Replace(Dvbbs.Forum_Setting(76),Chr(0),""),".","")
在目录后加(/)
If Right(CheckFolder,1)<>"/" Then CheckFolder=CheckFolder&"/"
End Function

这一功能是参考动力文章系统修改而来，能将复制过来的网页上的图片，在发表的同时保存在自己的空间，在我自己论坛上测试成功。但是不敢确定这一修改方法是否会带来什么不良影响，请大家指正。

对于空间小的用户来讲，请不要使用或者只修改为管理员可以使用，否则，所有图片存入本地空间，空间容量将会承受不住。

以上就是关于将远程服务器上的图片保存在本地空间的网络协议知识分享，更多电脑教程请移步到>>电脑教程。