161 lines
3.7 KiB
QBasic
161 lines
3.7 KiB
QBasic
Attribute VB_Name = "modFileIO"
|
|
'==============================================================================
|
|
'
|
|
' File : FileIO.bas
|
|
' Date : 11.02.1999
|
|
' Version: 1.00
|
|
' Author : Andreas Schmidt, lindner&partner
|
|
'
|
|
'==============================================================================
|
|
'
|
|
' *shared*
|
|
'
|
|
' Hilfsfunktionen für FileIO
|
|
'
|
|
'==============================================================================
|
|
'
|
|
' History:
|
|
'
|
|
' Date : 11.02.1999
|
|
' Version: 1.00
|
|
' Author : Andreas Schmidt, lindner&partner
|
|
'
|
|
' Erste Version.
|
|
'
|
|
'==============================================================================
|
|
|
|
Option Explicit
|
|
|
|
' Testen, ob Datei vorhanden ist
|
|
'
|
|
' @param sFilename Dateiname inkl. Path
|
|
' @return true = Datei ist vorhanden,
|
|
' false = Datei wurde nicht gefunden
|
|
'
|
|
Public Function isFile(sFilename As String) As Boolean
|
|
Dim fso As New Scripting.FileSystemObject
|
|
Dim file As Scripting.file
|
|
|
|
On Error GoTo isFileErr
|
|
If sFilename <> "" Then Set file = fso.GetFile(sFilename)
|
|
isFile = (Not file Is Nothing)
|
|
Exit Function
|
|
|
|
isFileErr:
|
|
Exit Function
|
|
|
|
End Function
|
|
|
|
' Testen, ob Directory vorhanden ist
|
|
'
|
|
' @param sFilename Dateiname inkl. Path
|
|
' @return true = Datei ist vorhanden,
|
|
' false = Datei wurde nicht gefunden
|
|
'
|
|
Public Function isDir(sDir As String) As Boolean
|
|
Dim fso As New Scripting.FileSystemObject
|
|
|
|
On Error GoTo isDirErr
|
|
If sDir <> "" Then isDir = fso.FolderExists(sDir)
|
|
Exit Function
|
|
|
|
isDirErr:
|
|
Exit Function
|
|
|
|
End Function
|
|
|
|
' Directory-Komponente eines kompletten Filenames zurückgeben.
|
|
'
|
|
' @param sPath Filename inkl. Path
|
|
'
|
|
Public Function getDirectory(sFilename As String) As String
|
|
Dim fso As New Scripting.FileSystemObject
|
|
Dim f As Scripting.file
|
|
|
|
On Error GoTo getDirectoryErr
|
|
|
|
Set f = fso.GetFile(sFilename)
|
|
getDirectory = f.ParentFolder
|
|
Exit Function
|
|
|
|
getDirectoryErr:
|
|
Exit Function
|
|
|
|
End Function
|
|
|
|
' @return Dateinamenskomponente eines kompletten Filenames
|
|
'
|
|
' @param sPath Filename inkl. Path
|
|
'
|
|
' Hier nicht mit Scripting.FileSystemObject arbeiten, da es
|
|
' damit nur funktioniert, wenn die angegebene Datei auch
|
|
' wirklich vorhanden ist!
|
|
'
|
|
Public Function getFilename(sFilename As String) As String
|
|
Dim nPos As Integer
|
|
|
|
Do While InStr(nPos + 1, sFilename, "\") > 0
|
|
nPos = InStr(nPos + 1, sFilename, "\")
|
|
Loop
|
|
|
|
getFilename = Mid$(sFilename, nPos + 1)
|
|
End Function
|
|
|
|
' @return DateLastModified der angegebenen Datei
|
|
'
|
|
Public Function getFileDate(sFilename As String) As Date
|
|
On Error GoTo getFileDateErr
|
|
|
|
Dim fso As Scripting.FileSystemObject
|
|
Dim fFile As Scripting.file
|
|
|
|
Set fso = New Scripting.FileSystemObject
|
|
Set fFile = fso.GetFile(sFilename)
|
|
|
|
getFileDate = fFile.DateLastModified
|
|
Exit Function
|
|
|
|
getFileDateErr:
|
|
Exit Function
|
|
|
|
End Function
|
|
|
|
' Kompletten Pathname zurückgeben
|
|
'
|
|
' @param sDir Directoryvorgabe
|
|
' @param sFilename Name der Datei
|
|
'
|
|
Public Function makePathname(sDir As String, sFilename As String) As String
|
|
Dim sRet As String
|
|
|
|
sRet = sDir
|
|
|
|
If Right$(sRet, 1) <> "\" And sRet <> "" Then sRet = sRet + "\"
|
|
sRet = sRet + sFilename
|
|
|
|
makePathname = sRet
|
|
End Function
|
|
|
|
' Datei löschen
|
|
'
|
|
' @param sFilename Name der Datei
|
|
'
|
|
' @return true = Datei erfolgreich entfernt
|
|
' false = Datei konnte nicht gelöscht werden
|
|
'
|
|
Public Function removeFile(sFilename As String) As Boolean
|
|
Dim fso As New Scripting.FileSystemObject
|
|
Dim f As Scripting.file
|
|
|
|
On Error GoTo removeFileErr
|
|
|
|
Set f = fso.GetFile(sFilename)
|
|
Call f.delete
|
|
|
|
removeFile = True
|
|
Exit Function
|
|
|
|
removeFileErr:
|
|
Exit Function
|
|
End Function
|