Editer un commentaire - Informaticien.be

Editer un commentaire

Sujet
Texte	Un autre méthode beaucoup plus rapide (50%) qui utilise les API et non le FileSystemObject (donc pas de DLL à lier/trimballer) [vb]Private Const MAX_PATH As Long = 260 Private Const INVALID_HANDLE_VALUE As Long = -1 Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10 nLength As Long lpSecurityDescriptor As Long bInheritHandle As Long End Type Private Type SECURITY_ATTRIBUTES Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" _ (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End Type Private Declare Function FindFirstFile Lib "kernel32" _ Alias "FindFirstFileA" _ (ByVal lpFileName As String, _ lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindClose Lib "kernel32" _ (ByVal hFindFile As Long) As Long Public Sub rMkDir(sPath As String) Dim sTmp As String Dim iIndex As Integer Dim iLen As Integer Dim iEnd As Integer Dim SecAttrib As SECURITY_ATTRIBUTES With SecAttrib .lpSecurityDescriptor = &O0 .bInheritHandle = False .nLength = Len(SecAttrib) End With iLen = Len(sPath) sTmp = Left(sPath, 2) If sTmp = "\\" Then iIndex = InStr(3, sPath, "\") End If Do iEnd = InStr(iIndex + 1, sPath, "\") If iEnd = 0 Then iEnd = iLen End If sTmp = Mid(sPath, 1, iEnd) If Not FolderExists(sTmp) Then Call CreateDirectory(sTmp, SecAttrib) End If iIndex = iEnd + 1 Loop While iEnd <> iLen End Sub Private Function FolderExists(sFolder As String) As Boolean Dim hFile As Long Dim WFD As WIN32_FIND_DATA sFolder = UnQualifyPath(sFolder) hFile = FindFirstFile(sFolder, WFD) FolderExists = (hFile <> INVALID_HANDLE_VALUE) And _ (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Call FindClose(hFile) End Function Private Function UnQualifyPath(ByVal sFolder As String) As String sFolder = Trim$(sFolder) If Right$(sFolder, 1) = "\" Then UnQualifyPath = Left$(sFolder, Len(sFolder) - 1) Else UnQualifyPath = sFolder End If End Function [/vb]