咔叽游戏

 找回密码
 立即注册

QQ登录

只需一步,快速开始

搜索
查看: 394|回复: 0

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

[复制链接]
  • TA的每日心情
    无聊
    2019-4-21 13:02
  • 签到天数: 3 天

    [LV.2]圆转纯熟

    发表于 2020-2-29 07:23:25 | 显示全部楼层 |阅读模式
    直接给大家分享一下咔叽网单www.2nzz.com测试正常可以使用的代码,并且支持多级目录创建
    代码一

    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 !</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如何检测某文件夹是否存在的资料请关注咔叽网单www.2nzz.com其它相关文章!

    QQ|免责声明|小黑屋|手机版|Archiver|咔叽游戏

    GMT+8, 2024-3-28 19:35

    Powered by Discuz! X3.4

    © 2001-2023 Discuz! Team.

    快速回复 返回顶部 返回列表