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

'v3.5 ****************************************************************
' Funktion:
' Das Skript öffnet eine HTML-Datei und zeigt in einem Frame
' die Dateien des gedroppten Ordners an. Benötigt ein Unter-
' verzeichnis (FrameScroller) mit einigen Spezialdateien.
'
' Übergebene Argumente :
' - kein Argument übergeben: Nachfrage: aktuelles Verzeichnis oder Abbruch.
' - nur ein Argument übergeben (eine Datei): übergeordneten
' Ordner holen, alle Dateien darin durchgehen
' - nur ein Argument übergeben (einen Ordner): ganzen Ordner
' holen, alle Dateien darin durchgehen
' - mehrere Argumente übergeben: Argumente einzeln auswerten:
' ist das aktuelle Argument eine Datei, diese eintragen
' (aber nicht den übergeordneten Ordner, dies nur bei einer
' einzigen übergebenen Datei)
' - ist das aktuelle Argument ein Ordner, alle Dateien dieses
' Ordners eintragen.
'
' Man kann also:
' - Drei Html-Dateien aus einem Ordner (mit vielen Html-Dateien)
' droppen, um nur in diesen dreien zu blättern.
' - Ordner droppen, um alle html/Text/Bild-Dateien darin zu sehen
' - eine Datei droppen, um alle in ihrem Verzeichnis zu sehen
' - einen Ordner und zwei Dateien droppen: man sieht alle
' Dateien in diesem Verzeichnis und die beiden Dateien (aber
' keine weiteren Dateien aus ihrem Ordner; s.o.)
'
' Ferner kann man:
' - die erlaubten Endungen (htm, html, txt...) verändern
' - das Script auf den Desktop legen und per Drag und Drop starten
' - eine Verknüpfung auf dieses Script in den SendTo-Ordner kopieren
' und per rechter Maustaste | Senden an starten
' - dieses Script perBatch-Datei starten
'
' Erfordert: WSH 2.0 / 5.5, Internet Explorer, Spezialdateien
'
' Version um 13:35 am 29.05.2003.
'
' Ralf Nebelo (c't 24 / 2001, S.264) & Christoph Römhild
' (veröffentlicht auf http://dieseyer.de)
' ****************************************************************

Option Explicit

' ****************************************

Const strErlaubte_Endungen = ".htm.html.shtml.txt.pdf.jpg.jpe.gif.tif.png.bmp" ' In der Form: ".htm.html" (mit Punkten)
Const strVersion = "um 13:35 am 29.05.2003" ' z.B. "um 17:08 am 24.05.2003"
Const strTitel = "Verzeichnis als Internet-Explorer Frame zeigen" ' Titel

Dim objFS ' Filesystem-Object

' Aufruf Main
Main

' ****************************************

Sub Main

' Pfade und Dateien
Const strConstPathFolder = "\FrameScroller" ' der Folder
Const strConstPath1 = "\LoadTMP.js" ' Temporäre Datei in der Form "\FrameScroller\LoadTMP.js"
Const strConstPath2 = "\Start.html" ' Framerahmen in der Form "\FrameScroller\Start.html"
Const strConstPath3 = "\Loader.js" ' Javascript in der Form "\FrameScroller\Loader.js"

Dim strDateiListe ' zu erstellender String
Dim strMeldung ' für MsgBox-Meldungen
Dim strArg ' Argumente von Kommandozeile
Dim strPathScript ' Pfad des Skriptes
Dim strPathFolder ' Pfad des Ordners FrameScroller (analog zu oben)
Dim strPath1 ' Temporäre Datei (analog zu oben)
Dim strPath2 ' Framerahmen (analog zu oben)
Dim strPath3 ' Javascript (analog zu oben)


' Init ********************************************
' Filesystem-Object holen
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")

' Pfade erstellen
strPathScript = objFS.GetParentFolderName( wscript.ScriptFullname )
strPathFolder = strPathScript + strConstPathFolder
strPath1 = strPathFolder + strConstPath1
strPath2 = strPathFolder + strConstPath2
strPath3 = strPathFolder + strConstPath3


' String strDateiListe erstellen ******************
' strDateiListe ist die zu bildende Liste
' sieht so aus : strDateiListe = "MeineDateien = new Array("file://c:/filme1.htm","file://c:/weltall1.htm","file://c:/texte1.htm");"

' Anfang der Zeile setzen :
strDateiListe = "MeineDateien = new Array("

' Je nach Anzahl der übergebenen Argumente : ******
' Dieser Block startet alles weitere wichtige
If Wscript.Arguments.Count = 0 Then
' Frage stellen
strMeldung = "Keine Dateien oder Ordner gedroppt. " & vbNewLine
strMeldung = strMeldung + "Soll statt dessen der Ordner des Skriptes in einem Frame dargestellt werden?"
if MsgBox (strMeldung, vbyesnocancel + vbquestion, strTitel) = vbyes then
call EinElementAuswerten (strPathScript, strDateiListe)
else
WScript.Quit ' Abbruch
end if

