Beschreibung
Unter Windows-Betriebssystemen gibt es eine Regel, die besagt, dass ein Verzeichniseintrag lediglich 260 Zeichen lang sein darf, das Windows-Dateisystem NTFS ist aber sehr wohl in der Lage, längere Einträge zu verwalten. Es wäre beispielsweise möglich, eine Freigabe (\\Server\Projekt\) mit einem Laufwerk (z:\) zu verbinden, die auf dem Server bereits 60 Zeichen lang ist (D:\Bereich\Abteilung\Projekte\Ein viel zu langer Projektname\). Auf dem Client wären also noch 257 Zeichen für Verzeichniseinträge und Dateinamen möglich, die, wenn sie genutzt werden, dazu führen, dass man auf diese Daten lokal auf dem Server nicht mehr direkt zugreifen könnte, da im Explorer bei 260 Zeichen Schluss ist. Das wird dann sehr mühsam, wenn solche Laufwerke migriert werden müssen. Um diese Probleme vorab festzustellen, dient das hier erstellte Programm, das lediglich auf die internen Funktionalitäten von Visual Basic 6 zugreift und keinerlei Erweiterungen benötigt.
Das Projekt
Wenn Sie die Visual Basic IDE starten öffnet sich automatisch der Dialog für ein neues Projekt. Analog können Sie diesen aber auch aus dem Menü 'Datei' mit dem Befehl 'Neues Projekt' oder der Tastenkombination STRG+N aufrufen. Wählen Sie jetzt bitte die Vorlage 'Standard-EXE' und bestätigen das mit Ok. Daraufhin wird das Projekt selbst und ein Formular erstellt. Das Formular benötigen wir später auch, jetzt kann es zunächst einmal geschlossen werden.
Sie können dann den Projekt Explorer im Menü 'Anzeige' finden oder mit der Tastenkombination STRG+R aufrufen, sollte er noch nicht geöffnet sein. Dort wird Ihnen das Projekt jetzt als Baumstruktur angezeigt und Sie können Änderungen an Eigenschaften vornehmen und Objekte bearbeiten. Der erste Eintrag bezeichnet das Projekt selbst und sollte noch 'Projekt1 (Projekt1)' lauten, was wir jetzt ändern wollen. Markieren Sie den Eintrag mit der Maus und drücken F4 um das Eigenschaften Fenster für das Projekt zu öffnen. Dort ändern Sie bitte den Namen in 'CheckPathLength' und bestätigen es mit ENTER. Der neue Name wird augenblich auch im Projekt Explorer angezeigt.
Als nächstes benötigen wir noch eine Referenz auf die Systemdialoge, welche dem Visual Basic Entwicker durch die Common Dialog Controls zur Verfügung gestellt (wird durch das Visual Basic 6 Setup mit installiert) werden. Öffnen Sie dazu zunächst über 'Ansicht' die 'Werkzeugsammlung', die alle dem Projekt zugeordneten Steuerelemente enthalten. Alle bisher aufgeführten Symbole darin sind Elemente die die Laufzeitumgebung bereits enthält. Klicken Sie mit der rechten Maustaste in einem freien Bereich der Werkzeugsammlung und wählen aus dem Popup-Menü den Eintrag 'Komponenten' um den Komponenten Dialog zu öffnen der alle im System registrierten Steuerelemente enthält. Suchen sie nach dem Eintrag 'Microsoft Common Dialog Control 6.0' in der Liste und setzen ein Häckchen davor um das Steuerelement in die Werkzeugsammlung aufzunehmen. Anschliessend bestätigen Sie Ihre Auswahl mit Ok. In der Werkzeugsammlung sollte jetzt ein weiteres Symbol vorhanden sein.
Damit ist die grundlegende Struktur des Projektes fertig und wir können uns um das Formular kümmern, das die Kommunikation mit unseren Benutzern übernehmen wird.
Die Benutzeroberfläche
Als wir das Projekt erstellt haben wurde automatisch ein Formular (Form1) erstellt, welches wir jetzt nach unseren Bedürfnissen anpassen. Doppelklicken Sie dazu den entsprechenden Eintrag (Form1 (Form1)) im Projekt Explorer um das Formular zu öffnen und wechseln dann mit F4 in dessen Eingenschaften. Dort ändern Sie bitte den Namen auf 'frmWait', Caption auf '##', ClipControls und ControlBox auf 'False', Height auf '915', Left auf '90', Top auf '90' und Width auf '9075'. Sie haben sicher festgestellt wie sich die meissten Eigenschaften auf das Formular ausgewirkt haben, trotzdem möchte ich sie noch kurz erläutern.
Ein Formular in Visual Basic ist ein Objekt, auf das wir später zur Laufzeit (wenn unser Programm ausgeführt wird) aus unserem Code zugreifen können und werden. Dazu müssen wir wissen wie das Objekt heisst und das haben wir in der Name-Eigenschaft festgelegt. Die Eigenschaften Left und Top beziehen sich auf den Bildschirm und legen fest wo unser Formular beginnt (vom linken bzw. oberen Rand) wenn es denn zur Laufzeit einmal angezeigt wird. Die Eigenschaften Heigh und Width legen analog fest wie hoch bzw. breit unser Formular dann ist (dieses ändern wir zur Laufzeit noch einmal). Die Caption ist der Text in der Titelzeile unseres Formulares, die Rauten dienen dabei als Erinnerung das der Titel aus dem Code heraus angepasst werden muss (das ist zur Laufzeit sehr auffällig). ClipControls zeigt (True) oder verbirgt (False) die Schaltflächen in der Titelleiste mit denen das Fenster ins Vollbild oder in die Taskleiste geschaltet werden kann. Da unser Formular später lediglich der Ausgabe dient benötigen wir diese Funktionalität nicht. Die ControlBox Eigenschaft ist analog für das Systemmenü (Symbol links in der Titelleiste) und die Schliessenschaltfläche der Titelleiste zuständig.
Dann benötigen wir noch zwei Steuerelemente auf unserem Formular. Klicken Sie dazu in der Werkzeugsammlung auf das gewünschte Element und zeichen Sie dann mit dem Mauszeiger (der dann ein Kreuz sein sollte) das Steuerelement auf das Formular. Wir benötigen den CommonDialog (dessen Ausmasse sind festgelegt, da er zur Laufzeit keine Oberfläche auf dem Formular beansprucht) und ein Label. Die Namen der Steuerelemente wird angezeigt wenn Sie mit dem Mauszeiger darüber verharren. Bitte ändern Sie den Namen des CommonDialog auf 'dlgFile' und stellen die folgenden Eigenschaften für das Label ein:
Name = lblWait Caption = ## Height = 765 Left = 90 Top = 60 Width = 8880
Damit ist die Benutzeroberfläche bereits fertig und wir können beginnen etwas zu programmieren. Doppelklicken Sie einfach auf einem freien Bereich im Formular um den Editor zu öffnen. Dieser wird Ihnen sogleich eine Hülle der Funktion 'Form_Load' erstellen in die wir einen Befehl hinzufügen wollen.
Me.Move 100, 100
Das Me ist ein Verweis auf das Formular in dem wir uns befinden und es handelt sich wie bereits erwähnt um ein Objekt. Move wiederum ist eine Methode die uns das Form Objekt zur Verfügung stellt. Eine Methode ist eine Prozedur oder Funktion die auch Attribute entgegennehmen kann, für eine Übersicht können Sie den Objektkatalog jederzeit mit F2 zu Rate ziehen, der die Objekte mit ihren Methoden und Eigenschaften anschaulich auflistet. Die Move Methode unterstützt 4 Argumente (Left, Top, Width, Height) von denen die letzten drei optional sind, also nicht angegeben werden müssen. Wir benutzen also in diesem Beispiel Left und Height, welche auch direkt als Eigenschaften des Formobjektes angesprochen werden könnten.
Das 'Form_Load' wird durch die Laufzeitumgebung aufgerufen wenn das Formular in den Speicher geladen, aber noch nicht angezeigt wird. Wir ändern also den Standort des Formulares noch bevor wir es anzeigen. Visual Basic bietet uns einige solcher Methoden an die auf bestimmte Ereignisse reagieren bzw. uns die Möglichkeit eröffnen darauf zu reagieren. Wir sollten noch auf ein weiteres Ereignis reagieren: Wenn der Anwender das Formular in der Grösse verändert sollten wir die darauf abgelegten Steuerelemente entsprechend anpassen. Das entsprechende Ereignis 'Form_Resize' wird wie der Name bereits vermuten lässt aufgerufen wenn sich an der Grösse des Formulares etwas ändert. Nun müssen wir aber die Methode nicht selber erstellen. Um Schreibfehler zu vermeiden bietet die Entwicklungsumgebung (IDE) uns eine Funktionalität die uns die Hülle der benötigten Funktion und der ggf. unterstützten Parameter erstellt.
Oben im Sourceeditor finden Sie zwei Comboboxen mit denen Sie links ein Objekt des Formulares auswählen können, in diesem Fall 'Form' für das Formular selbst. Der Editor springt dann sofort in die erste existierende Methode oder erstellt die 'Form_Load' Methode wenn noch keine andere Methode existiert. Danach wählen Sie rechts 'Resize' aus um die benötigte Methode erstellen zu lassen. In die gerade erstellte Methode schreiben Sie dann die folgenden Befehle.
If Me.Width < 4000 Or Me.Height < 1000 Then Exit Sub lblWait.Width = Me.ScaleWidth - 200 lblWait.Height = Me.ScaleHeight - 200
Das Schlüsselwort Me verweist hier wieder auf das Formular selbst. Es wird also geprüft ob die Breite 4000 Twips oder die Höhe 1000 Twips unterschreitet (15 Twips = 1 Pixel, das muss aber vom Betriebssystem erfragt werden siehe TwipsPerPixelX bzw. TwipsPerPixelY) und wenn dem so ist die Methode sofort wieder verlassen. Wenn eine bestimmte Formulargrösse unterschritten wird macht es irgendwann keinen Sinn mehr die Steuerelemente noch anpassen zu wollen, es kann sogar zu Fehlern kommen (das werden Sie aber sicher selbst noch erfahren). Andernfalls wird die Grösse das Labels (lblWait) anhand der Grösse des Formulares (Me) abzüglich der benötigten Ränder (200) angepasst. ScaleWidth und ScaleHight verweisen dabei lediglich auf den Clientbereich des Formulares (abzüglich Fensterumrandung), anders als die Eigenschaften Width und Height das tun würden. Wir ersparen uns damit das Abfragen der Fenstermetriken die der Anwender ja beeinflussen könnte.
Damit ist auch das erstellen der Benutzeroberfläche abgeschlossen. Sie sollten hier vielleicht einmal Ihre Arbeit abspeichern bevor wir mit der Programmierung der eigentlichen Programmlogik beginnen.
Die Programmlogik
CheckPathLength Beispielsourcen
Wenn Sie das zuvor besprochene nicht nachvollziehen, sondern aus dem fertigen Programm erarbeiten möchten, können Sie die folgend aufgeführten Zeilen einfach in neue Textdateien kopieren, die entsprechend Ihrer Überschriften benannt werden müssen.
CheckPathLength.vbp
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\Stdole2.tlb#OLE Automation
Module=basMain; basMain.bas
Form=frmWait.frm
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
IconForm="frmWait"
Startup="Sub Main"
HelpFile=""
Title="CheckPathLength"
ExeName32="CPL.exe"
Command32=""
Name="CheckPathLength"
HelpContextID="0"
Description="Prüft die Länge von Dateipfaden"
CompatibleMode="0"
MajorVer=1
MinorVer=1
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionComments="Prüft die Länge von Dateipfaden"
VersionCompanyName=""
VersionFileDescription="Prüft die Länge von Dateipfaden"
VersionLegalCopyright=""
VersionLegalTrademarks=""
VersionProductName="Check Path Length"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1== CheckPathLength.vbp ==
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\Stdole2.tlb#OLE Automation
Module=basMain; basMain.bas
Form=frmWait.frm
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
IconForm="frmWait"
Startup="Sub Main"
HelpFile=""
Title="CheckPathLength"
ExeName32="CPL.exe"
Command32=""
Name="CheckPathLength"
HelpContextID="0"
Description="Prüft die Länge von Dateipfaden"
CompatibleMode="0"
MajorVer=1
MinorVer=1
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionComments="Prüft die Länge von Dateipfaden"
VersionCompanyName=""
VersionFileDescription="Prüft die Länge von Dateipfaden"
VersionLegalCopyright=""
VersionLegalTrademarks=""
VersionProductName="Check Path Length"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1
frmWait.frm
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmWait
Caption = "##"
ClientHeight = 915
ClientLeft = 120
ClientTop = 1170
ClientWidth = 9075
ControlBox = 0 'False
Icon = "frmWait.frx":0000
LinkTopic = "Form1"
ScaleHeight = 915
ScaleWidth = 9075
Begin MSComDlg.CommonDialog dlgFile
Left = 5940
Top = 60
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Label lblWait
Caption = "##"
Height = 765
Left = 90
TabIndex = 0
Top = 60
Width = 8880
End
End
Attribute VB_Name = "frmWait"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Load() Me.Move 100, 100 End Sub
Private Sub Form_Resize() If Me.Width < 4000 Or Me.Height < 1000 Then Exit Sub lblWait.Width = Me.ScaleWidth - 200 lblWait.Height = Me.ScaleHeight - 200 End Sub
basMain.bas
Attribute VB_Name = "basMain"
Option Explicit
' Win32 API Deklaration (Ordner auswählen)
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pIdl As Long, ByVal pszPath As String) As Long
Public Const MAX_PATH As Long = 260
Public Type BROWSEINFO
hOwner As Long ' Form.hwnd
pidlRoot As Long ' = 0
pszDisplayName As String ' Verzeichnis Rückgabe (MAX_PATH)
lpszTitle As String ' Beschreibung im Dialog
ulFlags As Long ' = 0
lpfn As Long ' = 0
lParam As Long ' = 0
iImage As Long ' = 0
End Type
Public intMaxCharsInPath As Integer
Public dblFehler As Double
Sub main()
Dim strSearchFolder As String
Dim strExportFile As String
Dim intDatei As Integer
Dim strMSG As String
Load frmWait
With frmWait
.Caption = "Initialisierung"
.lblWait.Caption = "Variable werden vom Benutzer abgefragt..."
.Show vbModeless
End With
' Suchpfad vom Benutzer erfragen
strMSG = "Bitte geben Sie den zu durchsuchenden Pfad ein"
If GetFolder(strSearchFolder, strMSG) = False Then
MsgBox "Ohne Suchpfad kann das Programm nicht fortgesetzt werden.", _
vbInformation + vbOKOnly, "Abbruch"
Unload frmWait
Exit Sub
End If
If strSearchFolder = "" Then
MsgBox "Ohne Suchpfad kann das Programm nicht fortgesetzt werden.", _
vbInformation + vbOKOnly, "Abbruch"
Unload frmWait
Exit Sub
End If
frmWait.lblWait.Caption = frmWait.lblWait.Caption & vbCrLf & "Pfad: " & strSearchFolder
frmWait.Refresh
' Alarmlänge vom Benutzer erfragen
strExportFile = InputBox("Geben Sie die Länge des Pfades an bei dem eine Ausgabe " & _
"in die Ergebnisdatei erfolgen soll", "Alarm Pfadlänge eingeben", "235")
If strExportFile = "" Then
MsgBox "Ohne Angabe der ""Alarmlänge"" kann das Programm nicht fortgesetzt _
werden.", vbInformation + vbOKOnly, "Abbruch"
Unload frmWait
Exit Sub
ElseIf IsNumeric(strExportFile) = False Then
MsgBox "Es wurde keine Zahl eingegeben. Ohne Angabe der ""Alarmlänge"" kann _
das Programm nicht fortgesetzt werden.", _
vbInformation + vbOKOnly, "Abbruch"
Unload frmWait
Exit Sub
End If
On Error Resume Next
intMaxCharsInPath = CInt(strExportFile)
If Err.Number <> 0 Then
MsgBox "Die angegebene Zahl ist ungültig. Ohne Angabe der ""Alarmlänge"" kann _
das Programm nicht fortgesetzt werden.", _
vbInformation + vbOKOnly, "Abbruch"
Unload frmWait
Exit Sub
End If
On Error GoTo 0
If intMaxCharsInPath < 1 Or intMaxCharsInPath > 255 Then
MsgBox "Die angegebene Zahl ist ungültig. Ohne Angabe der ""Alarmlänge"" kann _
das Programm nicht fortgesetzt werden.", _
vbInformation + vbOKOnly, "Abbruch"
Unload frmWait
Exit Sub
End If
frmWait.lblWait.Caption = frmWait.lblWait.Caption & vbCrLf & "Alarmlänge: " & strExportFile
frmWait.Refresh
' Dateinamen für Ergebnisdatei vom Benutzer erfragen
strExportFile = ""
If GetExportFile(strExportFile) = False Then
MsgBox "Ohne Angabe einer Ergebnisdatei kann das Programm nicht fortgesetzt _
werden.", vbInformation + vbOKOnly, "Abbruch"
Unload frmWait
Exit Sub
End If
frmWait.Caption = "Durchsuche Dateibaum, bitte warten..."
frmWait.lblWait.Caption = ""
frmWait.Refresh
' Ergebnisdatei öffnen
intDatei = FreeFile
Open strExportFile For Output As #intDatei
' Dateikopf schreiben
strMSG = String(79, "-")
Print #intDatei, strMSG
strMSG = App.ProductName & " Version " & App.Major & "." & App.Minor & "." & App.Revision & " "
strMSG = strMSG & String(54 - Len(strMSG), " ") & App.LegalCopyright
Print #intDatei, strMSG
strMSG = "CPL gestartet am " & Format(Date, "dd.mm.yyyy") & " um " & _
Format(Time, "HH:mm") & " Uhr."
Print #intDatei, strMSG
strMSG = String(79, "-")
Print #intDatei, strMSG
' Suchfunktion aufrufen (ruft sich rekursiv immer wieder selbst auf)
dblFehler = 0
SearchTree strSearchFolder, intDatei
' Fehleranzahl in Datei schreiben
strMSG = "Es wurden " & CStr(dblFehler) & " Fehler nach eingegebener Definition festgestellt."
strSearchFolder = vbCrLf & String(79, "-") & vbCrLf & strMSG
Print #intDatei, strSearchFolder
' Ergebnisdatei schliessen, Ergebnis ausgeben und Formular entladen
Close #intDatei
frmWait.Caption = "Vorgang abgeschlossen"
frmWait.lblWait.Caption = strMSG
frmWait.Refresh
MsgBox strMSG, vbInformation + vbOKOnly, "Ergebnis"
Unload frmWait
End Sub
Private Function GetExportFile(ByRef File As String) As Boolean
Dim DLG As CommonDialog
GetExportFile = False
Set DLG = frmWait.dlgFile
With DLG
.CancelError = True
.DialogTitle = "Ergebnis speichern unter..."
.Filter = "Textdateien|*.txt|Alle Dateien|*.*"
.FilterIndex = 1
.Flags = cdlOFNHideReadOnly + cdlOFNOverwritePrompt + cdlOFNPathMustExist
On Error Resume Next
.ShowSave
If Err.Number <> 0 Then Exit Function
On Error GoTo 0
File = .FileName
End With
Set DLG = Nothing
GetExportFile = True
End Function
Private Function GetFolder(ByRef Folder As String, ByVal MSG As String) As Boolean Dim BI As BROWSEINFO Dim strPfad As String Dim lngReturnFolder As Long Dim lngReturnPath As Long GetFolder = False BI.hOwner = frmWait.hWnd BI.iImage = 0 BI.lParam = 0 BI.lpfn = 0 BI.pidlRoot = 0 BI.ulFlags = 0 BI.lpszTitle = MSG BI.pszDisplayName = String(MAX_PATH, 0) lngReturnFolder = SHBrowseForFolder(BI) If lngReturnFolder = 0 Then Exit Function strPfad = String(MAX_PATH, 0) lngReturnPath = SHGetPathFromIDList(lngReturnFolder, strPfad) Folder = Left(strPfad, InStr(strPfad, vbNullChar) - 1) GetFolder = True End Function
Private Sub SearchTree(ByRef sPath As String, ByVal FileNumber As Integer)
Dim colDirs As New Collection
Dim strDir As String
Dim varDir As Variant
Dim intPathlenght As Integer
Dim lngDirectory As Long
Dim strZeile As String
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
intPathlenght = Len(sPath)
On Error Resume Next
If Len(Dir(sPath & "*.*", vbArchive + vbDirectory + vbHidden + vbNormal + _
vbReadOnly + vbSystem)) = 0 Then
strZeile = "# Fehler # Verzeichnis konnte nicht gefunden oder geöffnet _
werden: " & sPath & vbCrLf
Print #FileNumber, strZeile
On Error GoTo 0
Exit Sub
End If
On Error GoTo 0
frmWait.lblWait.Caption = sPath
frmWait.lblWait.Refresh
strDir = Dir(sPath & "*.*", vbArchive + vbDirectory + vbHidden + vbNormal + _
vbReadOnly + vbSystem)
Do Until Len(strDir) = 0
DoEvents
If strDir <> "." And strDir <> ".." Then
On Error Resume Next
lngDirectory = (GetAttr(sPath & strDir) And vbDirectory)
If Err.Number = 0 Then
If lngDirectory <> 0 Then
varDir = sPath & strDir & "\"
colDirs.Add varDir
Else
If intMaxCharsInPath - 1 < Len(sPath & strDir) Then
strZeile = sPath & strDir & vbCrLf & Len(sPath & strDir) & vbCrLf
Print #FileNumber, strZeile
dblFehler = dblFehler + 1
End If
End If
Else
'MsgBox "Fehler bei Attributprüfung: " & Err.Number & vbCrLf _
& "Beschreibung: " & Err.Description & vbCrLf & vbCrLf _
& "Verzeichnis: " & sPath & vbCrLf & "Datei/Verzeichnis: " & strDir
strZeile = sPath & strDir & vbCrLf & Len(sPath & strDir) & vbCrLf
Print #FileNumber, strZeile
dblFehler = dblFehler + 1
End If
Err.Clear
On Error GoTo 0
End If
strDir = Dir()
Loop
For Each varDir In colDirs
DoEvents
strDir = varDir
SearchTree strDir, FileNumber
Next varDir
End Sub