Fichier log [Résolu]

chaima01 24 Messages postés lundi 1 mars 2010Date d'inscription 11 novembre 2012 Dernière intervention - 10 mai 2011 à 01:29 - Dernière réponse : NHenry 14262 Messages postés vendredi 14 mars 2003Date d'inscription 22 septembre 2018 Dernière intervention
- 12 mai 2011 à 20:48
je vient de trouver ce code de fichier log
Option Explicit

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

Private m_file As String
Private m_taille As Long
Private m_date As Boolean
Private m_time As Boolean
Private m_ptrfile As Integer
Private m_DateDebut As String
Private m_Block As Boolean
Private m_Buffer() As String
Private m_pos_log As Byte
Private m_Format_Date As String
Private m_Format_Heure As String
Private m_date_log As String * 8
Private m_entete As String

Public Enable As Boolean

Private Function init() As Boolean
On Error Resume Next
    If (Not Enable) Then
        Exit Function
    End If
    Dim tmp As String
    Dim pos As Long
    Dim i As Integer
    i = 1
    
    m_Block = True
    If (m_ptrfile <> 0) Then
        Close #m_ptrfile
    End If
    
    m_ptrfile = FreeFile()
    
    pos = InStrRev(m_file, ".", , vbTextCompare)
    
    m_DateDebut = Format(Now(), "yymmdd_hhmm")
    
    If (pos > 0) Then
        tmp = Mid$(m_file, 1, pos - 1) & m_DateDebut & Mid$(m_file, pos)
    Else
        tmp = m_file & m_DateDebut
    End If
    
    m_date_log = Format$(Now(), "ddmmyyyy")
    Open tmp For Append As #m_ptrfile
    If (m_taille <> 0) Then
        If CInt(Size) > m_taille Then
            init
        End If
    End If
    If (Len(m_entete) > 0) Then
        tmp = m_entete
        tmp = Replace(tmp, "%DATE%", Format$(Now(), "dd/mm/yyyy"))
        tmp = Replace(tmp, "%HEURE%", Format$(Now(), "hh:mm:ss"))
        tmp = Replace(tmp, "%VERSION%", App.Major & "." & App.Minor)
        tmp = Replace(tmp, "%BUILD%", App.Revision)
        tmp = Replace(tmp, "%NUMFICH%", CStr(i))
        tmp = Replace(tmp, "%APP%", App.EXEName)
        If (FileExist(App.path & IIf(Right$(App.path, 1) <> "", "", "") & App.EXEName & ".exe")) Then
            tmp = Replace(tmp, "%DATEMODIFAPP%", Format$(FileDateTime(App.path & IIf(Right$(App.path, 1) <> "", "", "") & App.EXEName & ".exe"), "dd/mm/yyyy hh:mm"))
        Else
            tmp = Replace(tmp, "%DATEMODIFAPP%", Format$(Now(), "dd/mm/yyyy hh:mm"))
        End If
        tmp = Replace(tmp, "%DIRCUR%", CurDir$())
        tmp = Replace(tmp, "%DIRAPP%", App.path)
        Print #m_ptrfile, tmp
    End If
    For pos = (m_pos_log + 1) To UBound(m_Buffer)
        If (Len(m_Buffer(pos)) > 0) Then Print #m_ptrfile, m_Buffer(pos)
    Next
    For pos = 0 To m_pos_log
        If (Len(m_Buffer(pos)) > 0) Then Print #m_ptrfile, m_Buffer(pos)
    Next
    m_Block = False
    
End Function