Elseif Wscript.Arguments.Count = 1 Then
' es wurde nur ein Argument übergeben; wenn Datei, dann übergeordneter Ordner; wenn Ordner, dann so lassen
strArg = OrdnerAusArgument ( 0 )
' Ist es Datei oder Ordner?
if strArg = "" then
' Weder Datei noch Ordner (z.B. /?)
AuswertungKommandzeilenParameter ( Wscript.Arguments(0) ) ' ggf. Hilfe oder Version anzeigen
WScript.Quit ' Abbruch
else
' Alles ok, strArg ist ein Pfad / Datei oder Ordner o.ä.
call EinElementAuswerten ( strArg, strDateiListe )
end if

Elseif Wscript.Arguments.Count > 1 Then
' Alles ok
call AlleArgumenteDurchgehen ( strDateiListe )
Else
' Fehler (Count < 0 oder ähnliches)
msgbox "Unbekannte Anzahl der Argumente", vbInformation, strTitel
End If ' End If von Je nach Anzahl der übergebenen Argumente


' ggf. Abbruch ************************************
If FolderExistsExtended (strPathFolder) = False Then WScript.Quit
If FileExistsExtended (strPath2) = False Then WScript.Quit
If FileExistsExtended (strPath3) = False Then WScript.Quit
If Len(strDateiListe) <= 25 then
strMeldung = "Keine Dateien gefunden."
msgbox strMeldung, vbcritical, strTitel
WScript.Quit ' Abbruch
end if

' write strDateiListe to LoadTMP.js ***************

call SchreibeStringInEinFile (strDateiListe, strPath1)

' Explorer starten ********************************

StarteProgramm "iexplore.exe", strPath2

end sub ' Ende von Main

' ************************************************************
' ************************************************************
' zentrale Subs

sub AlleArgumenteDurchgehen( strDateiListe )
' wird nur von Main gestartet
Dim intI
Dim strArg

' Alle Argumente durchgehen
For intI = 0 To Wscript.Arguments.Count - 1

' Argument einlesen
strArg = WScript.Arguments( intI )
' Argument auswerten
call EinElementAuswerten (strArg, strDateiListe )

Next ' Next Argument

end sub

' ************************************************************

sub EinElementAuswerten (strArg, strDateiListe )
' wird von Main oder von AlleArgumenteDurchgehen gestartet
Dim objFile

' Argument auswerten
If objFS.FolderExists( strArg ) = True Then
' Es ist ein Ordner :
' Alle Dateien im Ordner durchgehen
For Each objFile In objFS.GetFolder( strArg ).Files
call SchreibeString ( objFile, strDateiListe )
Next ' Next Datei
ElseIf objFS.FileExists(strArg) = True Then
' Es ist eine Datei : Direkt schreiben:
Set objFile = objFS.GetFile(strArg)
Call SchreibeString ( objFile, strDateiListe )
Else
' Fehler: weder noch (dieses Argument übergehen, mit dem nächsten fortfahren)
msgbox "Datei oder Ordner existiert nicht: " & vbnewLine & strArg, vbinformation, strTitel
End If

end sub

' ************************************************************

sub SchreibeString ( objLocalDatei, strDateiListe )

' wird nur von EinElementAuswerten gestartet

Dim strFile
Dim strEndung


' Dateiname holen
strFile = LCase(objLocalDatei.path)
' Endung einlesen
strEndung = objFS.GetExtensionName(strFile)

