一个可以自动创建多级目录的函数

时间:2022-06-16 00:36:59
  1. <%  
  2. '创建多级目录,可以创建不存在的根目录  
  3. '参数:要创建的目录名称,可以是多级  
  4. '返回逻辑值,True成功,False失败  
  5. '创建目录的根目录从当前目录开始  
  6. '---------------------------------------------------  
  7.  
  8. Function CreateMultiFolder(ByVal CFolder)  
  9.     Dim objFSO, PhCreateFolder, CreateFolderArray, CreateFolder  
  10.     Dim i, ii, CreateFolderSub, PhCreateFolderSub, BlInfo  
  11.     BlInfo = False  
  12.     CreateFolder = CFolder  
  13.     On Error Resume Next  
  14.     Set objFSO = Server.CreateObject("Scripting.FileSystemObject")  
  15.     If Err Then  
  16.         Err.Clear()  
  17.         Exit Function  
  18.     End If  
  19.     CreateFolder = Replace(CreateFolder, """/")  
  20.     If Left(CreateFolder, 1) = "/" Then  
  21.         CreateFolder = Right(CreateFolder, Len(CreateFolder) -1)  
  22.     End If  
  23.     If Right(CreateFolder, 1) = "/" Then  
  24.         CreateFolder = Left(CreateFolder, Len(CreateFolder) -1)  
  25.     End If  
  26.     CreateFolderArray = Split(CreateFolder, "/")  
  27.     For i = 0 To UBound(CreateFolderArray)  
  28.         CreateFolderSub = ""  
  29.         For ii = 0 To i  
  30.             CreateFolderSub = CreateFolderSub & CreateFolderArray(ii) & "/"  
  31.         Next  
  32.         PhCreateFolderSub = Server.MapPath(CreateFolderSub)  
  33.         If Not objFSO.FolderExists(PhCreateFolderSub) Then  
  34.             objFSO.CreateFolder(PhCreateFolderSub)  
  35.         End If  
  36.     Next  
  37.     If Err Then  
  38.         Err.Clear()  
  39.     Else  
  40.         BlInfo = True  
  41.     End If  
  42.     CreateMultiFolder = BlInfo  
  43. End Function  
  44. %>  

使用方法:

  1. <% Response.Write CreateMultiFolder("/upload/2006/11/11/") &"<br>" %> 

'函数的返回值为True(成功)或False(失败,可能是主机不支持FSO功能)