Visual Basic 6: Verzeichnislänge Prüfen Beispiel
Beschreibung
BearbeitenUnter 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
BearbeitenWenn 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
BearbeitenAls 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 Eigenschaften. 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 zeichnen 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
BearbeitenCheckPathLength Beispielsourcen
BearbeitenWenn 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
BearbeitenType=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
BearbeitenVERSION 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
BearbeitenAttribute 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