' Wenn Endung erlaubt (ignoriert also alle zips und exes etc.); Dateien ohne Endung ignorieren
If InStr ( 1, strErlaubte_Endungen, strEndung ) > 0 and strEndung <> "" Then
' dann zu bildende Liste ergänzen; dabei muss \ durch / ersetzt werden; chr(34) ist ein "
strDateiListe = strDateiListe + chr(34) + "file://" + Replace (strFile,"\","/") + chr(34) + ","
End If

end Sub

' ************************************************************
' ************************************************************
' Hilfs-subs

function OrdnerAusArgument ( intNummerDesArguments )

' Argument Nummer "intNummerDesArguments" der Kommandozeile lesen;
' wenn Ordner, diesen zurückgeben;
' wenn Datei, deren übergeordneten (enthaltenden) Ordner zurückgeben.

Dim strPath ' Puffer für Rückgabewert
Dim objFolder ' Object Folder
Dim objFile ' Object File
Dim strArgument ' Argument aus Kommandozeile


' Wurden Argumente übergeben?
If WScript.Arguments.count <= 0 then
' Nein, nichts, Rückgabewert zwischenspeichern
strPath = ""
Else
' Ja, es wurde etwas übergeben; Argument speichern
strArgument =WScript.Arguments( intNummerDesArguments )
End if


' Ist es eine Datei?
If objFS.FileExists (strArgument) then
' Ja, Datei :
set objFile = objFS.GetFile(strArgument)
' Rückgabewert zwischenspeichern
strPath = objFS.getParentFolderName (objFile.shortpath)
' Wenn nicht: Ist es ein Ordner?
ElseIf objFS.FolderExists (strArgument) then
' Ja, Ordner :
Set objFolder = objFS.GetFolder(strArgument)
' Rückgabewert zwischenspeichern
strPath = objFolder.ShortPath
Else
' Weder Datei noch Ordner (z.B. gelöschte Datei); Rückgabewert zwischenspeichern
strPath = ""
End if

' Rückgabewert setzen
OrdnerAusArgument = strPath

End function

' ************************************************************

sub AuswertungKommandzeilenParameter (strArg)

' Nur einen Parameter, der weder Datei noch Ordner ist, auswerten.
' z.B. für /? etc.

Dim strMeldung ' für MsgBox-Meldungen
Dim strArgAlsLCase ' in Kleinbuchstaben

' vorbereiten
' Kleinbuchstaben
strArgAlsLCase = Trim( LCase ( strArg ) )
' Das vbs Case kennt kein oder (Or), deshalb hier vereinheitlichen :
if strArgAlsLCase = "/?" or strArgAlsLCase ="?" or _
strArgAlsLCase ="/help" or strArgAlsLCase ="help" or _
strArgAlsLCase ="/h" or strArgAlsLCase ="h" or _
strArgAlsLCase ="/hilfe" or strArgAlsLCase ="hilfe" then
strArgAlsLCase = "/?"
end if
if strArgAlsLCase = "/v" then
strArgAlsLCase = "/version"
end if

' auswerten
select Case strArgAlsLCase
case "/?"
strMeldung = "Hilfe zu dir2htmlview." & vbnewline
strMeldung = strMeldung & vbnewline & "Schreibt ein Dateininhaltsverzeichnis des gedroppten Ordners in ein Frame." & vbnewline
strMeldung = strMeldung & "Braucht ein Unterverzeichnis (FrameScroller) mit einigen Spezialdateien."
MsgBox strMeldung, vbInformation, strTitel
case "/version"
strMeldung = "Version lautet " + strVersion
msgbox strMeldung , vbInformation, strTitel
case else
strMeldung = "Keine Dateien oder Ordner gedroppt. Das Skript konnte Ihren Parameter nicht erkennen. "
strMeldung = strMeldung & vbnewline & "Der Parameter lautete: " & vbnewline
strMeldung = strMeldung & strArg & vbnewline & "Eventuell ist die Datei oder der Ordner gelöscht worden."
strMeldung = strMeldung & vbnewline & vbnewline & "Verwenden Sie /? für Hilfe."
msgbox strMeldung, vbcritical, strTitel
end select

end sub

' ************************************************************

function FolderExistsExtended (strPathFolder )

Dim strMeldung ' für MsgBox-Meldungen


FolderExistsExtended = true

If objFS.FolderExists ( strPathFolder ) = False Then
strMeldung = "Ein wichtiger Ordner existiert nicht. "
strMeldung = strMeldung & vbnewline & "Deshalb Abbruch." & vbnewline
strMeldung = strMeldung & "Name des Pfads: " & vbnewline & strPathFolder & "."
MsgBox strMeldung, vbInformation, strTitel
FolderExistsExtended = false
End If

end function

' ************************************************************

function FileExistsExtended (strPath)

Dim strMeldung ' für MsgBox-Meldungen


FileExistsExtended = true

If objFS.FileExists ( strPath ) = False Then
strMeldung = "Eine wichtige Datei existiert nicht. "
strMeldung = strMeldung & vbnewline & "Deshalb Abbruch." & vbnewline
strMeldung = strMeldung & "Pfad der Datei: " & vbnewline & strPath & "."
MsgBox strMeldung, vbInformation, strTitel
FileExistsExtended = false
End If

end function

' ************************************************************

sub SchreibeStringInEinFile (strDateiListe, strPath1)

' fertigen String aus RAM in die Datei auf der Festplatte schreiben

Dim objTextFile


' letztes Komma wieder weg :
strDateiListe = Left ( strDateiListe, Len(strDateiListe)-1 )
' Klammer am Ende setzen :
strDateiListe = strDateiListe + ");"

' write strDateiListe to LoadTMP.js ***************************

' Datei erstellen, alte überschreiben :
Set objTextFile = objFS.OpenTextFile(strPath1, 2, True)
' schreiben :
objTextFile.WriteLine(strDateiListe)
' schliessen :
objTextFile.Close

end sub

' ************************************************************

sub StarteProgramm (Path, Parameter)

' startet z.B. den Internet Explorer

Dim objShell
Dim strAufruf

Set objShell = WScript.CreateObject ("WScript.Shell")
strAufruf = Path & " " & Parameter
' starte Programm mit Parameter und Vollbild und warte nicht
objShell.run strAufruf, 3, True

end sub

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


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