Übersicht
0001 Datei auf Existenz prüfen
![]() | Fast in jeder Applikation notwendig und in vielen Varianten im Netz zu finden, hier unsere Version:
' Prüft auf Existenz der übergebenen Datei. Hierbei werden
' auch die Attribute Hidden und System mit eingebunden!
Public Function file_exist(ByVal file As String) As Boolean
On Error GoTo FuncError
If (file <> "") Then
file_exist = (Dir(file, vbHidden + vbSystem) <> "")
Else
file_exist = False
End If
Exit Function
FuncError:
file_exist = False
End Function
|
| Autor: ralf schlegel Stand: 10/2004 |
0002 Windows-Pfad ermitteln
![]() | Die Position des Windowsverzeichnisses läßt sich leicht mit der API-Funktion GetWindowsDirectory ermitteln. Beachten Sie lediglich, dass Sie bei der Pufferübergabe den String zuvor mit Leerzeichen füllen. Das kann schon in der Zeile der Variabelndeklaration geschehen: Dim temp As String * 255 legt die Variabel temp nicht nur an, sondern füllt sie auch gleichzeitig mit 255 Zeichen (s.u.).
' Deklaration:
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As Long) As Long
' Funktion:
Public Function getWinFolder() As String
Dim sLen As Long
Dim temp As String * 255
sLen = GetWindowsDirectory(temp, Len(temp))
getWinFolder = Left$(temp, sLen)
End Function
|
| Autor: ralf schlegel Stand: 10/2004 |
0003 Special Folders
![]() | Um Dateien dynamisch aus den Anwenderverzeichnissen zu laden und wieder abzuspeichern ist es notwendig die Lage dieser Ordner zu ermitteln, denn "Eigene Dateien", "Eigene Bilder" , etc. können vom Benutzer an beliebigen Stellen eingerichtet worden sein. Wie man die Vielzahl der Ordner abfragt und vernünftig verwaltet erfahren Sie in diesem Demoprojekt... |
| Autor: ralf schlegel Stand: 11/2004 |
0004 Windows Papierkorb verwenden
![]() | Statt mit der Basic-Anweisung "Kill" eine Datei entgültig ins Nirvana zu schicken, ist es wesentlich eleganter diese nach Explorermanier in den Papierkorb zu verschieben! Dazu benötigt man die API-Funktion SHFileOperation . Diese Funktion bietet gleich mehrere Vorteile: zum einen kann sie mehrere Datein und Verzeichnisse auf einmal löschen, zum anderen ist sie auch in der Lage eine oder mehrere Datein zu kopieren, verschieben oder umzubenennen. Den vollen Funktionsumfang, sowie eine Beschreibung aller möglichen Flags finden Sie in der Tipp-Rubrik API, hier gehen wir nur auf das Löschen ein... ' Deklaration: Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" _ |
| Autor: ralf schlegel Stand: 12/2004 |
0005 BrowseForFolder (Verzeichnisauswahl-Dialog)
![]() | Die windowsinterne API-Routine zur Verzeichnisauswahl lässt sich unter Visual Basic nicht so ohne Weiteres nutzen. Es gibt im Netz einige Beispiele, wie man so etwas dennoch bewerkstelligen kann. Die hier zum Download bereitgestellte Variante von Marco Wünschmann kann jedoch noch einiges mehr! Für uns: Best Code 2004 - Gratulation Marco! |
| Autor: marco wünschmann EMail: siehe Quellcode Stand: 01/2004 |
0006 Dateipfad setzen / ermitteln (auch für Netzwerk)
0007 Erweiterte Dateiattribute
|
| Warum auch immer: die VBA Funktionen GetAttr und SetAttr scheinen spätestens ab Windows Vista hin und wieder Probleme zu bereiten. Erst recht, wenn sie im Batch (mehrer Dateien hintereinander) benutzt werden. Ausserdem stehen neuere Attribute, wie z.B.: compressed, nicht direkt in der Eingabe zur Verfügung, da sie in der Enumeration des alten VBA nicht angelegt wurden. Der folgende Codeabschnitt zeigt den besser funktionierenden API-Ersatz, der zusätzlich noch UNICODE und UNC-Path unterstützt! D.h.: Der übergebene Dateiname ist nicht mehr auf MAX_PATH (256-Zeichen) beschränkt und ''\\Servername\Verzeichnis1\MeineDatei.dat'' kann auch als Dateiname übergeben werden (vorausgesetzt, Sie haben auf dem Netzlaufwerk Schreibrechte). Kopieren Sie den Code in ein beliebiges Projektmodul.
Private Declare Function GetFileAttributesA Lib "kernel32" (ByVal lpFileName As String) As Long
Private Declare Function GetFileAttributesW Lib "kernel32" (ByVal lpFileName As Long) As Long
Private Declare Function SetFileAttributesA Lib "kernel32" (ByVal lpFileName As String, _
ByVal dwFileAttributes As Long) As Long
Private Declare Function SetFileAttributesW Lib "kernel32" (ByVal lpFileName As Long, _
ByVal dwFileAttributes As Long) As Long
Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInfo As OSVERSIONINFO) As Long
' Typendefinition Betriebssystem ermitteln:
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
Public Enum vbzFileAttrib
FILE_ATTRIBUTE_READONLY = &H1
FILE_ATTRIBUTE_HIDDEN = &H2
FILE_ATTRIBUTE_SYSTEM = &H4
FILE_ATTRIBUTE_VOLUME = &H8 ' Readonly Attribut! Nicht in SetAttr verwenden!
FILE_ATTRIBUTE_DIRECTORY = &H10
FILE_ATTRIBUTE_ARCHIVE = &H20
FILE_ATTRIBUTE_ALIAS = &H40
FILE_ATTRIBUTE_NORMAL = &H80
FILE_ATTRIBUTE_TEMPORARY = &H100
FILE_ATTRIBUTE_REPARSE_POINT = &H400
FILE_ATTRIBUTE_COMPRESSED = &H800
FILE_ATTRIBUTE_OFFLINE = &H1000
FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = &H2000
FILE_ATTRIBUTE_ENCRYPTED = &H4000
End Enum
' Prüft auf NT (Unicode)-Betriebssysteme:
' True bei NT/2000/XP/Vista/Win7, sonst False
Private Function isUnicode() As Boolean
Dim info As OSVERSIONINFO
info.dwOSVersionInfoSize = Len(info)
GetVersionExA info
isUnicode = (info.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
Public Function GetAttr(ByVal fName As String) As vbzFileAttrib
If isUnicode Then
If Left$(fName, 2) = "\\" Then fName = "UNC\" & Mid$(fName, 3)
GetAttr = GetFileAttributesW(StrPtr("\\?\" & fName))
Else
GetAttr = GetFileAttributesA(fName)
End If
End Function
Public Function SetAttr(ByVal fName As String, ByVal Attributes As vbzFileAttrib) As Boolean
If isUnicode Then
If Left$(fName, 2) = "\\" Then fName = "UNC\" & Mid$(fName, 3)
SetAttr = CBool(SetFileAttributesW(StrPtr("\\?\" & fName), Attributes))
Else
SetAttr = CBool(SetFileAttributesA(fName, Attributes))
End If
End Function
|
| Autor: ralf schlegel Stand: 05/2011 |








