直接给大家分享一下服务器之家测试正常可以使用的代码,并且支持多级目录创建
代码一
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
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
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
'自动创建多极目录
'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下是无法运行的。
下面的实现代码功能性简单,适合学习
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
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
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
'创建新文件夹(允许无级创建)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
|
创建文件夹
1
2
3
4
5
6
7
|
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
|
删除文件夹
1
2
3
4
5
6
7
|
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
|
复制文件
1
2
3
4
5
6
7
8
9
10
11
|
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\")
|
下面是其他网友的补充
1
2
3
4
5
6
7
8
|
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函数,文件与文件夹的相关操作用得到
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
'//提供文件处理通用接口
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如何检测某文件夹是否存在的资料请关注服务器之家其它相关文章!