Gestion des fichiers

Gestion des fichiers

Messagepar Michael DELIQUE » 05 Nov 2007 à 17:41

Code : Tout sélectionner
Function FileAttributes_API(wPathFile As String, nbAttribute As Integer) As Long
%REM
'variable API pour la fonction FileAttributes_API
Public Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String,ByVal dwFileAttributes As Long) As Long
%END REM
   
      'déclaration Variable
   
   On Error Goto ErreurHandle
   
   If Trim(wPathFile) = "" Then
      FileAttributes_API = 0
      Exit Function
   End If
   
   Select Case nbAttribute
   Case 0            ' Normal (Pas d'Attribut)
   Case 1             'Read Only - Lecture seule
   Case 2             'Hidden - Caché
   Case 3             'Read Only & Hidden - Lecture seule/caché
   Case Else
      Error 9999,"Mauvais attribut de fichier : "+Cstr(nbAttribute)
      Exit Function
   End Select
   
   FileAttributes_API = SetFileAttributes (wPathFile, nbAttribute)
   
   Exit Function
ErreurHandle:
   Msgbox "("+Structure_Log+" : "+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 !"
   FileAttributes_API = 0
   Exit Function
End Function
Dernière édition par Michael DELIQUE le 06 Nov 2007 à 08:53, édité 2 fois.
Cordialement

Michael (SMS-Phobique)
----------------------------
"La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi."
Albert EINSTEIN
Avatar de l’utilisateur
Michael DELIQUE
Administrateur
Administrateur
 
Message(s) : 12183
Inscrit(e) le : 16 Déc 2004 à 10:36
Localisation : Paris/Cergy

Messagepar Michael DELIQUE » 05 Nov 2007 à 18:02

Code : Tout sélectionner
Public Function GetFileInfo_API(wpathFile As String) As Variant
   
%REM
'variableAPI pour la fonction
Public Type FILETIME
      nbLowDateTime As Long
      nbHighDateTime As Long
End Type

Public Type SYSTEMTIME
      wYear As Integer
      wMonth As Integer
      wDayOfWeek As Integer
      wDay As Integer
      wHour As Integer
      wMinute As Integer
      wSeconde As Integer
      wMilliseconds As Integer
End Type

Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" ( Byval
lpFileName As String, Byval dwDesiredAccess As Long, Byval dwShareMode As
Long, lpSecurityAttributes As Long, Byval dwCreationDisposition As Long,
Byval dwFlagsAndAttributes As Long, Byval dwhTemplateFile As Long) As Long
Declare Function GetFileSize Lib "kernel32" ( Byval hFile As Long,
lpFileSizeHigh As Long) As Long
Declare Function CloseHandle Lib "kernel32" ( Byval hObject As Long) As
Long
Declare Function GetFileTime Lib "kernel32" ( Byval hFile As Long,
lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime
As FILETIME) As Long
Declare Function FileTimeToSystemTime Lib "kernel32" ( lpFileTime As
FILETIME,lpSystemTime As SYSTEMTIME) As Long
Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As
FILETIME,lpLocalFileTime As FILETIME) As Long
%END REM
   
   
        ' Récupère les informations sur le fichier
      'Déclaration Variables
   Dim nbHandleFichier As Long
   Dim lstValue List As String
   Dim lngLong As Long
   Dim ftCreate As Filetime
   Dim ftlastAccess As Filetime
   Dim ftLastWrite As Filetime
   Dim SysTime As SYSTEMTIME
   Dim LocalTime As FileTime
   
      ' Constante système
   Const GENERIC_WRITE = &H40000000
   Const OPEN_EXISTING = 3
   Const FILE_SHARE_READ = &H1
   Const FILE_SHARE_WRITE = &H2
   
   On Error Goto ErreurGetFileInfo_API
   
   lstvalue("TAILLE") = ""
   lstValue("CREATE") = ""
   lstValue("LASTACCESS") = ""
   lstValue("LASTWRITE") = ""
   
   
   If isvalideFile(wpathFile) = False Then
      Error 9999, "fichier inaccessible"
      GetFileInfo_API = lstValue
      Erase lstValue
      Exit Function
   End If
   
   nbHandleFichier = CreateFile(wPathFile, GENERIC_WRITE,FILE_SHARE_READ Or FILE_SHARE_WRITE, Byval 0&, OPEN_EXISTING, 0, 0)
   
   lstvalue("TAILLE") = Cstr(GetFileSize(nbHandleFichier,lngLong)    )
   
   GetFileTime nbHandleFichier, ftCreate, ftlastAccess, ftLastwrite
   
   FileTimeToLocalFileTime ftCreate, LocalTime
   FileTimeToSystemTime LocalTime, SysTime
   lstValue("CREATE") =Cstr(SysTime.wDay)+"/"+Cstr(SysTime.wMonth)+"/"+Cstr(SysTime.wYear)+""+Cstr(SysTime.wHour)+":"+Cstr(SysTime.wMinute)+":"+Cstr(SysTime.wSeconde)+":"+Cstr(SysTime.wMilliseconds)
   
   FileTimeToLocalFileTime ftlastAccess, LocalTime
   FileTimeToSystemTime LocalTime, SysTime
   lstValue("LASTACCESS") =Cstr(SysTime.wDay)+"/"+Cstr(SysTime.wMonth)+"/"+Cstr(SysTime.wYear)+""+Cstr(SysTime.wHour)+":"+Cstr(SysTime.wMinute)+":"+Cstr(SysTime.wSeconde)+":"+Cstr(SysTime.wMilliseconds)
   
   FileTimeToLocalFileTime ftLastWrite, LocalTime
   FileTimeToSystemTime LocalTime, SysTime
   lstValue("LASTWRITE") =Cstr(SysTime.wDay)+"/"+Cstr(SysTime.wMonth)+"/"+Cstr(SysTime.wYear)+""+Cstr(SysTime.wHour)+":"+Cstr(SysTime.wMinute)+":"+Cstr(SysTime.wSeconde)+":"+Cstr(SysTime.wMilliseconds)
   
   CloseHandle nbHandleFichier
   
   GetFileInfo_API = lstValue
   Erase lstValue
   
   Exit Function
