http://dieseyer.de • all rights reserved • © 2011 v11.8

'*** v11.8 *** www.dieseyer.de *****************************
' File: DateiNamenLangDIR.vbs
' Autor: dieseyer@gmx.de
' dieseyer.de
'
' Sucht im Zielverzeichnis nach Dateien, deren Name inkl.
' kompletter Pfadangabe länger als 250 Zeichen ist.
'
' Neu in v11.8: Verzeichnisse mit äÜöß werden unterstützt
' Neu in v11.8: Zusätzlicher Parameter möglich.
' dateinamenlangdir.vbs 240 C:\Drivers
' dateinamenlangdir.vbs 240 \\Server\Pfad
'
' Neu in v10.7: Zusätzliche Ausgabe in .CSV-Datei.
'
' Neu in v10.5: Zu testendes Verzeichnis auf VBS ziehen und
' fallen lassen.
'
' Neu in v9.4: 'Browse For Folder', wenn die Variable
' "LaufWerk" leer ist.
'
'***********************************************************

Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl

Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell")
Dim WSHNet : Set WSHNet = WScript.CreateObject("WScript.Network")
Dim Args : Set Args = Wscript.Arguments

Dim Tst, Txt, i, errTst, iDatei, iVerz, iLang, iAnz, MaxAnz, ZeilenAnz, LaufWerk, AutoMode, Zeit, DirTmp, DirCsv, DirCsvSumme
Dim fo, fi
Dim LogDatei
Dim ZeilenCSV : ZeilenCSV = 50*1000 ' max. Zeilenanzahl je CSV-Datei (Excel kann 'nur' 65.000)
' : ZeilenCSV = 150 ' max. Zeilenanzahl je CSV-Datei (Excel kann 'nur' 65.000)

iLang = 0
AutoMode = False
MaxAnz = 0


' Aufruf-Parameter einlesen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
LaufWerk = ""
For i = 0 to Args.Count - 1 ' hole alle Argumente
If i = 0 Then MaxAnz = Trim( Args( i ) )
If i > 0 Then LaufWerk = LaufWerk & " " & Args( i )
Next

If i = 1 Then LaufWerk = MaxAnz : MaxAnz = 0
LaufWerk = Trim( LaufWerk )

' MsgBox "MaxAnz: '" & MaxAnz & "'", , "053 :: "
' Aufruf-Parameter auswerten: Ist erster Parameter eine Zahl?
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If Mid( MaxAnz, 1, 2 ) = "\\" OR Mid( MaxAnz, 2, 2 ) = ":\" Then
' MsgBox MaxAnz & vbCRLF & LaufWerk, , "057 :: "
LaufWerk = MaxAnz & " " & LaufWerk
MaxAnz = 0
Else
MaxAnz = CInt( MaxAnz )
AutoMode = True
End If

If LaufWerk = "" Then Call InfoZeigen()

If LaufWerk = "" Then LaufWerk = BrowseForFolder( "Verzeichnis auswählen:", 9+16384, 0 )


' Pfad erreichbar?
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If fso.FolderExists( Laufwerk ) Then
Else
MsgBox vbTab & "= = = F E H L E R = = =" & vbCRLF & vbCRLF & ">" & Laufwerk & "<" & vbCRLF & vbCRLF & vbTab & "ist nicht erreichbar!", , "074 :: " & WScript.ScriptName
Trace32Log "075 :: Ende " & WScript.ScriptFullName & " (Dateidatum: " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 1
WScript.Quit
End If

If Right( LaufWerk, 1 ) = "\" Then LaufWerk = Left( LaufWerk, Len( LaufWerk ) - 1 ) ' ohne \ am Ende


