由本站酷站领地提供的过程代码
<%
'==============================
'创建多级目录，可以创建不存在的根目录
'参数：要创建的目录名称，可以是多级
'创建目录的根目录从当前目录开始
'支持相对路径和绝对路径
'''调用举例
''Call CreateMultiFolder("d:\t/upload/jumbot/myphoto/")
''Call CreateMultiFolder("/upload/jumbot/myphoto/")
'==============================
Function CreateMultiFolder(ByVal CFolder)
Dim objFSO, PhCreateFolder, CreateFolderArray, CreateFolder
Dim i, ii, CreateFolderSub, PhCreateFolderSub, BlInfo
BlInfo = False
CreateFolder = CFolder
On Error Resume Next
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If Err Then
Err.Clear()
Exit Function
End If
If Right(CreateFolder, 1) = "/" Then
CreateFolder = Left(CreateFolder, Len(CreateFolder) -1)
End If
CreateFolderArray = Split(CreateFolder, "/")
For i = 0 To UBound(CreateFolderArray)
CreateFolderSub = ""
For ii = 0 To i
CreateFolderSub = CreateFolderSub & CreateFolderArray(ii) & "/"
Next
PhCreateFolderSub = Server.MapPath(CreateFolderSub)
If Not objFSO.FolderExists(PhCreateFolderSub) Then
objFSO.CreateFolder(PhCreateFolderSub)
End If
Next
If Err Then
Err.Clear()
Else
BlInfo = True
End If
CreateMultiFolder = BlInfo
End Function
'〓保存图片过程
Function SaveRemoteFile(sSavePath,sRemoteFileUrl)
On Error Resume Next
SaveRemoteFile = False
Dim oXML : Set oXML = Server.CreateObject("Microsoft.XMLHTTP")
With oXML
.Open "Get",sRemoteFileUrl,False,"",""
.Send
If .Status<>200 Then Exit Function
RemoteDate = .ResponseBody
End With
Set oXML = Nothing
Dim oStream : Set oStream = Server.CreateObject("Adodb.Stream")
With oStream
.Type = 1
.Open
.Write RemoteDate
'〓获取远程文件名后缀
Extn = mid(sRemoteFileUrl,InStrRev(sRemoteFileUrl, ".")+1)
'〓将文件名重命名为日期ID
IDmsec=(timer*1000) Mod 1000
pid=year(now)&right("0"&month(now),2)&right("0"&day(now),2)&hour(now)&minute(now)&second(now)&IDmsec
'〓构建要保存图片的目录结构images/年-月/日文件夹
floderpath="/"&sSavePath&year(now)&"-"&month(now)&"/"&day(now)
'〓创建目录
Call CreateMultiFolder(floderpath)
'〓保存图片
.SaveToFile Server.MapPath(floderpath&"/"&pid&"."&Extn)
If Err.Number=0 Then SaveRemoteFile = True
.Close()
End With
Set oStream = Nothing
End Function
'〓调用方法如下
SourceURL="https://www.baidu.com/img/flexible/logo/pc/result.png"
Call SaveRemoteFile("images/",SourceURL)
%>