Classe para criar Diretórios

dim fso
set fso = server.createobject("scripting.filesystemobject") 
fso.createfolder("c:\meu_servidor\Minha_pasta") 
fso.createfolder("c:\meu_servidor\Minha_pasta\Pasta2") 
fso.createfolder("c:\meu_servidor\Minha_pasta\Pasta3") 
set fso = nothing

Set object = New PathDiretorio

Class PathDiretorio
	Private bGblDisableDirCreation

	Public CriarPath

	Public Property Get Version()
		Version = "2.0x"
	End Property

	Public Property Get DisableDirCreation()
		If Len(bGblDisableDirCreation) = 0 Then
			DisableDirCreation = False
			Exit Property
		End If
		DisableDirCreation = bGblDisableDirCreation
	End Property

	Public Property Let DisableDirCreation(byVal bIn)
		bGblDisableDirCreation = bIn
	End Property

	Public Sub CriarDir()
		DetermineAction CriarPath
	End Sub



	'Classe rotinas internas

	Private Sub DetermineAction(byVal sPath)
		if len(trim(sPath)) > 0 then
			'verificar a propriedade...
			If Not DisableDirCreation Then
				'se permitido, criar os diretórios 
				MkDirs sPath
			Else
				'mostrar o sistema desativado mensagem
				Message 8, sPath
			End If
		end if
	End Sub

	Private Function TesteDir_RequiredInput(byRef FULLPATH)
	
		If Len(Trim(FULLPATH)) = 0 then
			TesteDir_RequiredInput = False
			Exit Function
		End If
		TesteDir_RequiredInput = True
	End Function

	Private Function TestDir_DriveLetter(byRef FULLPATH)

		 '  Segundo Teste:                        
		 Segundo Teste: 
