Thema Datum  Von Nutzer Rating
Antwort
17.04.2024 22:40:54 LouieLoop
NotSolved
17.04.2024 23:42:54 ralf_b
NotSolved
18.04.2024 08:49:36 LouieLoop
NotSolved
18.04.2024 23:11:43 Gast82767
NotSolved
19.04.2024 17:09:43 Gast22787
Solved
Blau Objekt-basierter Ansatz (dient nur der Inspiration)
18.04.2024 12:02:36 Trägheit
NotSolved
18.04.2024 13:48:47 LouieLoop
NotSolved
19.04.2024 09:39:14 Gast71028
NotSolved
20.04.2024 00:47:39 Gast50786
NotSolved
20.04.2024 15:37:02 Gast78090
NotSolved
22.04.2024 18:41:37 Gast35910
NotSolved
23.04.2024 14:47:21 Gast84819
NotSolved

Ansicht des Beitrags:
Von:
Trägheit
Datum:
18.04.2024 12:02:36
Views:
49
Rating: Antwort:
  Ja
Thema:
Objekt-basierter Ansatz (dient nur der Inspiration)

Ein Hinweis vorweg:

Das ist eine naive Implementierung, das bedeutet ich würde es so nicht produktiv einsetzen. Beispielsweise würde ich statt der Open-Anweisung auf ADO.Stream setzen und ich würde Interfaces einführen; z.B. um Positionsinformationen eines LogEntry zu pflegen. Die Klasse LogFile würde ich weiter auftrennen in LogReader und LogWriter (auch hier wäre jeweils ein Interface sinnvoll).


Die hier verwendeten Klassen findest du weiter unten.
Hier folgt ein Beispiel zur Verwendung:

Option Explicit

Sub TestDemo()
  
  Dim objLogFile As LogFile
  Dim strFilename As String
  
  Set objLogFile = New LogFile
  
  strFilename = Environ$("USERPROFILE") & "\Desktop\MyLogFile.txt"
  
  If Not objLogFile.ReadFromFile(strFilename) Then
    Call MsgBox("Datei konnte nicht erfolgreich gelesen werden.")
    Exit Sub
  End If
  
  Dim objLogEntry As LogEntry
  Dim i As Long
  
  Debug.Print "~ OUTPUT ~"
  For i = 1 To objLogFile.EntryCount
    Set objLogEntry = objLogFile.Entry(i)
    Debug.Print objLogEntry.PageCount, objLogEntry.Filename
  Next
  '4             Datei01.docx
  '21            DateiBsp.docx
  '17            Datei939.docx
  '4             DateiLouie.docx
  '122           Datei02.docx
  
  '>> dritten Eintrag ändern und speichern
  Set objLogEntry = objLogFile.Entry(3)
  objLogEntry.PageCount = objLogEntry.PageCount + 7
  Call objLogEntry.WriteToFile(objLogFile)
  
  '>> Erneut Lesen, nach Änderung:
  ' * Erneutes Lesen wäre eigentlich nicht notwendig,
  '   da die Informationen bereits in den Instanzen gecached vorliegt)
  Call objLogFile.ReadFromFile(strFilename)
  Debug.Print "~ OUTPUT (edited)  ~"
  For i = 1 To objLogFile.EntryCount
    Set objLogEntry = objLogFile.Entry(i)
    Debug.Print objLogEntry.PageCount, objLogEntry.Filename
  Next
  '4             Datei01.docx
  '21            DateiBsp.docx
  '24            Datei939.docx
  '4             DateiLouie.docx
  '122           Datei02.docx
  
  Dim lngSum As Long
  Debug.Print String(15, "-")
  For i = 1 To objLogFile.EntryCount
    lngSum = lngSum + objLogFile.Entry(i).PageCount
  Next
  Debug.Print "Sum(PageCount):"; lngSum
  
End Sub

Klasse: LogFile

Option Explicit

Private Const C_SOURCE As String = "LogFile"
Private Const E_INVALID_SEPERATOR As Long = vbObjectError + 1
Private Const E_INVALID_POSITION As Long = vbObjectError + 2

Private m_colLogEntries As VBA.Collection
Private m_strSeperator As String
Private m_strFilename As String

Private Sub Class_Initialize()
  Set m_colLogEntries = New VBA.Collection
  m_strSeperator = ","
End Sub

