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

使用方法:

CreateMultiFolder("/202003/tools/")

代码二、测试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

测试代码

createit("/202004/tools/")

以上代码如果无法运行,请检查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 !&nbsp;&nbsp;</b>"&path2&"<br>")

response.Flush()

end sub

call copyfiles(Server.MapPath("../无标题2.bmp"),"D:\网站项目\photo\aspupload\07_images\")

下面是其他网友的补充 

Public Function CheckAndCreateFolder(FolderName)

  fldr = Server.Mappath(FolderName)

  Set fso = CreateObject("Scripting.FileSystemObject")

  If Not fso.FolderExists(fldr) Then

  fso.CreateFolder(fldr)

  End If

  Set fso = Nothing

End Function

 检查文件夹是否存在,不存在则创建文件夹,该函数无返回值。

例:CheckAndCreateFolder("ASP")

检查当前目录下是否存在ASP文件夹,不存在则创建文件夹ASP ,缺点是不支持多级目录创建。

 asp关于fso函数,文件与文件夹的相关操作用得到

'//提供文件处理通用接口

Class FileSystemObject

'/*

' * 功能描述:删除文件

' * 输入参数:FileName——文件相对路径

'*/

Public Function DelFile(FileName)

Dim getPath

getPath="/"

SET Fso=Server.CreateObject("Scripting.FileSystemObject")

getPath=Replace(getPath&FileName,"//","/")

if Fso.FileExists(Server.MapPath(getPath))=True then

  Fso.DeleteFile Server.mappath(getPath)

End if

Set Fso=Nothing

End Function

'/*

' * 功能描述:判断路径是否存在,如不存在则创建

' * 输入参数:SaveFilePath——相对路径,如:/UploadFiles/NewsFiles

'*/

Public Function CreatePath(SaveFilePath)

Dim DeclarePath,FileObj,FilePath

DeclarePath="/"

Set FileObj=Server.CreateObject("Scripting.FileSystemObject")

For Each FilePath in split(SaveFilePath,"/")

  DeclarePath=Replace(DeclarePath&FilePath&"/","//","/")

  if FileObj.FolderExists(Server.MapPath(DeclarePath))=false then

    FileObj.CreateFolder(Server.MapPath(DeclarePath))'创建文件夹

  end if

Next

Set FileObj=nothing

CreatePath=DeclarePath

End Function

'/*

' * 功能描述:重命名文件夹

' * 输入参数:GetPath——文件夹路径

' * 输入参数:OldName——旧的文件夹名称

' * 输入参数:NewName——新的文件夹名称

'*/

Public Function RenFolder(GetPath,OldName,NewName)

Dim Fso

if OldName="" or NewName="" then

  exit Function

else

  if OldName=NewName then exit Function

end if

SET Fso=Server.CreateObject("Scripting.FileSystemObject")

if Fso.FolderExists(Server.MapPath(GetPath&NewName)) then

  response.write"<script language=javascript>alert('目录已经存在!!');this.history.go(-1);</script>"

  response.end()

end if

'//旧的文件夹不存在,则创建

if Not Fso.FolderExists(Server.MapPath(GetPath&OldName)) Then

  CreatePath(GetPath&OldName)

End if

Fso.MoveFolder Server.MapPath(GetPath&OldName),Server.MapPath(GetPath&NewName)

set Fso=nothing

'response.redirect request.ServerVariables("HTTP_REFERER")

End Function

'/*

' * 功能描述:保存当前文件

' * 输入参数:GetPath——文件路径

' * 输入参数:GetContent——保存的内容

' * 输入参数:GetFile——保存的文件名

'*/

Public Function SaveEditFile(GetPath,GetContent,GetFile)

if GetContent="" or GetFile="" then exit Function

SET Fso=Server.CreateObject("Scripting.FileSystemObject")

set CF=Fso.CreateTextFile(Server.mappath(GetPath&GetFile),true)

CF.write GetContent

CF.Close

set CF=nothing

set Fso=nothing

'response.redirect request.ServerVariables("HTTP_REFERER")

End Function

End Class

以上是 ASP如何检测某文件夹是否存在,不存在则自动创建 的全部内容, 来源链接: utcz.com/z/318078.html

回到顶部