' Um caminho tem de ser absoluto e que  
' Inclui uma unidade " x: \ " 
' Onde "x" é uma letra válida  
' A melhor maneira de verificar é a utilização de uma  
' Expressão regular 

		Dim re

		set re = New RegExp
		with re
			.global = true
			.ignorecase = true
			.pattern = "[A-Z]\:\\"
			TestDir_DriveLetter = .test(FULLPATH)
		end with
		set re = Nothing
	End Function

	Private Sub TestDir_FixSeparators(byRef FULLPATH)
		
   ' Terceiro Teste:                              
   ' Certifique-se que o diretório separadores são  
   ' caminho certo, através da fixação incorreta  
   ' Barras ... (Altere "/" para "\") 

		
		FULLPATH = Replace(FULLPATH, "/", "\")
	End Sub

	Private Function TestDir_ExamineDirs(byRef FULLPATH, byRef aryDirs)

'QUARTO Teste : 
'Chegou a hora de testar cada um dos nomes de diretório  
'A ser criado para assegurar que eles não 
'Tem caracteres ilegais.                 

		Dim i, j, re, bTest

		aryDirs = Split(FULLPATH, "\")


		 ' Arrays sempre começam em 0, mas no presente     
		 ' Caso, o elemento 0 é a letra 
		 ' Então ignorá-lo ... 

		For i = 1 to Ubound(aryDirs)
			aryDirs(i) = Trim(aryDirs(i))
			For j = 1 to Len(aryDirs(i))
				bTest = False

				 ' Teste cada personagem de um nome de diretório 
				 ' Expressão regular contra um padrão que 
				 ' Especifica todos os caracteres ilegais


				set re = New RegExp
				with re
					.global = true
					.ignorecase = true
					'expressão regular tem um pouco de atualização  
					'um pouco mais limpo agora 
					.pattern = "[\" & chr(34) & _
						"\!\@\#\$\%\^\&\*\(\)\=\+\|\[\]" & _
						"\{\}\`\'\;\:\<\>\?\/\,]"
					bTest = .test(mid(aryDirs(i), j, 1))
				end with
				set re = Nothing

				if bTest Then
					Call Message(3, FULLPATH)
					TestDir_ExamineDirs = False
					Exit Function
				end if
			Next

			
			'Quinto Teste
			'Certifique-se de que um nome de diretório não é
			'Mais de 100 caracteres
	

			if Len(aryDirs(i)) > 100 then
				Call Message(4, FULLPATH)
				TestDir_ExamineDirs = False
				Exit Function
			end if
		Next
		TestDir_ExamineDirs = True
	End Function

	Private Function TestDir_CheckForFiles(byRef FULLPATH, byRef aryDirs)

		 'Sexto  Teste e Final
		 'É inaceitável criar arquivos usando 
		 'Este sistema  verifica o último elemento em 
		 'O array para uma extensão de arquivo separator ( . )                                    

		Dim j

		If Len(Trim(aryDirs(ubound(aryDirs)))) = 0 then

			
			 ' Se o último elemento do array é 
			 ' Vazio, o usr messed up e colocar o \
			 ' Seguindo o caminho. Isso é mau sintaxe 
			 ' Assim vamos removê-lo por redimming o 
			 ' Array por isso não irá estragar o programa 
			 ' Quando juntamos o array (se você não usa 
			 ' Preserve a palavra-chave, os valores no 
			 ' Array são perdidas ...)              


			Redim Preserve aryDirs(ubound(aryDirs) - 1)
		End If
		If InStr(Trim(aryDirs(ubound(aryDirs))), ".") <> 0 then

			j = 0
			j = cLng(Len(Right(aryDirs(ubound(aryDirs)), _
			    Len(aryDirs(ubound(aryDirs))) - _
			    InStrRev(Trim(aryDirs(ubound(aryDirs))), "."))))
			if j > 0 and j < 6 then
				Call Message(5, FULLPATH)
				TestDir_CheckForFiles = False
				Exit Function
			end if
		End If

		 
		 ' Recriar caminho completo a partir da matriz de
		 ' Diretórios em um caso houve trailing 

		FULLPATH = Join(aryDirs, "\")
		aryDirs = Split(FULLPATH, "\")
		If ubound(aryDirs) < 1 Then

			 
			 ' Somente uma letra de unidade foi especificado, e nós 
             ' Não podemos criar a unidade

			Call Message(6, FULLPATH)
			TestDir_CheckForFiles = False
			Exit Function
		End If
		TestDir_CheckForFiles = True
	End Function

	Private Sub MkDirs(byVal FULLPATH)
		Dim aryDirs

		If Not TesteDir_RequiredInput(FULLPATH) Then
			Call Message(1, FULLPATH)
			Exit Sub
		End If

		if NOT TestDir_DriveLetter(Left(FULLPATH, 3)) Then
			Call Message(2, FULLPATH)
			Exit Sub
		end if

		TestDir_FixSeparators(FULLPATH)

		If NOT TestDir_ExamineDirs(FULLPATH, aryDirs) Then Exit Sub

		If NOT TestDir_CheckForFiles(FULLPATH, aryDirs) Then Exit Sub

		If NOT CriarEstruturaDir(FULLPATH, aryDirs) Then Exit Sub

		Call Message(0, FULLPATH)
	End Sub

	Private Sub Print(byVal toPrint)
		Response.Write(toPrint)
	End Sub

	Private Function CriarEstruturaDir(byRef FULLPATH, byRef aryDirs)

		 ' Loop através de cada nome e diretório 
		 ' Construir um caminho para que o diretório com o
		 ' Outros diretórios no array:
		 '     Exemplo:                               
		 '       Se você digitar:                        
		 '         C: \ windows \ desktop \ testefolder \ xan  
		 '       O sistema irá loop através de 4 vezes  
		 '       E criar quatro strings assim :   
		 '         c:\windows                         
		 '         c:\windows\desktop                 
		 '         c:\windows\desktop\testefolder      
		 '         c:\windows\desktop\testefolder\xan 
		 '   No final de cada ciclo com sucesso,      
		 '   Criado o diretório está guardado em um      
		 '   Seqüência variável chamada strBuild         

		Dim i, strBuild, j, FSO, bTest

		For i = 1 to ubound(aryDirs)
			strBuild = ""
			if i > 0 and i < ubound(aryDirs) + 1 then
				for j = 0 to i
					strBuild = strBuild & aryDirs(j) & "\"
				next
				strBuild = trim(strBuild)
				if right(strBuild, 1) = "\" then _
					strBuild = Left(strBuild, Len(strBuild) - 1)
			end if

			 ' Criar uma instância do FSO para criar 
			 ' Cada diretório na seqüência strBuild


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

			 ' Se o caminho especificado existe, jogue um 
			 ' Erro e informar o cliente 


			if i = ubound(aryDirs) and FSO.FolderExists(strBuild) then 
				bTest = true 
			else 
				bTest = false
			end if

			 ' Se cada caminho do arquivo não existir, faça-o 

			if NOT FSO.FolderExists(strBuild) then FSO.CreateFolder(strBuild)
			Set FSO = Nothing
			if bTest Then
				Call Message(7, FULLPATH)
				CriarEstruturaDir = False
				Exit Function
			end if
		Next
		CriarEstruturaDir = True
	End Function


	Private Sub Message(byVal iErr, byVal FULLPATH)

		 ' Exibindo mensagens que são chamados por 
		 ' Vários eventos na classe 

		if iErr = 0 Then
			Print "<H3>" & FULLPATH & " Criado!</H3>"
			Print "Este diretório completo foi criado."
		else
			Print "<H3>" & FULLPATH & " NÃO Criado!</H3>"
			Print "O PathDiretorio Objeto v"
			Print Version & " devolvido o "
			Print "seguinte mensagem de erro:"
			select case iErr
				case 1
					Error_NoPathEntered
				case 2
					Error_MissingDriveLetter
				case 3
					Error_BadCharInPath
				case 4
					Error_PathTooLong
				case 5
					Error_NoFiles
				case 6
					Error_NoDrives
				case 7
					Error_PathDiretorioExists
				case 8
					Error_PermissionDenied
				case 9
					Error_BadDriveLetter
				case else
					Error_Unspecified
			end select
		end if
	End Sub

	Private Sub Error_NoPathEntered
		%>
		<P>
		INSCREVER CAMINHO
		</P>
		<%
	End Sub

	Private Sub Error_MissingDriveLetter
		%>
		<P>
		Letra do Drive Ausente
		</P>
		<%
	End Sub

	Private Sub Error_BadCharInPath
		%>
		<P>
		CARACTER "BAD" NO PATH DO DIRETÓRIO
		</P>
		<%
	End Sub

	Private Sub Error_PathTooLong
		%>
		<P>
		UM OU MAIS DIRETÓRIO  são MUITO longos 
(Máximo 100 caracteres para cada diretório)
		</P>
		<%
	End Sub

	Private Sub Error_NoFiles
		%>
		<P>
		VOCÊ NÃO PODE criar arquivos com este sistema
		</P>
		<%
	End Sub

	Private Sub Error_NoDrives
		%>
		<P>
		VOCÊ NÃO PODE criar arquivos com este sistema
		</P>
		<%
	End Sub

	Private Sub Error_PathDiretorioExists()
		%>
		<P>
		O caminho especificado já existe
		</P>
		<%
	End Sub

	Private Sub Error_PermissionDenied()
		%>
		<P>
		O sistema foi DESATIVADO 
Pelo administrador. Não haverá DIRETÓRIO 
CRIADO PARA VOCÊ HOJE. VEJA O código fonte para 
Instruções sobre como ativar este sistema na sua 
SERVIDOR!
		</P>
		<%
	End Sub

	Private Sub Error_BadDriveLetter()
		%>
		<P>
		A unidade ESPECIFICADA NÃO PODE SER ENCONTRADA!
		</P>
		<%
	End Sub

	Private Sub Error_Unspecified()
		%>
		<P>
		ERRO NAO ESPECIFICADO
		</P>
		<%
	End Sub
End Class