Public Function ReadFromFile(Filename As String) As Boolean
  
  Dim colLogEntries As VBA.Collection
  Set colLogEntries = New VBA.Collection
  
  Dim lngPosition As Long
  Dim QNr As Long
  
  lngPosition = 1
  QNr = FreeFile
  
  Dim objLogEntry As LogEntry
  Dim strLine As String
  
  On Error GoTo ErrHandler
  Open Filename For Input As #QNr
    Do Until EOF(QNr)
      
      Set objLogEntry = New LogEntry
      objLogEntry.Position = lngPosition
      
      Line Input #QNr, strLine
      
      Call objLogEntry.FromLineExpr(strLine, Me.Seperator)
      Call colLogEntries.Add(objLogEntry)
      
      lngPosition = lngPosition + Len(strLine) + Len(vbNewLine)
    Loop
  Close #QNr
  On Error GoTo 0
  
  Set m_colLogEntries = colLogEntries
  m_strFilename = Filename
  ReadFromFile = True
  
  Exit Function
ErrHandler:
  Debug.Print Err.Number & ":", Err.Description
  Close #QNr
  ReadFromFile = False
End Function

Public Property Get Seperator() As String
  Seperator = m_strSeperator
End Property

Public Property Let Seperator(RHS As String)
  If Len(RHS) = 0 Then Call Err.Raise(E_INVALID_SEPERATOR, C_SOURCE, "Seperator cannot be of length zero")
  m_strSeperator = RHS
End Property

Public Property Get Entry(Index As Long) As LogEntry
  Set Entry = m_colLogEntries(Index)
End Property

Public Property Get EntryCount() As Long
  EntryCount = m_colLogEntries.Count
End Property

Public Sub WriteEntry(LineExpr As String, Optional Position As Long = 0)
  
  If m_strFilename = "" Then
    Exit Sub
  End If
  
  Dim QNr As Long
  QNr = FreeFile
  
  On Error GoTo ErrHandler
  If Position <= 0 Then
    Open m_strFilename For Append As #QNr
  Else
    Open m_strFilename For Append As #QNr
    Seek #QNr, Position
  End If
  
  Print #QNr, LineExpr
  Close #QNr
  
  If Position > 0 Then
    'TODO: update Position-Property aller nachfolgenden LogEntry Instanzen
  End If
  
  Exit Sub
ErrHandler:
  Close #QNr
  Call Err.Raise(Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End Sub

Klasse: LogEntry

Option Explicit

Private m_lngPosition As Long

Private m_lngPageCount As Long
Private m_strFilename As String

Public Property Get Position() As Long
  Position = m_lngPosition
End Property

Public Property Let Position(RHS As Long)
  m_lngPosition = RHS
End Property


Public Property Get PageCount() As Long
  PageCount = m_lngPageCount
End Property

Public Property Let PageCount(RHS As Long)
  m_lngPageCount = RHS
End Property

Public Property Get Filename() As String
  Filename = m_strFilename
End Property

Public Property Let Filename(RHS As String)
  m_strFilename = RHS
End Property

Public Function AsLineExpr(Seperator As String) As String
  AsLineExpr = Format$(Me.PageCount, "000") & Seperator & Me.Filename
End Function

Public Sub FromLineExpr(LineExpr As String, Seperator As String)

  Dim vntLine As Variant
  vntLine = Split(Trim$(LineExpr), Seperator)
  
  Me.PageCount = CLng(Trim$(vntLine(0)))
  Me.Filename = Trim$(vntLine(1))
  
End Sub

Public Sub WriteToFile(File As LogFile)
  Dim strLineExpr As String
  strLineExpr = Me.AsLineExpr(File.Seperator)
  Call File.WriteEntry(strLineExpr, Me.Position)
End Sub

 

Grüße


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
17.04.2024 22:40:54 LouieLoop
NotSolved
17.04.2024 23:42:54 ralf_b
NotSolved
18.04.2024 08:49:36 LouieLoop
NotSolved
18.04.2024 23:11:43 Gast82767
NotSolved
19.04.2024 17:09:43 Gast22787
Solved
Blau Objekt-basierter Ansatz (dient nur der Inspiration)
18.04.2024 12:02:36 Trägheit
NotSolved
18.04.2024 13:48:47 LouieLoop
NotSolved
19.04.2024 09:39:14 Gast71028
NotSolved
20.04.2024 00:47:39 Gast50786
NotSolved
20.04.2024 15:37:02 Gast78090
NotSolved
22.04.2024 18:41:37 Gast35910
NotSolved
23.04.2024 14:47:21 Gast84819
NotSolved