' LogDatei festlegen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
LogDatei = WScript.ScriptFullName
LogDatei = Left( LogDatei, InStrRev( LogDatei, "." ) - 1 )
' MsgBox LogDatei, , "086 :: " : WScript.Quit
If Mid( Laufwerk, 2, 1 ) = ":" Then
Tst = Mid( Laufwerk, 1, 1 ) & "-" & Mid( Laufwerk, InStrRev( Laufwerk, "\" ) + 1 )
Else
Tst = Mid( Laufwerk, InStrRev( Laufwerk, "\" ) + 1 )
End If
DirCsvSumme = LogDatei & "_" & Tst & ".csv"
DirCsv = LogDatei & "_" & Tst & "_000.csv"
DirTmp = LogDatei & "_" & Tst & "_.tmp"
LogDatei = LogDatei & "_" & Tst & "_.log"
' MsgBox "LogDatei " & vbTab & LogDatei & vbCRLF & "DirTmp " & vbTab & DirTmp, , "096 :: " : WScript.Quit


' LogDatei beginnen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Trace32Log " ", 1
Trace32Log "102 :: Start " & WScript.ScriptFullName & " (Dateidatum: " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 2
Trace32Log "103 :: LogDatei: " & LogDatei, 1
Trace32Log "104 :: PCname: " & WSHNet.ComputerName, 1
Trace32Log "105 :: Angemeldeter User: " & WSHNet.UserName, 1

WScript.Sleep 500
WSHShell.Run "trace32.exe """ & LogDatei & """", , False
WScript.Sleep 500

Trace32Log "111 :: Start " & now(), 1
Trace32Log "112 :: Zu prüfendes Verzeichnis bzw. Laufwerk: " & LaufWerk, 1
Trace32Log "113 :: DirTmp: '" & DirTmp & "'", 1

WScript.Sleep 500

Zeit = Timer()


' Prüfen, ob in die DIR-Zieldatei noch geschrieben wird
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If fso.FileExists( DirTmp ) Then
Txt = fso.GetFile( DirTmp ).Size
wshshell.Popup "Bitte nicht OK drücken!!!" , 3, "124 :: Nach 3sek bin ich weg!", vbExclamation
If not Txt = fso.GetFile( DirTmp ).Size Then
MsgBox "Z.Z. wird Laufwerk " & vbCRLF & vbCRLF & LaufWerk & vbCRLF & vbCRLF & " noch geprüft . . .", 4096 + vbInformation, "126 :: " & WScript.ScriptName
Trace32Log "127 :: Ende " & WScript.ScriptFullName & " (Dateidatum: " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 1
WScript.Quit
Else
Trace32Log "130 :: Zu prüfendes Verzeichnis bzw. Laufwerk: " & LaufWerk, 1
Txt = vbTab & "Laufwerk/Verzeichnis " & vbCRLF & vbCRLF & LaufWerk & vbCRLF & vbCRLF & vbTab & "wurde bereits geprüft. "
Txt = Txt & vbCRLF & vbTab & "Soll es erneut geprüft werden?"

If not AutoMode Then i = MsgBox (Txt, vbQuestion+vbYesNo+4096, "134 :: " & WScript.ScriptName)

If i = vbNo Then Trace32Log "136 :: Ende " & WScript.ScriptFullName & " (Dateidatum: " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 1
If i = vbNo Then WScript.Quit
End If
End If
WScript.Sleep 500


' MaxAnz festlegen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Trace32Log "145 :: Aufforderung zur Eingabe der 'MaxAnz' . . .", 1
Txt = "Dateien mit kompletten Pfad dürfen eine bestimmte Zeichenanzahl nicht übersteigen." & vbCRLF & vbCRLF
Txt = Txt & "Es sollen alle Dateien mit komplettem Pfad aufgelistet werden, deren Zeichenanzahl folgende Zahl übersteigt:"
If MaxAnz = "" OR MaxAnz < 3 Then MaxAnz = InputBox( Txt, "148 :: " & WScript.ScriptName, 222 )
If MaxAnz = "" OR MaxAnz < 3 Then
MsgBox " . . . denn eben nicht!", , "150 :: " & WScript.ScriptName
Trace32Log "151 :: Ende " & WScript.ScriptFullName & " (Dateidatum: " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 1
WScript.Quit
End If
MaxAnz = CInt(MaxAnz)
Trace32Log "155 :: 'MaxAnz' steht jetzt auf '" & MaxAnz & "'", 1

If Len( LaufWerk ) = 3 AND InStr( LaufWerk, ":\" ) = 2 Then LaufWerk = Left( LaufWerk, 2 )

Trace32Log "159 :: Auf Dateien mit mehr als " & MaxAnz & " Ze1ichen im Dateinamen mit kompletten Pfad wird geprüft:", 1
Trace32Log "160 :: " & LaufWerk, 1


Zeit = Timer()


' Neue DIR-Zieldatei wird erstellt
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Txt = "%comspec% /c chcp 1252&&@echo 22 > """ & DirTmp & """&&dir """ & LaufWerk & "\"" /s /b >> """ & DirTmp & """2>&1"
Txt = "%comspec% /c dir """ & LaufWerk & "\"" /s /b > """ & DirTmp & """2>&1"
Trace32Log "170 :: Wird gestartet: " & Txt, 1
Trace32Log "171 :: DIR-Start - das kann jetzt dauern . . . ", 1
' MsgBox Txt, , "172 :: "
WSHShell.run Txt, 0, True
Trace32Log "174 :: DIR-End - Dauer: " & Timer() - Zeit & "s", 1


' Neue DIR-Zieldatei zum Lesen öffnen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if not fso.FileExists( DirTmp) Then wshshell.Popup "Bitte nicht OK drücken!!!", 3, "179 :: Nach 3sek bin ich weg!", vbExclamation

' WSHShell.run "notepad """ & DirTmp & """", , True


' alte CSV-Dateien löschen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Trace32Log "186 :: '" & DirCsv & "'", 1
Tst = DateiMitLfdNr( DirCsv, -1 )
Trace32Log "188 :: '" & DirCsv & "'", 1
If InStr( Tst, "Fehler" ) = 1 Then
MsgBox vbTab & "= = = F E H L E R = = =" & vbCRLF & vbCRLF & Tst, 4096 + vbCritical, "190 :: " & WScript.ScriptName
WScript.Quit
End If


' Alte Protokolldatei (.csv) löschen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ZeilenAnz = 2^200 : i = 0
' MsgBox DirCsv & vbCRLF & ZeilenAnz, , "198 :: "

If fso.FileExists( DirCsvSumme ) Then
On Error Resume Next
fso.DeleteFile DirCsvSumme, True
errTst = Err.Number & " - " & Err.Description
On Error GoTo 0
If Len( errTst ) > 4 Then
Tst = "Fehler: " & "206 :: Nicht löschbar: '" & DirCsvSumme & "'"
If not AutoMode Then MsgBox vbTab & "= = = F E H L E R = = =" & vbCRLF & vbCRLF & Tst, 4096 + vbCritical, "207 :: " & WScript.ScriptName
Trace32Log "208 :: " & Tst, 3
WScript.Quit
Else
Trace32Log "211 :: Gelöscht: " & DirCsvSumme, 1
End If
End If
fso.OpenTextFile( DirCsvSumme, 8, true, 0 ).WriteLine( """" & "214 :: Jede CSV-Datei enthält max. " & FormatNumber( ZeilenCSV, 0, , -1 ) & " Zeilen . . .""" )


' Neue DIR-Zieldatei zeilenweise lesen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
iDatei = 0 ' alle Zeilen zählen
Set fi = FSO.OpenTextFile( DirTmp, 1, , 0 ) ' Datei zum Lesen öffnen
Do While Not (fi.atEndOfStream) ' wenn Datei nicht zu ende ist, weiter machen

If ZeilenAnz > ZeilenCSV Then ' neue ZielDatei
DirCsv = DateiMitLfdNr( DirCsv, 1 )
fso.OpenTextFile( DirCsvSumme, 8, true, 0 ).WriteLine( """" & Date() & """;""" & Time() & """;""" & DirCsv & """" )
ZeilenAnz = 0 ' je CSV-Datei
fso.OpenTextFile( DirCsv, 2, true).WriteLine ( """0"";""0"";""0"";""0"";""komplettpfad""" )
End If

iDatei = iDatei + 1

Txt = fi.Readline
If Len(Txt) > MaxAnz Then ' Zeilenlänge zu gross?
ZeilenAnz = ZeilenAnz + 1 ' je CSV-Datei
Txt = ToANSI( Txt ) ' ää, ö, ü, ß ....
iLang = iLang + 1 ' je zu langer Pfad
Trace32Log "237 :: Nr.: " & iLang & " Länge: " & len(Txt) & " " & Txt, 1 ' protokollieren
' fso.OpenTextFile( DirCsv, 8, true).WriteLine( iLang & vbTab & len(Txt) & vbTab & Txt )
' fso.OpenTextFile( DirCsv, 8, true, 0 ).WriteLine( """" & iLang & """;""" & len(Txt) & """;""" & Txt & """" )
fso.OpenTextFile( DirCsv, 8, true, 0 ).WriteLine( """" & iDatei & """;""" & ZeilenAnz & """;""" & iLang & """;""" & len(Txt) & """;""" & Txt & """" )
End If
Loop
fi.Close
Set fi = Nothing ' Datei schließen


' if fso.FileExists( DirTmp) Then fso.DeleteFile DirTmp

' Ergebnisdatei starten
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
On Error Resume Next
' If iLang > 0 Then WSHShell.Run "notepad """ & DirCsv & """", , False
' If iLang > 0 Then WSHShell.Run """" & DirCsv & """", , False
If iLang > 0 Then WSHShell.Run """" & DirCsvSumme & """", 2, False
On Error GoTo 0

' Txt = iDatei & " Dateien auf Laufwerk " & LaufWerk & " wurden überprüft."
Trace32Log "258 :: " & iLang & " " & "Dateien haben mehr als " & MaxAnz & " Zeichen im Dateinamen . . .", 2
Trace32Log "259 :: " & iDatei & " " & "Dateien/Verzeichnissen auf Laufwerk " & LaufWerk & " wurden geprüft.", 1
Trace32Log "260 :: Gesmatdauer: " & Timer() - Zeit & "s", 1

' Zeit = hour(Zeit-now()) & ":" & minute(Zeit-now()) & ":" & secound(Zeit-now())

Trace32Log "264 :: Ende " & WScript.ScriptFullName & " (Dateidatum: " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 1

WScript.Quit


'*** v11.7 *** www.dieseyer.de *****************************
Function DateiMitLfdNr( DateiPfad, Mode )
'***********************************************************
' An die Prozedur muss ein Pfad zu einer 'Muster'-Datei
' übergeben werden z.B. C:\Temp\Datei_000.log
' Mode = -1 löscht alle C:\Temp\Datei_???.log
' Mode = 1 ermittelt den nächsten Dateinamen
' C:\Temp\Datei_023.log
' bei DateiPfad = C:\Temp\Datei_022.log

Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim DateiGrund, DateiErw, DateiNr, errTst, Tst, Tyt, i, n

' DateiPfad-Syntax prüfen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DateiErw = fso.GetExtensionName( DateiPfad )
i = InStrRev( DateiPfad, "_" ) - 1
' Trace32Log "286 :: '" & i & "' '" & DateiPfad & "'", 1
DateiGrund = Left( DateiPfad, i )
i = i + Len( "_000." & DateiErw )
If not i = Len( DateiPfad ) Then
DateiMitLfdNr = "Fehler: " & "290 :: Kann nicht verwendet werden: '" & DateiPfad & "'"
MsgBox DateiMitLfdNr & vbCRLF & vbCRLF & DateiPfad, , "291 :: " & i & " vs. " & Len( DateiPfad )
Exit Function
End If


' Mode prüfen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If not Mode = 1 and not Mode = - 1 Then
DateiMitLfdNr = "Fehler: " & "299 :: Parameterfehler!"
' MsgBox DateiMitLfdNr & vbCRLF & DateiPfad, , "300 :: " & i & " vs. " & Len( DateiPfad )
Exit Function
End If


' Mode = -1 => (alte) Dateien löschen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If Mode = -1 Then ' alle Dateien löschen
Trace32Log "308 :: Ggf. Dateien löschen: " & DateiGrund & "_[000..999]." & DateiErw, 1
For i = 0 to 999

DateiNr = i : If Len( DateiNr ) < 3 Then DateiNr = "0" & DateiNr : If Len( DateiNr ) < 3 Then DateiNr = "0" & DateiNr
Tst = DateiGrund & "_" & DateiNr & "." & DateiErw

Tyt = ""
Tyt = Tyt & "DateiPfad: " & vbTab & "'" & DateiPfad & "'" & vbCRLF
Tyt = Tyt & "DateiErw: " & vbTab & "'" & DateiErw & "'" & vbCRLF
Tyt = Tyt & "DateiGrund: " & vbTab & "'" & DateiGrund & "'" & vbCRLF
Tyt = Tyt & "DateiNr: " & vbTab & "'" & DateiNr & "'" & vbCRLF
Tyt = Tyt & vbTab & vbTab & "'" & Tst & "'" & vbCRLF
' Tyt = MsgBox( Tyt, vbOKCancel, "320 :: " )
' If not Tyt = vbOK Then MsgBox "Ende.", , "321 :: " : WScript.Quit

If fso.FileExists( Tst ) Then
On Error Resume Next
fso.DeleteFile Tst, True
errTst = Err.Number & " - " & Err.Description
On Error GoTo 0
If Len( errTst ) > 4 Then
DateiMitLfdNr = "Fehler: " & "329 :: Nicht löschbar: '" & Tst & "'"
Trace32Log "330 :: " & DateiMitLfdNr, 3
Exit Function
Else
Trace32Log "333 :: (" & DateiNr & ") Gelöscht: " & Tst, 1
End If
End If
Next
Trace32Log "337 :: Alle Dateien gelöscht: " & DateiGrund & "_[000..999]." & DateiErw, 1
End If


' Mode = 1 => neuen (nächsten) DateienNamen ermitteln
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If Mode = 1 Then ' neuer (freier) Dateinname
Trace32Log "344 :: Nächsten Dateiname ermitteln - 'nach' " & DateiPfad, 1
Tst = InStrRev( DateiPfad, "_" ) + 1
Tst = Mid( DateiPfad, Tst )
Tst = Left( Tst, InStr( Tst, "." ) -1 )
' MsgBox "'" & Tst & "'", , "348 :: " & i ' : WScript.Quit

For i = 0 to 999
DateiNr = i : If Len( DateiNr ) < 3 Then DateiNr = "0" & DateiNr : If Len( DateiNr ) < 3 Then DateiNr = "0" & DateiNr

' If DateiNr < Tst Then Trace32Log "353 :: '" & DateiNr & "' '" & Tst & "'", 1
' If DateiNr = Tst Then Trace32Log "354 :: '" & DateiNr & "' '" & Tst & "'", 2
' If DateiNr > Tst Then Trace32Log "355 :: '" & DateiNr & "' '" & Tst & "'", 3

If "0" & DateiNr > "0" & Tst Then
' Trace32Log "358 :: Neu DateiNr: '" & DateiNr & "'", 1
DateiMitLfdNr = DateiGrund & "_" & DateiNr & "." & DateiErw
' Trace32Log "360 :: Neuer DateiName: '" & Tst & "'", 1
Exit For
End If
Next
Trace32Log "364 :: Nächster Dateiname '" & DateiMitLfdNr & "'", 1
End If

End Function ' DateiMitLfdNr( DateiPfad )


'***********************************************************
Function ToANSI( ASCIIz )
'***********************************************************
' von Christoph Basedau aus
' http://groups.google.de/groups?q=ToANSI+%3D+Replace&hl=de&lr=&newwindow=1&selm=ugGVQok3AHA.1604%40tkmsftngp02&rnum=1
ToANSI = Replace(ASCIIz, chr(132), chr(228))
ToANSI = Replace(ToANSI, chr(129), chr(252))
ToANSI = Replace(ToANSI, chr(142), Chr(196))
ToANSI = Replace(ToANSI, chr(154), Chr(220))
ToANSI = Replace(ToANSI, chr(153), Chr(214))
ToANSI = Replace(ToANSI, chr(148), Chr(246))
ToANSI = Replace(ToANSI, chr(225), Chr(223))
End Function ' ToANSI( ASCIIz )


'*** v9.4 *** www.dieseyer.de ******************************
Function BrowseForFolder(strPrompt, intBrowseInfo, vRootFolder)
'***********************************************************
' http://www.codecomments.com/message367170.html
' http://groups.google.de/group/microsoft.public.scripting.vbscript/browse_frm/thread/f083a8d1806e9a68/d835b2a1ec45afec?lnk=st&q=BrowseForFolder+strPrompt+intBrowseInfo+vRootFolder&rnum=1&hl=de#d835b2a1ec45afec
'
'BrowseForFolder dialog. Follows MSDN example closely. Also handles selection of special
'folders (ex Desktop), which do not return a folder3 object as 'normal' folders do.
'Code below does not support all options, only folders.
'To use, copy and paste function into script,
'call as BrowseForFolder(strPrompt, intBrowseInfo, vRootFolder) where root folder is either an
'integer (constants below) or a string with a folder path.
'To use the constants below, they must be in the script header.

'Flags specifying the options for the dialog box. This member can include zero or a combination of the following values.
Const BIF_BROWSEFORCOMPUTER = 4096 'Only return computers. If the user selects anything other than a computer, the OK button is grayed.
Const BIF_BROWSEFORPRINTER = 8192 'Only allow the selection of printers. If the user selects anything other than a printer, the OK button is grayed. In Microsoft Windows XP, the best practice is to use an XP-style dialog, setting the root of the dialog to the Printers and Faxes folder (CSIDL_PRINTERS).
Const BIF_BROWSEINCLUDEFILES = 16384 'Version 4.71. The browse dialog box will display files as well as folders.
'Const BIF_BROWSEINCLUDEURLS = 'Version 5.0. The browse dialog box can display URLs. The BIF_USENEWUI and BIF_BROWSEINCLUDEFILES flags must also be set. If these three flags are not set, the browser dialog box will reject URLs. Even when these flags are set, the browse dialog box will only display URLs if the folder that contains the selected item supports them. When the folder's IShellFolder::GetAttributesOf method is called to request the selected item's attributes, the folder must set the SFGAO_FOLDER attribute flag. Otherwise, the browse dialog box will not display the URL.
Const BIF_DONTGOBELOWDOMAIN = 2 'Do not include network folders below the domain level in the dialog box's tree view control.
Const BIF_EDITBOX = 16 'Version 4.71. Include an edit control in the browse dialog box that allows the user to type the name of an item.
'Const BIF_NEWDIALOGSTYLE = 'Version 5.0. Use the new user interface. Setting this flag provides the user with a larger dialog box that can be resized. The dialog box has several new capabilities including: drag-and-drop capability within the dialog box, reordering, shortcut menus, new folders, delete, and other shortcut menu commands. To use this flag, you must call OleInitialize or CoInitialize before calling SHBrowseForFolder.
Const BIF_NONEWFOLDERBUTTON = 512 'Version 6.0. Do not include the New Folder button in the browse dialog box.
'Const BIF_NOTRANSLATETARGETS = 'Version 6.0. When the selected item is a shortcut, return the PIDL of the shortcut itself rather than its target.
Const BIF_RETURNFSANCESTORS = 8 'Only return file system ancestors. An ancestor is a subfolder that is beneath the root folder in the namespace hierarchy. If the user selects an ancestor of the root folder that is not part of the file system, the OK button is grayed. Const BIF_RETURNONLYFSDIRS = 1 'Only return file system directories. If the user selects folders that are not part of the file system, the OK button is grayed.
'Const BIF_SHAREABLE = 'Version 5.0. The browse dialog box can display shareable resources on remote systems. It is intended for applications that want to expose remote shares on a local system. The BIF_NEWDIALOGSTYLE flag must also be set.
Const BIF_STATUSTEXT = 4 'Include a status area in the dialog box. The callback function can set the status text by sending messages to the dialog box. This flag is not supported when BIF_NEWDIALOGSTYLE is specified.
'Const BIF_UAHINT = 'Version 6.0. When combined with BIF_NEWDIALOGSTYLE, adds a usage hint to the dialog box in place of the edit box. BIF_EDITBOX overrides this flag.
'Const BIF_USENEWUI = 'Version 5.0. Use the new user interface, including an edit box. This flag is equivalent to BIF_EDITBOX | BIF_NEWDIALOGSTYLE. To use BIF_USENEWUI, you must call OleInitialize or CoInitialize before calling SHBrowseForFolder.
Const BIF_VALIDATE = 32 'Version 4.71. If the user types an invalid name into the edit box, the browse dialog box will call the application's BrowseCallbackProc with the BFFM_VALIDATEFAILED message. This flag is ignored if BIF_EDITBOX is not specified.

Const ssfALTSTARTUP = 29 'File system directory that corresponds to the user's nonlocalized Startup program group. (value = 29)
Const ssfAPPDATA = 26 'Version 4.71. File system directory that serves as a common repository for application-specific data. A typical path is C:\Documents and Settings\username\Application Data. (value = 26)
Const ssfBITBUCKET = 10 'Virtual folder containing the objects in the user's Recycle Bin. (value = 15)
Const ssfCOMMONALTSTARTUP = 30 'File system directory that corresponds to the nonlocalized Startup program group for all users. Valid only for Microsoft Windows NT systems. (value = 30)
Const ssfCOMMONAPPDATA = 35 'Version 5.0. Application data for all users. A typical path is C:\Documents and Settings\All Users\Application Data. (value = 35)
Const ssfCOMMONDESKTOPDIR = 25 'File system directory that contains files and folders that appear on the desktop for all users. A typical path is C:\Documents and Settings\All Users\Desktop. Valid only for Windows NT systems. (value = 25)
Const ssfCOMMONFAVORITES = 31 'File system directory that serves as a common repository for all users' favorite items. Valid only for Windows NT systems. (value = 31)
Const ssfCOMMONPROGRAMS = 23 'File system directory that contains the directories for the common program groups that appear on the Start menu for all users. A typical path is C:\Documents and Settings\All Users\Start Menu\Programs. Valid only for Windows NT systems. (value = 23)
Const ssfCOMMONSTARTMENU = 22 'File system directory that contains the programs and folders that appear on the Start menu for all users. A typical path is C:\Documents and Settings\All Users\Start Menu. Valid only for Windows NT systems. (value = 22)
Const ssfCOMMONSTARTUP = 24 'File system directory that contains the programs that appear in the Startup folder for all users. A typical path is C:\Documents and Settings\All Users\Start Menu\Programs\Startup. Valid only for Windows NT systems. (value = 24)
Const ssfCONTROLS = 3 'Virtual folder containing icons for the Control Panel applications. (value = 3)
Const ssfCOOKIES = 33 'File system directory that serves as a common repository for Internet cookies. A typical path is C:\Documents and Settings\username\Cookies. (value = 33)
Const ssfDESKTOP = 0 'Microsoft Windows Desktopùvirtual folder that is the root of the namespace. (value = 0)
Const ssfDESKTOPDIRECTORY = 16 'File system directory used to physically store the file objects that are displayed on the desktop. It is not to be confused with the desktop folder itself, which is a virtual folder. A typical path is C:\Documents and Settings\username\Desktop. (value = 16)
Const ssfDRIVES = 17 'My Computerùvirtual folder containing everything on the local computer: storage devices, printers, and Control Panel. This folder may also contain mapped network drives. (value = 17)
Const ssfFAVORITES = 6 'File system directory that serves as a common repository for the user's favorite items. A typical path is C:\Documents and Settings\username\Favorites. (value = 6)
Const ssfFONTS = 20 'Virtual folder containing installed fonts. A typical path is C:\WINNT\Fonts. (value = 20)
Const ssfHISTORY = 34 'File system directory that serves as a common repository for Internet history items. (value = 34)
Const ssfINTERNETCACHE = 32 'File system directory that serves as a common repository for temporary Internet files. A typical path is C:\Documents and Settings\username\Temporary Internet Files. (value = 32)
Const ssfLOCALAPPDATA = 28 'Version 5.0. File system directory that serves as a data repository for local (non-roaming) applications. A typical path is C:\Documents and Settings\username\Local Settings\Application Data. (value = 28)
Const ssfMYPICTURES = 39 'My Pictures folder. A typical path is C:\Documents and Settings\username\My Documents\My Pictures. (value = 39)
Const ssfNETHOOD = 19 'A file system folder containing the link objects that may exist in the My Network Places virtual folder. It is not the same as ssfNETWORK, which represents the network namespace root. A typical path is C:\Documents and Settings\username\NetHood. (value = 19)
Const ssfNETWORK = 21 'Network Neighborhoodùvirtual folder representing the root of the network namespace hierarchy. (value = 18)
Const ssfPERSONAL = 5 'File system directory that serves as a common repository for a user's documents. A typical path is C:\Documents and Settings\username\My Documents. (value = 5)
Const ssfPRINTERS = 4 'Virtual folder containing installed printers. (value = 4)
Const ssfPRINTHOOD = 18 'File system directory that contains the link objects that may exist in the Printers virtual folder. A typical path is C:\Documents and Settings\username\PrintHood. (value = 27)
Const ssfPROFILE = 40 'Version 5.0. User's profile folder. (value = 40)
Const ssfPROGRAMFILES = 38 'Version 5.0. Program Files folder. A typical path is C:\Program Files. (value = 38)
Const ssfPROGRAMS = 2 'File system directory that contains the user's program groups (which are also file system directories). A typical path is C:\Documents and Settings\username\Start Menu\Programs. (value = 2)
Const ssfRECENT = 8 'File system directory that contains the user's most recently used documents. A typical path is C:\Documents and Settings\username\Recent. (value = 8)
Const ssfSENDTO = 9 'File system directory that contains Send To menu items. A typical path is C:\Documents and Settings\username\SendTo. (value = 9)
Const ssfSTARTMENU = 11 'File system directory containing Start menu items. A typical path is C:\Documents and Settings\username\Start Menu. (value = 11)
Const ssfSTARTUP = 7 'File system directory that corresponds to the user's Startup program group. The system starts these programs whenever any user logs onto Windows NT or starts Windows 95. A typical path is C:\Documents and Settings\username\Start Menu\Programs\Startup. (value = 7)
Const ssfSYSTEM = 37 'Version 5.0. System folder. A typical path is C:\WINNT\SYSTEM32. (value = 37)
Const ssfTEMPLATES = 21 'File system directory that serves as a common repository for document templates. (value = 21)
Const ssfWINDOWS = 36 'Version 5.0. Windows directory or SYSROOT. This corresponds to the %windir% or %SYSTEMROOT% environment variables. A typical path is C:\WINNT. (value = 36)

Dim oShell
Dim oFolder
Dim oFolderItem
Dim strPath
Dim oWSHShell
Dim oFSO
Dim bSuccess
Dim errTst

Set oShell = CreateObject("Shell.Application")
Set oWSHShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")

Do
'syntax: oFolder = Shell.BrowseForFolder(Hwnd, sTitle, iOptions [,vRootFolder])
Set oFolder = oShell.BrowseForFolder(&H0, strPrompt, intBrowseInfo, vRootFolder)

On Error Resume Next
'This seems to get a 'normal' folder object from the folder3 object returned by BrowseForFolder
Set oFolderItem = oFolder.Items.Item
errTst = Err.Number & " - " & Err.Description
On Error GoTo 0
If Len( errTst ) > 4 Then
' MsgBox "Invalid selection; Please try again", , "476 :: " & WScript.ScriptName
Else


'If a special folder (ex. desktop) is selected, object is nothing.
If (oFolderItem Is Nothing) Then
'This is necessary - seems to convert invalid object reference to a string?
strPath = oFolder
Set oFolderItem = oFSO.GetFolder(oWSHShell.SpecialFolders(strPath))
End If
End If

On Error Resume Next
If Not oFSO.FolderExists(oFolderItem.Path) Then
On Error GoTo 0
MsgBox "Falsche Eingabe => Ende!", , "491 :: " & WScript.ScriptName : WScript.Quit
Else
bSuccess = True
End If
Loop While Not bSuccess

BrowseForFolder = oFolderItem.Path

End Function ' BrowseForFolder(strPrompt, intBrowseInfo, vRootFolder)


'***********************************************************
Sub InfoZeigen
'***********************************************************
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim Txt, Tst
Txt = Txt & "Das VBScript prüft in einem Verzeichnis die Länge des kompletten Pfad zu allen Dateien in allen Unterver-" & vbCRLF
Txt = Txt & "zeichnissen. Überschreitet die Länge einen Grenzwert, wird die Datei protokolliert." & vbCRLF & vbCRLF
Txt = Txt & "Start das VBS das erste mal und ohne Parameter, wierden diese Informationen angezeigt." & vbCRLF & vbCRLF
Txt = Txt & "Dem VBS kann ein Verzeichnis übergeben werden - dazu im Windows-Explorer einfach ein Verzeichnis " & vbCRLF
Txt = Txt & "auf das VBS ziehen und 'fallen lassen'." & vbCRLF & vbCRLF
Txt = Txt & "Sind mehrere Verzeichnisse zu prüfen, ist eine CMD mit folgenden Beispielzeilen möglich, wobei der erste " & vbCRLF
Txt = Txt & "Parameter der Grenzwert für die Pfadlänge ist:" & vbCRLF
Txt = Txt & vbTab & WSCript.ScriptName & " 230 \\Server1\DATA" & vbCRLF
Txt = Txt & vbTab & WSCript.ScriptName & " 230 \\Server1\KOPIE" & vbCRLF
Txt = Txt & vbTab & """%~dp0" & WSCript.ScriptName & """ 255 ""\\ServerX\DS Daten""" & vbCRLF
Txt = Txt & vbTab & """%~dp0" & WSCript.ScriptName & """ 155 C:\" & vbCRLF & vbCRLF
Txt = Txt & "Beim Prüfen der Pfadlänge erzeugt der DIR-Befehl (DIR /S/B) eine temporäre Datei für die Auswertung," & vbCRLF
Txt = Txt & "die im Anschluß zeilenweise geprüft wird . . . also: Nicht ungeduldig werden." & vbCRLF

Tst = WScript.ScriptFullName & ".txt"
If fso.FileExists( Tst ) Then
WScript.CreateObject("WScript.Shell").Run """" & Tst & """", , False
Else
MsgBox "Beschreibung des VBScripts " & WSCript.ScriptName & vbCRLF & vbCRLF & Txt, vbInformation, "525 :: " & WScript.ScriptName & Len( Txt )
fso.OpenTextFile( Tst, 2, true).WriteLine ( Txt )
On Error Resume Next
On Error Goto 0
End If
End Sub ' InfoZeigen

'*** v9.C *** www.dieseyer.de ******************************
Sub Trace32Log( LogTxt, ErrType )
'***********************************************************
' in VBS und HTA verwendbar
' Aufbau einer LOG-Datei für trace32.exe ( SMS Trace;
' ALLES in einer Zeile!):
' <![LOG[...]LOG]!>
' <
' time="08:12:54.309+-60"
' date="03-14-2008"
' component="SrcUpdateMgr"
' context=""
' type="0"
' thread="1812"
' file="productpackage.cpp:97"
' >
'
' "context=" Info wird nicht angezeigt
' type="0" normale Zeie => NEUE LOG-DATEI - ggf. alte überschreiben !!!!!!!!!!!!
' type="1" normale Zeie
' type="2" gelbe Zeie
' type="3" rote Zeie
' type="F" rote Zeie

' "thread=" kann eine Dezimalzahl aufnehmen; trace32 zeigt
' neben der Dezimalzahl in Klammern die entspr.
' Hexadezimalzahl an - z.B. "33 (0x21)"
' "file=" wird in "Source:" angezeigt
'

Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim LogDateiX, TitelX, Tst, Nr

On Error Resume Next
Tst = KeineLog
On Error Goto 0
If UCase( Tst ) = "JA" Then Exit Sub

On Error Resume Next
TitelX = Titel ' Fehler, wenn die Variable 'Titel' nicht außerhalb der Prozedur definiert wurde
TitelX = title ' Fehler, wenn die Variable 'Titel' nicht außerhalb der Prozedur definiert wurde
If Len( TitelX ) < 2 Then TitelX = document.title ' .hta
If Len( TitelX ) < 2 Then TitelX = WScript.ScriptName ' .vbs
On Error Goto 0

On Error Resume Next
LogDateiX = LogDatei ' wurde die Variable 'LogDatei' nicht außerhalb der Prozedur definiert
If Len( LogDateiX ) < 2 Then LogDateiX = WScript.ScriptFullName & ".log" ' .vbs
If Len( LogDateiX ) < 2 Then LogDateiX = TitelX & ".log" ' .hta
On Error Goto 0

Nr = 0 ' Wenn in Thread die Zeilennummer stehen soll:
Nr = 999999
If Nr = 0 AND InStr( LogTxt, " :" & ": " ) > 0 Then
' Wenn in Thread die Zeilennummer stehen soll - Voraussetzung
' ist eine ZeilenNr. im Format '22 :: '
Nr = LogTxt
Nr = Mid( Nr, 1, InStrRev( Nr, " :" & ": " ) -1 ) ' nach der Zeilennummer
Nr = Mid( Nr, InStrRev( Nr, " " ) + 1 ) ' vor der Zeilennummer
On Error Resume Next : Tst = Int( Nr ) : On Error Goto 0 ' Zeilennummer als (Integer) Zahl
Do ' Tst für Vergleich auf gleiche Länge wie Nr anpassen
If Len( Tst ) = Len( Nr ) Then Exit Do
Tst = "0" & Tst
Loop

If "x" & Tst = "x" & Nr Then
LogTxt = Replace( LogTxt, Tst & " :" & ": ", "" )
Nr = Int( Nr )
End If
End If
If Nr = 999999 Then Nr = 0


' Zwei Nachkommastellen (nach Sekunden) der aktuellen Zeit
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Tst = Timer() ' timer() in USA: 1234.22
Tst = Replace( Tst, "," , ".") ' timer() in Deutschland: 123454,12
If InStr( Tst, "." ) = 0 Then Tst = Tst & ".000"
Tst = Mid( Tst, InStr( Tst, "." ), 4 )
If Len( Tst ) < 3 Then Tst = Tst & "0"

' Zeitzone ermitteln - neu (v9.C) und immer richtig(er)
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim AktDMTF : Set AktDMTF = CreateObject("WbemScripting.SWbemDateTime")
AktDMTF.SetVarDate Now(), True : Tst = Tst & Mid( AktDMTF, 22 ) ' : MsgBox Tst, , "616 :: "
' MsgBox "AktDMTF: '" & AktDMTF & "'", , "617 :: "
Set AktDMTF = nothing

LogTxt = "<![LOG[" & LogTxt & "]LOG]!>"
LogTxt = LogTxt & "<"
LogTxt = LogTxt & "time=""" & Hour( Time() ) & ":" & Minute( Time() ) & ":" & Second( Time() ) & Tst & """ "
LogTxt = LogTxt & "date=""" & Month( Date() ) & "-" & Day( Date() ) & "-" & Year( Date() ) & """ "
LogTxt = LogTxt & "component=""" & TitelX & """ "
LogTxt = LogTxt & "context="""" "
LogTxt = LogTxt & "type=""" & ErrType & """ "
LogTxt = LogTxt & "thread=""" & Nr & """ "
LogTxt = LogTxt & "file=""dieseyer.de"" "
LogTxt = LogTxt & ">"

Tst = 8 ' LOG-Datei erweitern
If ErrType = 0 Then Tst = 2 ' LOG-Datei erneuern (alte löschen, neue erstellen)

On Error Resume Next
If LogTxt = vbCRLF Then fso.OpenTextFile( LogDateiX, Tst, true).WriteLine ( LogTxt )
If not LogTxt = vbCRLF Then fso.OpenTextFile( LogDateiX, Tst, true).WriteLine ( LogTxt )
On Error Goto 0

Set fso = Nothing

End Sub ' Trace32Log( LogTxt, ErrType )

http://dieseyer.de • all rights reserved • © 2011 v11.8