AJOUTER UNE LIGNE DANS UN FICHIER - API

'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

05 mars 2006 10:54:44 :

Maj : Vérif. INVALID_HANDLE_VALUE par rapport a CreateFile Modif. GetFileSize Remplacement de DeleteFile par vidage du fichier avec SetEndOfFile

• INFO-BULLE PERSONNALISÉE, MULTILIGNES AVEC QQ OPTONS
• INFORMATION DISQUE DUR
• RETROUVE LA DATE DE CRÉATION D'UN FICHIER - API
• ECHANGE DE MESSAGES WINDOWS ENTRE DEUX APPLICATIONS
• TIRAGE DU LOTO

• EXTRAIRE LE TEXTE DES FENETRES D'APPLICATIONS TIERCES (LISTBOX, LISTVIEW, TEXTBOXES, ...)
• CONTROLE MENU => RENDRE INVISIBLE LES MENUS ET SOUS MENUS
• ENVOI MAIL VB 2005 API WINDOWS
• LISTER LES PAGES DE CODE SUPPORTÉES PAR WINDOWS
• OCX REGISTRE

• SUPPRIMER LIGNES VIDES FICHIER TEXTE
• DLL DE TRACE POUR EFFECTUER LE LOG DES APPLICATIONS (ÉCRITURE DANS FICHIER/BASE DE DONNÉES)
• MANSHILOG, DLL PERMETTANT D'ÉCRIRE ET DE LIRE DES LOGS
• CRÉER DES FICHIERS DE LOG EN QUELQUES LIGNES
• ROUTEUR DE FICHIERS EN TRAY ICON