| |
Visual-Basic EinsteigerKleine Spielerei ... | | | Autor: Manfred X | Datum: 17.01.17 08:35 |
| In der FileList-Klasse werden Dateien (Angabe im Parameter mit vollem Pfad)
angehängt. Ordnerangaben und Zeiger werden dabei automatisch erstellt.
Abfragen von Ordner- oder Dateilisten durch die GetEntries-Methode.
'FilesystemEntry-Klasse
Option Explicit
Public name As String 'eines Unterordners oder einer Datei
Public IsFile As Boolean 'Ist es eine Datei?
Public Parent As Integer 'direkt übergeordneter Ordner (Arrayindex) =============================
'FileList-Klasse
Option Explicit
Private Entries() As FilesystemEntry
Public Count As Integer
Private Sub Class_Initialize()
ReDim Entries(1 To 1000) As FilesystemEntry
Count = 0
End Sub
Private Sub Class_terminate()
Count = 0
ReDim Entries(0) As FilesystemEntry
End Sub
Public Function AddFilePath(Filepath As String) As Boolean
'Eintragung einer Datei (kompletter Pfad)
AddFilePath = False
Dim parts() As String, i%, index%
'Pfad in Teile zerlegen
parts = Split(Filepath, "\", , vbTextCompare)
If UBound(parts) < 2 Then Exit Function
'fehlende Einträge in der Entry-Liste ergänzen
Dim path As String, oldindex%
oldindex = -1
For i = 0 To UBound(parts)
path = path & parts(i) & "\"
If Not i = UBound(parts) Then
'Ist der Eintrag des Teilpfades bereits vorhanden
index = FindEntryByPath(path, False)
End If
If i = UBound(parts) Or index < 1 Then
'Datei oder neuer Pfadteil wird ergänzt
Count = Count + 1
If Count >= UBound(Entries) Then
'Array ggf. verlängern
ReDim Preserve Entries(1 To UBound(Entries) + 1000)
End If
'neuer Eintrag
Set Entries(Count) = New FilesystemEntry
Entries(Count).name = Trim(UCase(parts(i)))
Entries(Count).Parent = oldindex 'übergeordn. Entry
If i = UBound(parts) Then Entries(Count).IsFile = True
index = Count
End If
oldindex = index
Next i
AddFilePath = True
End Function
Private Function FindEntryByPath(ByVal path As String, _
Optional ByVal GetFiles As Boolean = True) As Integer
'Listen-Index einer Datei oder eines Ordners ermitteln
Dim i%
path = Trim(UCase(path))
For i = 1 To Count
If Entries(i).IsFile = GetFiles Then
If path = GetPath(i) Then
FindEntryByPath = i
Exit Function
End If
End If
Next i
FindEntryByPath = -1
End Function
Private Function GetPath(ByVal index As Integer) As String
'Zu einem Arrayindex den kompletten Pfad zusammenstellen
GetPath = ""
If index < 1 Or index > Count Then Exit Function
Dim path$, i%
i = index: path = ""
Do
path = Entries(i).name & "\" & path
i = Entries(i).Parent
Loop While i > 0
GetPath = path
End Function
Public Sub GetEntries(FolderPath As String, ByRef FolderEntries$(), _
Optional ByVal GetFiles As Boolean = True, _
Optional ByVal GetFullPath As Boolean = True)
'Alle Dateinamen (GetFiles=True) oder alle Unterordner (false)
'im FolderPath zurückgeben (Angabe mit \ abschließen)
Dim index%, i%, c%, ok As Boolean
index = FindEntryByPath(FolderPath, False)
If index < 1 Then
ReDim FolderEntries(0)
FolderEntries(0) = "Ordner nicht gefunden"
Exit Sub
End If
ReDim FolderEntries(10)
For i = 1 To Count
If Entries(i).IsFile = GetFiles And Entries(i).Parent = index Then
c = c + 1
If UBound(FolderEntries) = c Then
ReDim Preserve FolderEntries(c + 10)
End If
If Not GetFullPath Then
FolderEntries(c) = Entries(i).name
Else
FolderEntries(c) = GetPath(i)
FolderEntries(c) = _
Mid$(FolderEntries(c), 1, Len(FolderEntries(c)) - 1)
End If
End If
Next i
ReDim Preserve FolderEntries(c)
End Sub
Beitrag wurde zuletzt am 17.01.17 um 08:41:04 editiert. | |
| Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
Einloggen | Neu registrieren |
|
|
vb@rchiv CD Vol.6 vb@rchiv Vol.6
Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
Online-Update-Funktion Entwickler-Vollversionen u.v.m.Jetzt zugreifen Tipp des Monats sevGraph (VB/VBA)
Grafische Auswertungen
Präsentieren Sie Ihre Daten mit wenig Aufwand in grafischer Form. sevGraph unterstützt hierbei Balken-, Linien- und Stapel-Diagramme (Stacked Bars), sowie 2D- und 3D-Tortendiagramme und arbeitet vollständig datenbankunabhängig! Weitere Infos
|
|
|
Copyright ©2000-2024 vb@rchiv Dieter Otter Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.
Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel
|
|