Gestion des répertoires

[Michael DELIQUE]

Code : Tout sélectionner

Public Function DirectoryCreate_API(wDirectory As String) As Long
   
   ' Créer un nouveau répertoire
   
%REM
'variable API pour la fonction DirectoryCreate_API
Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" ( Byval lpPathName As String,lpSecurityAttributes As Long) As Long
%END REM
   
   On Error Goto ErreurDirectoryCreate_API
   
   If Trim(wDirectory) = "" Then   
      DirectoryCreate_API = 0
   End If   
   
   DirectoryCreate_API = CreateDirectory (wDirectory, Byval &H0)
   
   Exit Function
ErreurDirectoryCreate_API:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"

   DirectoryCreate_API = 0      
   Exit Function
End Function

Code : Tout sélectionner

Public Function DirectoryDelete_API(wDirectory  As String,wForce As Integer) As Long
   
      ' Suppression d'un Repertoire
   
%REM
'variableAPI pour la fonction DirectoryDelete_API
'Declare Function SHFileOperation Lib "shell32" Alias "SHFileOperationA" ( lpFileOp As SHFILEOPSTRUCT) As Long
'Public Type SHFILEOPSTRUCT
'   hWnd As Long
'   wFunc As Long
'   pForm As String
'   pTo As String
'   fFlags As Integer
'   fAborted As Variant
'   hNameMaps As Long
'   sProgress As String
'End Type
'Const FO_DELETE = &H3
Const FOF_NOCONFIRMATION = &H10
%END REM
   
   'Daclaration Variable
   Dim SHDirOp As SHFILEOPSTRUCT
   Const FOF_NOCONFIRMATION = &H10
   Const FO_DELETE = &H3
   
   On Error Goto ErreurDirectoryDelete_API
   
   If Trim(wDirectory)   = "" Then
      DirectoryDelete_API = 0
      Exit Function
   Elseif isValideDirectory(wDirectory) = False Then
      DirectoryDelete_API = 0
      Exit Function
   End If
   
   SHDirOp.wFunc = FO_DELETE
   If wForce = True Then
      'pas de message de confirmation
      SHDirOp.fFlags = FOF_NOCONFIRMATION
   End If
   SHDirOp.pForm = wDirectory
   SHFileOperation SHDirOp
   
   Exit Function
ErreurDirectoryDelete_API:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   DirectoryDelete_API = 0
   Exit Function
End Function

Code : Tout sélectionner

Function DirectorySearch_API(sSearch As String) As String
   
%REM
'Variables API pour la fonction
Const MAX_PATH = 260
Const INVALID_HANDLE_VALUE = -1

Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type
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

Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( Byval lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( Byval hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
%END REM
   
   'Déclaration Variables
   Dim nbiNum As Long
   Dim i As Long
   Dim nbiDeb As Long
   Dim nbhFile As Long
   Dim tFindFile As WIN32_FIND_DATA
   Dim bTrouve As Variant
   Dim tmpSearch As String
   Dim nbpos As Integer
   
   On Error Goto erreurDirectorySearch_API
   
   sSearch = sSearch & ":"
   
   nbhFile = findfirstfile(sSearch + "\*.*", tFindFile)
   bTrouve = nbhFile <> INVALID_HANDLE_VALUE
   Do While bTrouve
      If tFindFile.dwFileAttributes = 16 Or tFindFile.dwFileAttributes = 17 Then
         If Left$(tFindFile.cFileName, 1) <> "." Then
            nbpos = Instr(tfindfile.cfilename, Chr$(0))
            tmpSearch = Left$(tfindfile.cfilename, nbpos - 1)
            DirectorySearch_API = sSearch & "\" & tmpSearch
            Exit Do
         End If
      End If
      nbiNum = nbiNum + 1
      bTrouve = FindNextFile(nbhFile, tFindFile)
   Loop
   
   Exit Function
ErreurDirectorySearch_API:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   DirectorySearch_API = ""
   Exit Function
End Function