Soyez le premier à donner votre avis sur cette source.
Snippet vu 11 619 fois - Téléchargée 32 fois
'Module Option Explicit Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long 'Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long Private Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long Private Const GENERIC_READ = &H80000000 Private Const GENERIC_WRITE = &H40000000 Private Const FILE_SHARE_READ = &H1 Private Const FILE_SHARE_WRITE = &H2 Private Const FILE_ATTRIBUTE_HIDDEN = &H2 Private Const CREATE_NEW = 1 Private Const OPEN_ALWAYS = 4 Private Const OPEN_EXISTING = 3 Private Const FILE_BEGIN = 0 Private Const FILE_CURRENT = 1 Private Const FILE_END As Long = 2 'Valeur de retour si erreur Private Const INVALID_HANDLE_VALUE As Long = -1 Public Sub Debug_Log(Contenu_AddLine As String) Dim PathFile As String: PathFile = "" Dim hFile As Long: hFile = 0 Dim FileSize As Long: FileSize = 0 Dim Del_File As Long: Del_File = 0 Dim BytesWritten As Long: BytesWritten = 0 'Receive the low and high-order halves of the file size Dim loworder As Long, highorder As Long 'Indique le chemin du fichier If Right$(App.Path, 1) <> "\" Then PathFile = App.Path & "\Log.txt" Else PathFile = App.Path & "Log.txt" End If 'Ajoute l'hrs au contenu Contenu_AddLine = Right("00" & CStr(Day(Date)), 2) & "/" & Right("00" & CStr(Month(Date)), 2) & "/" & CStr(Year(Date)) & " - " & CStr(Time) & " | " & Contenu_AddLine 'Crée le fichier, ou ouvre le fichier si il existe hFile = CreateFile(PathFile, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_ALWAYS, 0, 0) If hFile = INVALID_HANDLE_VALUE Then 'Il n'existe pas 'Crée fichier hFile = CreateFile(PathFile, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, CREATE_NEW, 0, 0) End If 'Récupére la taille du fichier en octets 'Attention, GetFileSize peut renvoyer une taille de fichier maximum de : 2,147,483,647 bytes. highorder = 0 'initialize the value for high-order half loworder = GetFileSize(hFile, highorder) FileSize = highorder * 2 ^ 32 + loworder 'Je verifie si le fichier est vide If FileSize = 0 Then 'Il est vide, on écrit une ligne 'Positionne le pointeur a la fin du fichier '2 posibilités : FILE_BEGIN ou FILE_END 'SetFilePointer hFile, FileSize, 0, FILE_BEGIN 'ou avec FILE_END celle que j'utilise SetFilePointer hFile, 0, 0, FILE_END 'On ajoute la ligne à la fin du fichier WriteFile hFile, ByVal Contenu_AddLine, Len(Contenu_AddLine), BytesWritten, ByVal 0& Else 'On limite la taille du fichier 'Ici la limite est de 2 Mo soit 2,097,152 octets If FileSize > 2097152 Then 'On vide le fichier SetEndOfFile hFile Else 'On ajoute un vbCrLf à notre ligne Contenu_AddLine = vbCrLf & Contenu_AddLine End If 'Positionne le pointeur a la fin du fichier '2 posibilités : FILE_BEGIN ou FILE_END 'SetFilePointer hFile, FileSize, 0, FILE_BEGIN 'ou avec FILE_END celle que j'utilise SetFilePointer hFile, 0, 0, FILE_END 'On ajoute la ligne à la fin du fichier WriteFile hFile, ByVal Contenu_AddLine, Len(Contenu_AddLine), BytesWritten, ByVal 0& End If CloseHandle hFile End Sub
5 mars 2006 à 09:54
Je limite le fichier a 2 Mo car dans mon cas c'est un fichier de debugage, il me sert a lister les erreurs alors je le limite car je ne veux pas qu'il prenne dans le temps trop de place disque.
Tu as raison BruNews, j'ai pas fait gaffe.
Je ferais une MAJ pour la modif de vidage et non de suppression du fichier et par rapport a GetFileSize.
crenaud76 : C'est une autre facon d'ajouter une ligne dans un fichier et cela évite d'écrire un fichier via une variable.
Merci pour vos commentaires.
a+
5 mars 2006 à 03:57
Pourquoi fermer handle, supprimer fichier puis recréer ? c'est très couteux.
Ceci suffisait:
SetFilePointer hFile, 0, 0, FILE_BEGIN
SetEndOfFile hFile
ainsi fichier à 0 octet en un temps record et aucun risque de ratage d'obtention d'un nouveau handle.
Gaffe aussi au retour de GetFileSize, c'est un DWORD donc plage 32 bits NON SIGNE, les comparaisons < ou > en vb risquent fort de donner nimporte quoi. Comme les très grands fichiers deviennnet fréquents à notre époque, il convient de prendre l'habitude de fournir le second param à la fonction, un prog ne peut présumer la taille d'un fichier.
5 mars 2006 à 02:48
Fallais y penser :D
Par contre pourquoi supprimer le fichier si celui-ci est supérieur à 2 Mo. Imagine celui qui lit pas tes commentaires et qui exécute ton code sur un fichier de plus de 2 Mo...
Bonne continuation
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.