ErreurGetFileInfo_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 !"
   
   lstvalue("TAILLE") = ""
   lstValue("CREATE") = ""
   lstValue("LASTACCESS") = ""
   lstValue("LASTWRITE") = ""
   GetFileInfo_API = lstValue
   Erase lstValue
   CloseHandle nbHandleFichier
   Exit Function
End Function
Cordialement

Michael (SMS-Phobique)
----------------------------
"La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi."
Albert EINSTEIN
Avatar de l’utilisateur
Michael DELIQUE
Administrateur
Administrateur
 
Message(s) : 12183
Inscrit(e) le : 16 Déc 2004 à 10:36
Localisation : Paris/Cergy

Messagepar Michael DELIQUE » 06 Nov 2007 à 08:56

Code : Tout sélectionner
Public Function FileClose_API(nbHandleFichier As Long) As Long
   
%REM
'variable API pour la fonction FileClose_API
Declare Function CloseHandle Lib "kernel32" (Byval hObject As Long) As Long
%END REM
   
   On Error Goto ErreurFileClose_API
      ' Fermeture du fichier
   FileClose_API = CloseHandle (nbHandleFichier)
   Exit Function
ErreurFileClose_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 !"
   FileClose_API = 0   
   Exit Function
End Function


Code : Tout sélectionner
Public Function FileCopy_API(wFIchierSource As String, wFichierCIble As String) As Long
   
   ' Copie d'un fichier (Il faut que le fichier soit éxistant)
%REM
'variables API pour la fonction FileCopy_API
Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" ( Byval lpExistingFileName As String, Byval lpNewFileName As String, Byval bFailIfExits As Long) As Long
%END REM
   
   On Error Goto ErreurFileCopy_API
   
   If Trim(wFIchierSource) = "" Then
      Exit Function
   Elseif Trim(wFichierCIble) = "" Then
      Exit Function
   End If
   
   FileCopy_API = CopyFile(wFIchierSource , wFichierCIble, 0)
   Exit Function
ErreurFileCopy_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 !"
   FileCopy_API = 0
   Exit Function
End Function


Code : Tout sélectionner
Public Function FileDelete_API(wFIchierSource As String) As Long
   
      ' Suppression du fichier
   
%REM
'Variables API pourla fonction FileDelete_API
Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" ( Byval lpFileName As String) As Long
%END REM
   
   On Error Goto ErreurFileDelete_API
   
   If Trim(wFIchierSource) = "" Then
      FileDelete_API = 0
      Exit Function
   End If
   
   FileDelete_API = DeleteFile(wFIchierSource)
   
   Exit Function
ErreurFileDelete_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 !"
   FileDelete_API = 0
   Exit Function
End Function


Code : Tout sélectionner
Public Function FileMove_API(wFIchierSource As String, wFichierCIble As String) As Long
   
 ' Déplacer ou Renommer un fichier
   
%REM
'Variables API pour la fonction
Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" ( Byval lpExistingFileName As String, Byval lpNewFileName As String) As Long
%END REM
   
   On Error Goto ErreurFileMove_API
   
   If Trim(wFIchierSource) = "" Then
      FileMove_API = 0
      Exit Function
   Elseif Trim(wFichierCIble) = "" Then
      FileMove_API = 0
      Exit Function
   End If
   
   If Ucase(Trim(wFIchierSource)) = Ucase(Trim(wFichierCIble)) Then
      FileMove_API = 0
      Exit Function
   End If
   
   
   FileMove_API  = MoveFile (wFIchierSource , wFichierCIble)
   
   Exit Function
ErreurFileMove_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 !"
   FileMove_API = 0
   Exit Function
End Function


Code : Tout sélectionner
Public Function FileOpen_API(wFIchierSource As String) As Long
   
       ' Ouvrir/creer un fichier
   
%REM
'variable API pour la fonction FileOpen_API
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" ( Byval lpFileName As String, Byval dwDesiredAccess As Long, Byval dwShareMode As Long, lpSecurityAttributes As Long, Byval dwCreationDisposition As Long, Byval dwFlagsAndAttributes As Long, Byval dwhTemplateFile As Long) As Long
Const GENERIC_WRITE = &H40000000
Const OPEN_EXISTING = 3
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
%END REM
   
   On Error Goto ErreurFileOpen_API
   
   If Trim(wFIchierSource) = "" Then
      FileOpen_API= 0
      Exit Function
   End If
   
   FileOpen_API = CreateFile(wFIchierSource, GENERIC_WRITE,FILE_SHARE_READ Or FILE_SHARE_WRITE, Byval 0&, OPEN_EXISTING, 0, 0)
   Exit Function
ErreurFileOpen_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 !"
   FileOpen_API = 0
   Exit Function
End Function
[/code]
Cordialement

Michael (SMS-Phobique)
----------------------------
"La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi."
Albert EINSTEIN
Avatar de l’utilisateur
Michael DELIQUE
Administrateur
Administrateur
 
Message(s) : 12183
Inscrit(e) le : 16 Déc 2004 à 10:36
Localisation : Paris/Cergy


Retour vers API