Laufwerk, Ordner, Datei ermitteln #2

[eknori]

Hier etwas für die Puristen, die nichts von der Windows API halten  

Mit der Funktion ExistFileDirDrive könnt ihr die Existenz sowohl von Dateien, Verzeichnissen als auch Laufwerken prüfen. Bei der Prüfung der Existenz eines Verzeichnisses ist es egal, ob der übergebene Pfadname mit einem Backslash "\" abschließt oder nicht. Die Funktion kommt auch ohne weiteres mit UNC-Pfadangaben zurecht.

Zur Prüfung der Existenz eines Laufwerks könnt ihr nicht nur "nackte" Laufwerksbuchstaben oder Laufwerksbuchstaben plus Doppelpunkt zur Prüfung übergeben, sondern auch beliebige Verzeichnis- oder Datei-Pfade - existiert ein Verzeichnis oder eine Datei, existiert zwangsläufig auch das Laufwerk. Das gilt natürlich auch bei der Frage nach der Existenz eines Pfades - existiert eine Datei in einem Pfad, existiert ebenso das Verzeichnis, in dem sie sich befindet. Die letzten beiden Anmerkungen mögen Ihnen zwar trivial und überflüssig vorkommen - aber manchmal kommt man einfach nicht auf die trivialsten Lösungen, oder...?

Im Gegensatz zu vielen Lösungen, die bei der Prüfung der Existenz einer Datei diese zu öffnen versuchen, greift die Funktion ExistFileDirDrive auf die Dateiattribute zu (GetAttr). Damit werden Probleme mit Dateisperrungen, zufälliger Erzeugung doch noch nicht vorhandener Dateien und mit den Zeitattributen (Anlegen, letzte Modifikation) vermieden.


( http://www.eknori.de/downloads/ExistFileDirDrive.zip )


Sub Click(Source As Button)
     Dim dummy As Integer
     dummy = ExistFileDirDrive("c:\my downloads")
     If dummy > 0 Then      
           Msgbox "Yoo, ist da"
     Else
           Msgbox "Nö, nicht gefunden"
     End If
End Sub

Function ExistFileDirDrive(FilePathName As String) As Integer
     Dim nTest As String
     
     nTest = Lcase$(FilePathName)
     If Len(nTest) = 1 Then
           Select Case Left$(nTest, 1)
           Case "a" To "z"
                 nTest = FilePathName & ":\"
           End Select
     Elseif Len(nTest) = 2 Then
           Select Case Left$(nTest, 2)
           Case "a:" To "z:"
                 nTest = FilePathName & "\"
           End Select
     End If
     On Error Resume Next
     ExistFileDirDrive = Cint(Getattr(nTest) Or vbNormal _
     Or vbHidden Or vbSystem Or vbArchive Or vbDirectory)
End Function

[TMC]

Die Lösung von Ulrich stammt wohl ursprünglich von VBA (wegen vbNormal etc.) und ist ohne Option Declare, aber ist schließlich auch schon älter.
Bzw. sehr alt, wenn man auf "Letzte Änderung" schaut:

« Letzte Änderung: 01.01.70 - 01:00:00 von 1034200800 »

Ich habe aber genau sowas heute gebraucht, und leicht modifiziert.

Code

Public Function ExistsWindowsDirFile(strWinFilePath As String) As Integer
	
%REM
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Purpose:
Checks if a directory or file exists.
-----------------------------------------------------------------------------------------------------
Returns:
True if the provided file or directory exists and False if not.
-----------------------------------------------------------------------------------------------------
Used functions/subs:
 * ErrorMessage -- a standard error handling procedure.
-----------------------------------------------------------------------------------------------------
Example:
	Sub Click(Source As Button)
		Dim strRetInputbox As String
		Dim intFunctionRet As Integer
		strRetInputbox = Inputbox$("Enter path of directory or complete path of a file:")
		If strRetInputbox = "" Then Exit Sub
		intFunctionRet = ExistsWindowsDirFile(strRetInputbox)
		If (intFunctionRet = True) Then
			Msgbox "Provided directory or file does exist :-)", 64
		Else
			Msgbox "File or directory not found !", 48
		End If
	End Sub
-----------------------------------------------------------------------------------------------------
History:
Feb 17, 2002		Ulrich Krause		New
Feb 27, 2005		Matthias TMC	Several changes
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////	
%END REM
	
	On Error Goto ErrorHandler
	
	Dim intReturn As Integer
	
	'// Prepare source string
	strWinFilePath = Lcase$(Trim$(strWinFilePath))
	
	'// Add colon and/or back slash (if missing and if provided path is a drive)
	If Len(strWinFilePath) = 1 Then
		Select Case strWinFilePath
		Case "a" To "z":	strWinFilePath = strWinFilePath & ":\"
		Case Else:			Exit Function 'False will be returned
		End Select
	Elseif Len(strWinFilePath) = 2 Then
		Select Case strWinFilePath
		Case "a:" To "z:":		strWinFilePath = strWinFilePath & "\"
		Case Else:				Exit Function 'False will be returned
		End Select
	End If	
	
	'// The trick. A runtime-error #53 will occur if dir/file cannot be found.
	intReturn = Getfileattr(strWinFilePath)
	
	'// No runtime-error occured, so we return True (because now we can assume that dir/file exists)
	ExistsWindowsDirFile = True
	
GoOut:
	Exit Function
ErrorHandler:
	Select Case Err
	Case 53: ' 53 = File not found
		ExistsWindowsDirFile = False
		Resume GoOut
	Case Else:
		ExistsWindowsDirFile = False
		ErrorMessage "ExistsWindowsDirFile"
		Resume GoOut
	End Select
End Function