Hallo
Ich suche etwas womit ich von einem Client auf einen Server zugreifen kann.
Das Programm oder Script soll je nachdem Plattform unabhängig sein welches mich zu Java bzw JavaScript bringt.
Jetzt hab ich das Problem das ich in Access 2003 schon etwas geschrieben habe. Dies ist mehr oder weniger etwas um die Dateien auf der Festplatte auszulesen und Informationen darüber zu bekommen. Dies werde ich auch im Anhang anhängen sodas Ihr wisst was ich bisher getan habe.
Zu dem eigentlichen Projekt:
Ich habe vor eine Datenbank zu erstellen und dort denn die Festplatten einer ficktiven Firma auszulesen wo die Server an bestimmten Standorten(z.B. München, Köln und Berlin) sind und ich von jedem anderen Geschäft aus den Admins zugriff gewähren kann. Auf den Servern liegen Installationsdateien von z. B. Adobe Reader oder ZoneAlarm .
Diese sind jedoch nur als *.exe vorhanden und der Admin sucht sich dann immer dumm und dämlich. Deshalb auch meine Datenbank. Das ganze ist für meine Prüfung zum IT-Systemelektroniker. Nur leider haben wir in unserer Ausbildung nichts vom programmieren gelernt, nur ein wenig C++ und da weiß ich aber auch nicht wie ich es machen soll. Jetzt habe ich in einem anderen Forum folgenden Quelltext gefunden, der mir das ausgibt was ich will. Das problem is jedoch das ich eine Datenbank habe aber kein Programm mit dem ich sie auf den einzelnen Servern öffnen kann.
Das Programm muss folgendes können:
Nur registrierte Benutzer zulassen die ein Benutzernamen und Passwort besitzen
Öffnen der Datenbank
Auf verschiedene Systeme zugreifen (Linux, Windows, usw.)
das wars erstmal sollten noch fragen sein bitte ich darum mir die zu stellen damit wir schnell zu einer geeignetten Lösung kommen.
MfG Marinesoldat001
Anhang:
Modul
Option Compare Database
' MODUL---------------------------------------------------------------------------
' Name: Dateiliste
Option Explicit
' Benötigte API-Deklarationen
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Const MAX_PATH = 260
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BFFM_SETSELECTION = &H466
Private Const BFFM_INITIALIZED = 1
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" ( _
ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" ( _
ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" ( _
lpbi As BrowseInfo) As Long
Private Declare Function SendMessage Lib "user32.dll" _
Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal Msg As Long, _
wParam As Any, _
lParam As Any) As Long
Private m_BrowseInitDir As String
Public datEigenschaft()
Public datGesGröße As Long
' Aufruf-Routine
' Vorgabewerte mit '##### gekennzeichnet
Sub Datei_Eigenschaften()
Dim sPath As String
Dim clsKlasse As New clsVerzeichnisbaum
Dim Pfad As String
Dim DateiTyp As String
Dim blattName As String
Dim Zaehler As Long
Dim n As Integer
Dim d As Variant
Dim schreibdatei As String
Dim Dateiname As String
Dim DosName As String
Dim PfadVerzeichnis As String
Dim Erstellt As String
Dim letzterZugriff As String
Dim letzterSchreibzugriff As String
Dim Dateigroese As String
' ##### Ordnerauswahldialog mit Vorselektion
Pfad = OrdnerAuswählen("Bitte Ordner auswählen", "C:\temp")
' Anwendung verlassen, wenn kein Verzeichnis ausgewählt wurde
If Pfad = "" Then Exit Sub
' ##### festlegen , welcher Dateityp gesucht wird ('*' - alle Dateien)
DateiTyp = "*" 'Textdatei
' ##### Aufruf des Klassenmoduls 'clsVerzeichnisbaun'
' bei TRUE werden die Unterverzeichnisse mit durchsucht
d = clsKlasse.DateilisteErstellen(Pfad, DateiTyp, True)
' neu dimensionieren
ReDim datEigenschaft(1 To 7, 1 To UBound(d))
' Dateieigenschaften in die Variable datEigenschaft() schreiben
For Zaehler = 1 To UBound(d)
' Dateiname
datEigenschaft(1, Zaehler) = d(Zaehler)(1)
' DOS-Name
datEigenschaft(2, Zaehler) = d(Zaehler)(2)
' Pfad
datEigenschaft(3, Zaehler) = d(Zaehler)(3)
' Erstellungszeitpunkt
datEigenschaft(4, Zaehler) = Format(d(Zaehler)(4), "DD.MM.YYYY hh:nn:ss")
' letzter Zugriff
datEigenschaft(5, Zaehler) = Format(d(Zaehler)(5), "DD.MM.YYYY hh:nn:ss")
' letzter Schreibzugriff
datEigenschaft(6, Zaehler) = Format(d(Zaehler)(6), "DD.MM.YYYY hh:nn:ss")
' Größe
datEigenschaft(7, Zaehler) = d(Zaehler)(7)
Next
For Zaehler = 1 To UBound(d)
schreibdatei = "c:\ablage\textschreiben.txt"
Dateiname = datEigenschaft(1, Zaehler)
DosName = datEigenschaft(2, Zaehler)
PfadVerzeichnis = datEigenschaft(3, Zaehler)
Erstellt = datEigenschaft(4, Zaehler)
letzterZugriff = datEigenschaft(5, Zaehler)
letzterSchreibzugriff = datEigenschaft(6, Zaehler)
Dateigroese = datEigenschaft(7, Zaehler)
Open schreibdatei For Append As 1
Write #1, Dateiname
Write #1, DosName
Write #1, PfadVerzeichnis
Write #1, Erstellt
Write #1, letzterZugriff
Write #1, letzterSchreibzugriff
Write #1, Dateigroese
Close 1
Next
'Ausgabe das Schreiben beendet ist
MsgBox "geschrieben"
' Abschnitt 'Augabe in eine Textdatei'
' "Dateiname"
' "Dos-Name"
' "Pfad/Verzeichnis"
' "Erstellt"
' "letzter Zugriff"
' "letzter Schreibzugriff"
' "Dateigröße"
'.Cells(Zaehler + 6, 7) = datGesGröße
'.Pfad
End Sub
' Ordnerauswahl-Dialog mit optionaler Angabe eines Startverzeichnisses
Public Function OrdnerAuswählen(ByVal sPrompt As String, _
Optional ByVal sInitDir As String) As String
Dim nPos As Long
Dim nIDList As Long
Dim sPath As String
Dim oInfo As BrowseInfo
m_BrowseInitDir = sInitDir
' Datenstruktur füllen
With oInfo
.hWndOwner = GetActiveWindow()
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
If sInitDir <> "" Then
' Callback-Funktionsadresse
.lpfnCallback = FuncCallback(AddressOf BrowseCallback)
End If
End With
' Dialog anzeigen und auswerten
nIDList = SHBrowseForFolder(oInfo)
If nIDList Then
sPath = String$(MAX_PATH, 0)
Call SHGetPathFromIDList(nIDList, sPath)
Call CoTaskMemFree(nIDList)
nPos = InStr(sPath, vbNullChar)
If nPos Then sPath = Left$(sPath, nPos - 1)
End If
OrdnerAuswählen = sPath
End Function
Private Function BrowseCallback(ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Select Case uMsg
Case BFFM_INITIALIZED
' Start-Ordner
Call SendMessage(hWnd, BFFM_SETSELECTION, ByVal 1&, _
ByVal m_BrowseInitDir)
End Select
BrowseCallback = 0
End Function
' Hilfsfunktion für AddressOf
Private Function FuncCallback(ByVal nParam As Long) As Long
FuncCallback = nParam
End Function
' --------------------------------------------------------------------------------
Klassenmodul
Option Compare Database
'Nachfolgenden Code in ein Klassenmodul einfügen:
' KLASSENMODUL ---------------------------------------------------------
' Name: clsVerzeichnisbaum
Option Explicit
' benötigte API-Deklarationen
Private Declare Function FindClose Lib "kernel32" ( _
ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" ( _
ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" _
Alias "FindNextFileA" ( _
ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" ( _
lpFileTime As FILETIME, _
lpSystemTime As SYSTEMTIME) As Long
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const MAX_PATH = 260
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private iDateiliste()
Private myIndex As Long
Private Function DurchlaufePfad(ByVal Pfadname As String, _
ByVal Erweiterung As String, _
ByVal Verzeichnis As Boolean) As Currency
Dim Suchhandle As Long, Rück As Long
Dim Filedaten As WIN32_FIND_DATA
Dim Suchkriterium As String
Dim strFileName As String
Dim strDosName As String
Dim Verzeichnisgröße As Currency
Dim Eigenschaft(1 To 7)
' Führende und nachfolgende Leerzeichen entfernen
Pfadname = Trim(Pfadname)
' Wenn nötig, Backslash anhängen
If Right$(Pfadname, 1) <> "\" Then Pfadname = Pfadname & "\"
' Alle Dateien suchen
Suchkriterium = Pfadname & "*" ' für alle Dateien
With Filedaten
.cAlternate = String(14, Chr(0))
.cFileName = String(260, Chr(0))
' Erstes Filehandle auf dieser Ebene ermitteln
Suchhandle = FindFirstFile(Suchkriterium, Filedaten)
Rück = Suchhandle
Do While Rück <> 0
' Datei gefunden
Verzeichnisgröße = 0
strFileName = StrSpaceNullTrim(.cFileName)
strDosName = StrSpaceNullTrim(.cAlternate)
If strFileName <> ".." And strFileName <> "." Then
' Directory oder File gefunden.
' Vorheriges Verzeichnis (.), oder Wurzelverzeichnis (..) ignorieren
If (.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY And _
Verzeichnis = True Then
' Rekursiver Aufruf, wenn Unterverzeichnis
Verzeichnisgröße = DurchlaufePfad((Pfadname & strFileName), Erweiterung, Verzeichnis)
Else
' Passt das Suchmuster?
If Erweiterung = Right(strFileName, Len(Erweiterung)) Or Erweiterung = "*" Then
' Datei Infos in Array Eigenschaft kopieren
Eigenschaft(1) = strFileName
If Len(strDosName) = 0 Then strDosName = strFileName
Eigenschaft(2) = strDosName
Eigenschaft(3) = Pfadname
Eigenschaft(4) = Zeitumwandlung(.ftCreationTime)
Eigenschaft(5) = Zeitumwandlung(.ftLastAccessTime)
Eigenschaft(6) = Zeitumwandlung(.ftLastWriteTime)
Eigenschaft(7) = .nFileSizeLow
datGesGröße = datGesGröße + Eigenschaft(7)
myIndex = myIndex + 1
' Wenn mehr Dateien vorhanden, als iDateiliste aufnehmen
' kann, Array Redimensionieren und Werte beibehalten
If myIndex > UBound(iDateiliste) Then _
ReDim Preserve iDateiliste(1 To myIndex + 1000)
iDateiliste(myIndex) = Eigenschaft
End If
End If
End If
.cAlternate = String(14, Chr(0))
.cFileName = String(260, Chr(0))
' Nächste Datei
Rück = FindNextFile(Suchhandle, Filedaten)
Loop
End With
FindClose Suchhandle
End Function
Public Function DateilisteErstellen(Startpfad As String, _
Erweiterung As String, _
Unterverzeichnis As Boolean)
On Error Resume Next
ReDim iDateiliste(1 To 1000)
DurchlaufePfad Startpfad, Erweiterung, Unterverzeichnis
If myIndex = 0 Then
ReDim iDateiliste(0)
Else
ReDim Preserve iDateiliste(1 To myIndex)
End If
DateilisteErstellen = iDateiliste
End Function
Private Function StrSpaceNullTrim(X As String) As String
StrSpaceNullTrim = Trim(Left(X, InStr(1, X, Chr(0)) - 1))
End Function
Private Function Zeitumwandlung(Filezeit As FILETIME) As Date
Dim S_Zeit As SYSTEMTIME
' Umwandlung Filezeit in Systemzeit
FileTimeToSystemTime Filezeit, S_Zeit
If S_Zeit.wYear >= 1900 Then
Zeitumwandlung = CDbl(DateSerial(S_Zeit.wYear, _
S_Zeit.wMonth, S_Zeit.wDay) _
+ TimeSerial(S_Zeit.wHour, S_Zeit.wMinute, S_Zeit.wSecond))
Else
Zeitumwandlung = 0
End If
End Function
' ----------------------------------------------------------------------
Ich suche etwas womit ich von einem Client auf einen Server zugreifen kann.
Das Programm oder Script soll je nachdem Plattform unabhängig sein welches mich zu Java bzw JavaScript bringt.
Jetzt hab ich das Problem das ich in Access 2003 schon etwas geschrieben habe. Dies ist mehr oder weniger etwas um die Dateien auf der Festplatte auszulesen und Informationen darüber zu bekommen. Dies werde ich auch im Anhang anhängen sodas Ihr wisst was ich bisher getan habe.
Zu dem eigentlichen Projekt:
Ich habe vor eine Datenbank zu erstellen und dort denn die Festplatten einer ficktiven Firma auszulesen wo die Server an bestimmten Standorten(z.B. München, Köln und Berlin) sind und ich von jedem anderen Geschäft aus den Admins zugriff gewähren kann. Auf den Servern liegen Installationsdateien von z. B. Adobe Reader oder ZoneAlarm .
Diese sind jedoch nur als *.exe vorhanden und der Admin sucht sich dann immer dumm und dämlich. Deshalb auch meine Datenbank. Das ganze ist für meine Prüfung zum IT-Systemelektroniker. Nur leider haben wir in unserer Ausbildung nichts vom programmieren gelernt, nur ein wenig C++ und da weiß ich aber auch nicht wie ich es machen soll. Jetzt habe ich in einem anderen Forum folgenden Quelltext gefunden, der mir das ausgibt was ich will. Das problem is jedoch das ich eine Datenbank habe aber kein Programm mit dem ich sie auf den einzelnen Servern öffnen kann.
Das Programm muss folgendes können:
Nur registrierte Benutzer zulassen die ein Benutzernamen und Passwort besitzen
Öffnen der Datenbank
Auf verschiedene Systeme zugreifen (Linux, Windows, usw.)
das wars erstmal sollten noch fragen sein bitte ich darum mir die zu stellen damit wir schnell zu einer geeignetten Lösung kommen.
MfG Marinesoldat001
Anhang:
Modul
Option Compare Database
' MODUL---------------------------------------------------------------------------
' Name: Dateiliste
Option Explicit
' Benötigte API-Deklarationen
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Const MAX_PATH = 260
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BFFM_SETSELECTION = &H466
Private Const BFFM_INITIALIZED = 1
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" ( _
ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" ( _
ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" ( _
lpbi As BrowseInfo) As Long
Private Declare Function SendMessage Lib "user32.dll" _
Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal Msg As Long, _
wParam As Any, _
lParam As Any) As Long
Private m_BrowseInitDir As String
Public datEigenschaft()
Public datGesGröße As Long
' Aufruf-Routine
' Vorgabewerte mit '##### gekennzeichnet
Sub Datei_Eigenschaften()
Dim sPath As String
Dim clsKlasse As New clsVerzeichnisbaum
Dim Pfad As String
Dim DateiTyp As String
Dim blattName As String
Dim Zaehler As Long
Dim n As Integer
Dim d As Variant
Dim schreibdatei As String
Dim Dateiname As String
Dim DosName As String
Dim PfadVerzeichnis As String
Dim Erstellt As String
Dim letzterZugriff As String
Dim letzterSchreibzugriff As String
Dim Dateigroese As String
' ##### Ordnerauswahldialog mit Vorselektion
Pfad = OrdnerAuswählen("Bitte Ordner auswählen", "C:\temp")
' Anwendung verlassen, wenn kein Verzeichnis ausgewählt wurde
If Pfad = "" Then Exit Sub
' ##### festlegen , welcher Dateityp gesucht wird ('*' - alle Dateien)
DateiTyp = "*" 'Textdatei
' ##### Aufruf des Klassenmoduls 'clsVerzeichnisbaun'
' bei TRUE werden die Unterverzeichnisse mit durchsucht
d = clsKlasse.DateilisteErstellen(Pfad, DateiTyp, True)
' neu dimensionieren
ReDim datEigenschaft(1 To 7, 1 To UBound(d))
' Dateieigenschaften in die Variable datEigenschaft() schreiben
For Zaehler = 1 To UBound(d)
' Dateiname
datEigenschaft(1, Zaehler) = d(Zaehler)(1)
' DOS-Name
datEigenschaft(2, Zaehler) = d(Zaehler)(2)
' Pfad
datEigenschaft(3, Zaehler) = d(Zaehler)(3)
' Erstellungszeitpunkt
datEigenschaft(4, Zaehler) = Format(d(Zaehler)(4), "DD.MM.YYYY hh:nn:ss")
' letzter Zugriff
datEigenschaft(5, Zaehler) = Format(d(Zaehler)(5), "DD.MM.YYYY hh:nn:ss")
' letzter Schreibzugriff
datEigenschaft(6, Zaehler) = Format(d(Zaehler)(6), "DD.MM.YYYY hh:nn:ss")
' Größe
datEigenschaft(7, Zaehler) = d(Zaehler)(7)
Next
For Zaehler = 1 To UBound(d)
schreibdatei = "c:\ablage\textschreiben.txt"
Dateiname = datEigenschaft(1, Zaehler)
DosName = datEigenschaft(2, Zaehler)
PfadVerzeichnis = datEigenschaft(3, Zaehler)
Erstellt = datEigenschaft(4, Zaehler)
letzterZugriff = datEigenschaft(5, Zaehler)
letzterSchreibzugriff = datEigenschaft(6, Zaehler)
Dateigroese = datEigenschaft(7, Zaehler)
Open schreibdatei For Append As 1
Write #1, Dateiname
Write #1, DosName
Write #1, PfadVerzeichnis
Write #1, Erstellt
Write #1, letzterZugriff
Write #1, letzterSchreibzugriff
Write #1, Dateigroese
Close 1
Next
'Ausgabe das Schreiben beendet ist
MsgBox "geschrieben"
' Abschnitt 'Augabe in eine Textdatei'
' "Dateiname"
' "Dos-Name"
' "Pfad/Verzeichnis"
' "Erstellt"
' "letzter Zugriff"
' "letzter Schreibzugriff"
' "Dateigröße"
'.Cells(Zaehler + 6, 7) = datGesGröße
'.Pfad
End Sub
' Ordnerauswahl-Dialog mit optionaler Angabe eines Startverzeichnisses
Public Function OrdnerAuswählen(ByVal sPrompt As String, _
Optional ByVal sInitDir As String) As String
Dim nPos As Long
Dim nIDList As Long
Dim sPath As String
Dim oInfo As BrowseInfo
m_BrowseInitDir = sInitDir
' Datenstruktur füllen
With oInfo
.hWndOwner = GetActiveWindow()
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
If sInitDir <> "" Then
' Callback-Funktionsadresse
.lpfnCallback = FuncCallback(AddressOf BrowseCallback)
End If
End With
' Dialog anzeigen und auswerten
nIDList = SHBrowseForFolder(oInfo)
If nIDList Then
sPath = String$(MAX_PATH, 0)
Call SHGetPathFromIDList(nIDList, sPath)
Call CoTaskMemFree(nIDList)
nPos = InStr(sPath, vbNullChar)
If nPos Then sPath = Left$(sPath, nPos - 1)
End If
OrdnerAuswählen = sPath
End Function
Private Function BrowseCallback(ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Select Case uMsg
Case BFFM_INITIALIZED
' Start-Ordner
Call SendMessage(hWnd, BFFM_SETSELECTION, ByVal 1&, _
ByVal m_BrowseInitDir)
End Select
BrowseCallback = 0
End Function
' Hilfsfunktion für AddressOf
Private Function FuncCallback(ByVal nParam As Long) As Long
FuncCallback = nParam
End Function
' --------------------------------------------------------------------------------
Klassenmodul
Option Compare Database
'Nachfolgenden Code in ein Klassenmodul einfügen:
' KLASSENMODUL ---------------------------------------------------------
' Name: clsVerzeichnisbaum
Option Explicit
' benötigte API-Deklarationen
Private Declare Function FindClose Lib "kernel32" ( _
ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" ( _
ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" _
Alias "FindNextFileA" ( _
ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" ( _
lpFileTime As FILETIME, _
lpSystemTime As SYSTEMTIME) As Long
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const MAX_PATH = 260
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private iDateiliste()
Private myIndex As Long
Private Function DurchlaufePfad(ByVal Pfadname As String, _
ByVal Erweiterung As String, _
ByVal Verzeichnis As Boolean) As Currency
Dim Suchhandle As Long, Rück As Long
Dim Filedaten As WIN32_FIND_DATA
Dim Suchkriterium As String
Dim strFileName As String
Dim strDosName As String
Dim Verzeichnisgröße As Currency
Dim Eigenschaft(1 To 7)
' Führende und nachfolgende Leerzeichen entfernen
Pfadname = Trim(Pfadname)
' Wenn nötig, Backslash anhängen
If Right$(Pfadname, 1) <> "\" Then Pfadname = Pfadname & "\"
' Alle Dateien suchen
Suchkriterium = Pfadname & "*" ' für alle Dateien
With Filedaten
.cAlternate = String(14, Chr(0))
.cFileName = String(260, Chr(0))
' Erstes Filehandle auf dieser Ebene ermitteln
Suchhandle = FindFirstFile(Suchkriterium, Filedaten)
Rück = Suchhandle
Do While Rück <> 0
' Datei gefunden
Verzeichnisgröße = 0
strFileName = StrSpaceNullTrim(.cFileName)
strDosName = StrSpaceNullTrim(.cAlternate)
If strFileName <> ".." And strFileName <> "." Then
' Directory oder File gefunden.
' Vorheriges Verzeichnis (.), oder Wurzelverzeichnis (..) ignorieren
If (.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY And _
Verzeichnis = True Then
' Rekursiver Aufruf, wenn Unterverzeichnis
Verzeichnisgröße = DurchlaufePfad((Pfadname & strFileName), Erweiterung, Verzeichnis)
Else
' Passt das Suchmuster?
If Erweiterung = Right(strFileName, Len(Erweiterung)) Or Erweiterung = "*" Then
' Datei Infos in Array Eigenschaft kopieren
Eigenschaft(1) = strFileName
If Len(strDosName) = 0 Then strDosName = strFileName
Eigenschaft(2) = strDosName
Eigenschaft(3) = Pfadname
Eigenschaft(4) = Zeitumwandlung(.ftCreationTime)
Eigenschaft(5) = Zeitumwandlung(.ftLastAccessTime)
Eigenschaft(6) = Zeitumwandlung(.ftLastWriteTime)
Eigenschaft(7) = .nFileSizeLow
datGesGröße = datGesGröße + Eigenschaft(7)
myIndex = myIndex + 1
' Wenn mehr Dateien vorhanden, als iDateiliste aufnehmen
' kann, Array Redimensionieren und Werte beibehalten
If myIndex > UBound(iDateiliste) Then _
ReDim Preserve iDateiliste(1 To myIndex + 1000)
iDateiliste(myIndex) = Eigenschaft
End If
End If
End If
.cAlternate = String(14, Chr(0))
.cFileName = String(260, Chr(0))
' Nächste Datei
Rück = FindNextFile(Suchhandle, Filedaten)
Loop
End With
FindClose Suchhandle
End Function
Public Function DateilisteErstellen(Startpfad As String, _
Erweiterung As String, _
Unterverzeichnis As Boolean)
On Error Resume Next
ReDim iDateiliste(1 To 1000)
DurchlaufePfad Startpfad, Erweiterung, Unterverzeichnis
If myIndex = 0 Then
ReDim iDateiliste(0)
Else
ReDim Preserve iDateiliste(1 To myIndex)
End If
DateilisteErstellen = iDateiliste
End Function
Private Function StrSpaceNullTrim(X As String) As String
StrSpaceNullTrim = Trim(Left(X, InStr(1, X, Chr(0)) - 1))
End Function
Private Function Zeitumwandlung(Filezeit As FILETIME) As Date
Dim S_Zeit As SYSTEMTIME
' Umwandlung Filezeit in Systemzeit
FileTimeToSystemTime Filezeit, S_Zeit
If S_Zeit.wYear >= 1900 Then
Zeitumwandlung = CDbl(DateSerial(S_Zeit.wYear, _
S_Zeit.wMonth, S_Zeit.wDay) _
+ TimeSerial(S_Zeit.wHour, S_Zeit.wMinute, S_Zeit.wSecond))
Else
Zeitumwandlung = 0
End If
End Function
' ----------------------------------------------------------------------
