ASP如何检测某文件夹是否存在,不存在则自动创建

    直接给大家分享一下lingkb测试正常可以使用的代码,并且支持多级目录创建

    代码一

    
     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如何检测某文件夹是否存在,不存在则自动创建的详细内容,更多关于ASP如何检测某文件夹是否存在的资料请关注lingkb其它相关文章!


Notice: Undefined variable: cao_ver in /data/wwwroot/www.lingkb.com/wp-content/plugins/riprodl/old.php on line 409