Public Property Let FileName(path As String)
On Error Resume Next
    Dim pos As Long
    
    If (Not Enable) Then
        Call Err.Raise(vbObjectError + 1, "ClsLog::FileName", "Log désactivé")
        Exit Property
    End If
    
    If ((Left$(path, 2) <> "\") And (Mid$(path, 2, 2) <> ":")) Then
        m_file = CurDir$ & "" & path
    Else
        m_file = path
    End If
    pos = InStrRev(m_file, "", , vbTextCompare)
    If (MakeSureDirectoryPathExists(Left$(m_file, pos)) = 0) Then
        Err.Raise 1, "Class Log", "Impossible de créer l'arborescence de Log"
    Else
        init
    End If
End Property

Public Property Get FileName() As String
    FileName = m_file
End Property

Public Property Let MaxSize(Taille As Long)
On Error Resume Next
    If (((Taille < 100) Or (Taille > 5 * 1024)) And (Taille <> 0)) Then
        Err.Raise 2, "Class Log", "Taille spécifiée incorrecte !"
    Else
        m_taille = Taille
    End If
End Property

Public Property Get MaxSize() As Long
    MaxSize = m_taille
End Property

Public Property Let LogTime(tmp As Boolean)
    m_time = tmp
End Property

Public Property Get LogTime() As Boolean
    LogTime = m_time
End Property

Public Property Let LogDate(tmp As Boolean)
    m_date = tmp
End Property

Public Property Get LogDate() As Boolean
    LogDate = m_date
End Property

Public Property Get Size() As Double
   Size = CDbl(LOF(m_ptrfile) / 1024)
End Property

Public Sub Ecrire(texte As String)
    Dim tmp As String
    
    If (Not Enable) Then
        Exit Sub
    End If
    
    If (Len(Trim$(texte)) > 0) Then
        tmp = IIf(LogDate, Format(Now(), m_Format_Date) & " ", "")
        tmp = tmp & IIf(LogTime, Format(Now(), m_Format_Heure) & " ", "")
        tmp = tmp & texte
        If (Not m_Block) Then
            If (m_date_log <> Format$(Now(), "ddmmyyyy")) Then
                init
            End If
           Print #m_ptrfile, tmp
        Else
            m_pos_log = m_pos_log + 1
            If (m_pos_log > 250) Then m_pos_log = 0
            m_Buffer(m_pos_log) = tmp
        End If
        Debug.Print tmp
    End If
    If (m_taille <> 0) Then
        If CInt(Size) > m_taille Then
            init
        End If
    End If
End Sub

Private Sub Class_Initialize()
    m_taille = 1024
    m_date = True
    m_time = True
    m_Block = True
    ReDim m_Buffer(0 To 250)
    Enable = False
    m_file = vbNullString
    m_pos_log = 250
    m_Format_Date = "dd-mm-yyyy"
    m_Format_Heure = "hh:mm:ss"
End Sub

Public Property Let Format_Heure(frt As String)
    m_Format_Heure = frt
End Property

Public Property Get Format_Heure() As String
    Format_Heure = m_Format_Heure
End Property

Public Property Let Format_Date(frt As String)
    m_Format_Date = frt
End Property

Public Property Get Format_Date() As String
    Format_Date = m_Format_Date
End Property

Public Property Let Entete(str As String)
    m_entete = str
End Property

Private Function FileExist(ByVal nom As String) As Boolean
On Error Resume Next
    Dim attrib As Integer
    
    attrib = GetAttr(nom)
    If (Err <> 0) Then
        FileExist = False
    Else
        If ((attrib And vbDirectory) = vbDirectory) Then
            FileExist = False
        Else
            FileExist = True
        End If
    End If
End Function


mais on exécutant ce code j’obtiens un fichier nommée trace avec la date et l'heure par contre je veut obtenir seulement un fichier nommée trace ( sans date et heure).
SVP , j'ai passer des heures à chercher ce qu'il faut le modifier mais ça marche pas.
merci d'avance
Afficher la suite 

Votre réponse

13 réponses

Meilleure réponse
NHenry 14262 Messages postés vendredi 14 mars 2003Date d'inscription 22 septembre 2018 Dernière intervention - 10 mai 2011 à 12:20
3
Merci
Bonjour,

Je pense qu'en regardant où est utilisé le résultat de cette ligne :
m_DateDebut = Format(Now(), "yymmdd_hhmm")
Tu aura ta réponse.

Mon site

Merci NHenry 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 95 internautes ce mois-ci

Commenter la réponse de NHenry
Meilleure réponse
NHenry 14262 Messages postés vendredi 14 mars 2003Date d'inscription 22 septembre 2018 Dernière intervention - 10 mai 2011 à 12:59
3
Merci
Bonjour,

"Open tmp For Append As #m_ptrfile"
Append -> Output

Mon site

Merci NHenry 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 95 internautes ce mois-ci

Commenter la réponse de NHenry
chaima01 24 Messages postés lundi 1 mars 2010Date d'inscription 11 novembre 2012 Dernière intervention - 10 mai 2011 à 12:50
0
Merci
svp , j'ai une autre question .
quand le fichier exite déja , je trouve que les anciens enregistrement reste encore.
comment je peux effacer l'ancien fichier et créer un autre nouveau ?

merci d'avance
Commenter la réponse de chaima01
chaima01 24 Messages postés lundi 1 mars 2010Date d'inscription 11 novembre 2012 Dernière intervention - 10 mai 2011 à 13:29
0
Merci
merci beaucoup NHenry
Commenter la réponse de chaima01
chaima01 24 Messages postés lundi 1 mars 2010Date d'inscription 11 novembre 2012 Dernière intervention - 10 mai 2011 à 13:44
0
Merci
SVP NHenry, j'ai un autre problème au niveau de msflexgrid et j'espére que tu va m'aider ^^
j'ai un msflexgrid dans le quel j'ai affiché les enregistrements qui se trouve dans la table.
au début, j'ai fixé le msflexgrid a 10 colonnes.
je veux savoir comment je peux réaliser le retour a la ligne si le nombre des enregistrements dépasse 10 , c'est à dire continuer l'affichage mais dans la ligne suivante ?
voici le code :

MSFlexGrid1.Cols = 10
MSFlexGrid1.Rows = 15


Rs2.Open "select adresse_ip, NOM_CELLULE from routeur", cnn, adOpenKeyset, adLockOptimistic

If Rs2.RecordCount > 0 Then
  j = 1
    Rs2.AbsolutePosition = 1
    MSFlexGrid1.Row = 0
        Do While Not Rs2.EOF
            MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1
            MSFlexGrid1.TextMatrix(1, j) = Rs2.Fields("adresse_ip")
            MSFlexGrid1.TextMatrix(2, j) = Rs2.Fields("NOM_CELLULE")
                If SocketsInitialize() Then
                     'Address to ping
                    strIPAddress = MSFlexGrid1.TextMatrix(1, j)
                    'Ping the IP that is passing the address and get a reply.
                     lngSuccess = ping(strIPAddress, Reply)
                    'Display the results.
                    Debug.Print "Address to Ping: " & strIPAddress
                     Debug.Print "Raw ICMP code: " & lngSuccess
                    Debug.Print "Ping Response Message : " & EvaluatePingResponse(lngSuccess)
                    Debug.Print "Time : " & Reply.RoundTripTime & " ms"
                     'Clean up the sockets.
                    SocketsCleanup
                Else
                    'Winsock error failure, initializing the sockets.
                    Debug.Print WINSOCK_ERROR
                End If
                
                With MSFlexGrid1
            .FillStyle = flexFillRepeat
            .Col = j
            .Row = 0
           .ColAlignment(j) = 4
           .RowHeight(0) = 1000
          
         
    If EvaluatePingResponse(lngSuccess) = "Success!" Then

      Set .CellPicture = LoadPicture("c:\application PFE\routeur1.jpg")
    
     Else

      Set .CellPicture = LoadPicture("c:\application PFE\routeu2.jpg")
    Trace.Ecrire MSFlexGrid1.TextMatrix(1, j) & "  Déconnecté  "
    End If
 End With
 j = j + 1
 Rs2.MoveNext
 Loop
 End If
 'Loop
 Rs2.Close


merci de m'aider
Commenter la réponse de chaima01
NHenry 14262 Messages postés vendredi 14 mars 2003Date d'inscription 22 septembre 2018 Dernière intervention - 10 mai 2011 à 21:12
0
Merci
Bonjour,

Tu fais un compteur qui compte le nombre d'ajout et quand tu arrives à 10, tu passe à la ligne suivante.

Mon site
Commenter la réponse de NHenry
chaima01 24 Messages postés lundi 1 mars 2010Date d'inscription 11 novembre 2012 Dernière intervention - 10 mai 2011 à 21:22
0
Merci
oui j'ai essayé.
svp, si ça ne te dérange pas, peut-tu modifier le code que je vient de l'envoyer ?
merci d'avance
Commenter la réponse de chaima01
NHenry 14262 Messages postés vendredi 14 mars 2003Date d'inscription 22 septembre 2018 Dernière intervention - 11 mai 2011 à 21:27
0
Merci
Bonjour,

Je n'ai pas le temps de reprendre et corriger ton code (en plus,sans coloration syntaxique, 3ième icone à droite dans le boite de message).

Voici un exemple :

Dim lLigne as long
Dim lColonne as long 

lLigne=0
lColonne=0

Do until Recordset.Eof
Cellule(lColonne, lLigne)=Value
lColonne=(lColonne+1) mod 10
if lColonne=0 then lLigne=lLigne+1
loop


Mon site
Commenter la réponse de NHenry
NHenry 14262 Messages postés vendredi 14 mars 2003Date d'inscription 22 septembre 2018 Dernière intervention - 11 mai 2011 à 21:28
0
Merci
Désolé, la fatigue (concernant la coloration syntaxique, j'ai 2 demandes similaire, je me suis mélangé)
Commenter la réponse de NHenry
chaima01 24 Messages postés lundi 1 mars 2010Date d'inscription 11 novembre 2012 Dernière intervention - 12 mai 2011 à 16:59
0
Merci
merci pour la réponse , mais ça marche pas. Toujours indices hors limites
Commenter la réponse de chaima01
NHenry 14262 Messages postés vendredi 14 mars 2003Date d'inscription 22 septembre 2018 Dernière intervention - 12 mai 2011 à 18:37
0
Merci
Bonjour,

ça donne quoi ton code et sur quelle ligne tu as l'erreur ?

Mon site
Commenter la réponse de NHenry
chaima01 24 Messages postés lundi 1 mars 2010Date d'inscription 11 novembre 2012 Dernière intervention - 12 mai 2011 à 19:42
0
Merci
bonjour ,
je veux afficher dans un msflexgrid1 les enregistrements qui se trouve dans la table router.
la 1ére ligne contient une image qui indique l'état de l'équipement (fonctionne ou non).
la 2éme ligne contient l'adresse ip de chaque équipement
la 3éme ligne contient le non de cellule (ou se trouve l'équipement).
j'ai fixé le msflexgrid1 comme suit: msflexgrid1.cols=10 et msflexgrid1.rows=15
le problème c'est au niveau le retour a la ligne . j'ai essayé comme ça:

Private Sub command_Click()

Dim lLigne As Long
Dim lColonne As Long

MSFlexGrid1.Cols = 10
MSFlexGrid1.Rows = 15
lLigne = 0
lColonne = 0

Rs2.Open "select adresse_ip, NOM_CELLULE from routeur", cnn, adOpenKeyset, adLockOptimistic

If Rs2.RecordCount > 0 Then
  j = 1
    Rs2.AbsolutePosition = 1
    MSFlexGrid1.Row = 0
        Do Until Rs2.EOF
            MSFlexGrid1.TextMatrix(lLigne, lColonne) = Rs2.Fields("adresse_ip")
            lLigne = lLigne + 1
            MSFlexGrid1.TextMatrix(lLigne, lColonne) = Rs2.Fields("NOM_CELLULE")
            lColonne = (lColonne + 1) Mod 10
            If lColonne = 0 Then
            lLigne = lLigne + 3
            End If
            
                If SocketsInitialize() Then
                     'Address to ping
                    strIPAddress = MSFlexGrid1.TextMatrix(1, j)
                    'Ping the IP that is passing the address and get a reply.
                     lngSuccess = ping(strIPAddress, Reply)
                    'Display the results.
                    Debug.Print "Address to Ping: " & strIPAddress
                     Debug.Print "Raw ICMP code: " & lngSuccess
                    Debug.Print "Ping Response Message : " & EvaluatePingResponse(lngSuccess)
                    Debug.Print "Time : " & Reply.RoundTripTime & " ms"
                     'Clean up the sockets.
                    SocketsCleanup
                Else
                    'Winsock error failure, initializing the sockets.
                    Debug.Print WINSOCK_ERROR
                End If
                
                With MSFlexGrid1
            .FillStyle = flexFillRepeat
            .Col = lColonne
            .Row = lLigne
           .ColAlignment(lColonne) = 4
           .RowHeight(lColonne) = 1000
          
         
    If EvaluatePingResponse(lngSuccess) = "Success!" Then
           
       ' .CellBackColor = &H80FF80
        
      Set .CellPicture = LoadPicture("c:\application PFE\routeur1.jpg")
    
     Else
            
        '.CellBackColor = &H8080FF
      Set .CellPicture = LoadPicture("c:\application PFE\routeu2.jpg")
       ' Trace.Ecrire MSFlexGrid1.TextMatrix(1, j) & "  Déconnecté  "
    End If
 End With
 j = j + 1
 Rs2.MoveNext
 Loop
 End If
 
 Rs2.Close
End Sub  


svp aider moi
Commenter la réponse de chaima01
NHenry 14262 Messages postés vendredi 14 mars 2003Date d'inscription 22 septembre 2018 Dernière intervention - 12 mai 2011 à 20:48
0
Merci
Bonjour,

Pourquoi faire 2 lignes si différentes dans les indexes ?
MSFlexGrid1.TextMatrix(lLigne, lColonne) = Rs2.Fields("adresse_ip")
strIPAddress = MSFlexGrid1.TextMatrix(1, j)

Et sur quelle ligne se situe l'erreur, as-tu regardé les valeurs au moment de l'erreur ?

Mon site
Commenter la réponse de NHenry

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.