ASP如何检测某文件夹是否存在,不存在则自动创建 |
|
本文标签：ASP文件夹是否存在 直接给大家分享一下脚本之家测试正常可以使用的代码，并且支持多级目录创建 代码一
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
使用方法：
代码二、测试ok
'自动创建多极目录
'code by jb51 reterry
function createit(path)
dim fsofo,cinfo,thepath,thepatharray
dim i,ii,binfo
binfo=false
thepath=path
set fsofo=createobject("scripting.filesystemobject")
if err then
err.clear
exit function
end if
thepath=replace(thepath,"","/")
if left(thepath,1)="/" then
thepath=right(thepath,len(thepath)-1)
end if
if right(thepath,1)="/" then
thepath=left(thepath,len(thepath)-1)
end if
thepatharray=split(thepath,"/")
for i=0 to ubound(thepatharray)
createfoldersub1=createfoldersub1&thepatharray(i)&"/"
createfoldersub=server.mappath(createfoldersub1)
if not fsofo.folderexists(createfoldersub) then
fsofo.createfolder(createfoldersub)
end if
next
if err then
err.clear
else
binfo=true
end if
createit=binfo
end function
测试代码
以上代码如果无法运行，请检查iis运行用户的权限是否有写功能 。今天测试的时候默认iis7.5下是无法运行的 。 下面的实现代码功能性简单，适合学习
ASP如何检测某文件夹是否存在,不存在则自动创建
folder=server.mappath("/imagess")
Set fso = CreateObject("Scripting.FileSystemObject")
if fso.fileexists(Server.mappath(filepath)) then
respnse.write("都有了还建什么建")
else
fso.createfolder(folder)
end if
Set fso = nothing
Dim objFSO
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(Server.MapPath(SavePath))=false Then
objFSO.CreateFolder(Server.MapPath(SavePath))
End If
folder=server.mappath("/imagess")
Set fso = CreateObject("Scripting.FileSystemObject")
if fso.fileexists(Server.mappath(filepath)) then
respnse.write("都有了还建什么建")
else
fso.createfolder(folder)
end if
Set fso = nothing
都不完善，我想楼主的意思是创建无极深度目录吧，给个我写的：
'创建新文件夹(允许无级创建)1:35 2005-1-31
Public Function CreateFolder(FolderPath)
Dim sObjFSO
Dim arrFolder
Dim i
Set sObjFSO = Server.CreateObject("Scripting.FileSystemObject")
FolderPath = Replace(FolderPath,"","/")
arrFolder = Split(FolderPath,"/")
On Error Resume Next
For i = 0 To UBound(arrFolder)
If i > 0 Then arrFolder(i) = arrFolder(i-1) & "/" & arrFolder(i)
If Not sObjFSO.FolderExists(arrFolder(i)) Then
sObjFSO.CreateFolder(arrFolder(i))
End If
Next
CreateFolder = True
If Err.number <> 0 Then
CreateFolder = False
Err.Clear
End If
End Function
创建文件夹
dim fso,SavePath
SavePath=server.MapPath("."&imagefile&""&username&""&specialname&"")
set fso = server.CreateObject("scripting.filesystemobject")
if fso.FolderExists(SavePath)=false then
fso.createfolder(SavePath)
end if
set fso=nothing
删除文件夹
dim fso,SavePath
SavePath=server.MapPath("."&imagefile&""&username&""&specialname&"")
set fso = server.CreateObject("scripting.filesystemobject")
if fso.FolderExists(SavePath)=true then
fso.deletefolder(SavePath)
end if
set fso=nothing
复制文件
dim fso
set fso=server.CreateObject("scripting.filesystemobject")
sub copyfiles(path,path2)
set mycopy=fso.getfile(path)
response.flush()
mycopy.copy path2
response.write("<b>installed success ! </b>"&path2&"<br>")
response.Flush()
end sub
call copyfiles(Server.MapPath("../无标题2.bmp"),"D:网站项目photoaspupload
|
