Page 1 sur 1
Gestion des répertoires
Publié:
06 Nov 2007 à 08:57par 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