' ************************************************** ' * AUTOR: Hansi Rau NOV. 2003 ' * VBS Script Dateienen finden inkl. Subfolders ' * und deren Kommentarzeilen in eine HTML Datei ' * scriptinfo.htm schreiben. ' * Diese Datei in den Startordner legen und starten ' ************************************************** Const ForReading = 1, ForWriting = 2, ForAppending = 8 Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0 Dim fso, IFile Dim Pfad, Dateiname Txt = "" Set fso = CreateObject("Scripting.FileSystemObject") Set wshShell = createObject("WScript.Shell") pfad=WScript.ScriptFullName Startordner = Left(pfad, InstrRev(pfad, "\")) 'als string Set IFolder = fso.GetFolder(startordner) 'Startordner als FolderObjekt Extension="vbs" HtmlDateiName = "scriptinfo.html" Set HtmlDatei = fso.CreateTextFile (startordner & HtmlDateiName, true) HtmlDatei.writeline "" & vbcrlf & "" & vbcrlf headerTxt="" & vbcrlf HtmlDatei.writeline headerTxt HtmlDatei.writeline "" HtmlDatei.writeline "

Liste der Scripte

" HtmlDatei.writeline "
" HtmlDatei.writeline "" CollectFiles IFolder 'übergibt das Folder-Objekt HtmlDatei.Write liste HtmlDatei.writeline "
" HtmlDatei.writeline "" HtmlDatei.writeline "" HtmlDatei.close 'msgbox(fertig) ' hier könnte man den ie öffnen wshshell.Run """" & HtmlDateiName & """" ' ********** logisches Ende Sub CollectFiles(IFolder) On Error Resume Next For each IFile in IFolder.Files ext = LCase(fso.GetExtensionName(IFile.Name)) If LCase(right(IFile.name, 3))= extension then pfad = IFile.Path Dateiname = IFile.Name erstellZeilen pfad End If Next For each Subfolder in IFolder.SubFolders CollectFiles Subfolder Next On Error Goto 0 End sub Sub erstellZeilen(pfad) Set ODatei=fso.GetFile(pfad) 'Hole Dateihandle und erstelle ein Textstreamobjekt Set Scriptdatei=ODatei.OpenAsTextStream(ForReading,TristateFalse) i=10 z=0 Txt = "" x="'" fertig = false While z < 10 'mehr als 10 Zeilen braucht man nicht auszuwerten z = z + 1 x = ScriptDatei.ReadLine if InStr(1,x,Chr(39))=1 then 'Zeile beginnt mit Hochkomma x = Replace(x, chr(39), "", 1, 1) Txt = Txt & " " & x if ScriptDatei.AtEndOfStream = True then z = 99 end if end if wend ScriptDatei.close Txt = trim(cleanup(Txt)) writeZeile Left(pfad, InstrRev(pfad, "\")-1), dateiname, Txt End sub Sub writeZeile(tpfad, dateiname, Txt) HtmlDatei.Writeline "" HtmlDatei.Writeline "

" & tpfad & "

" Butt = "" Butt = Replace(Butt, "\", "\\") 'Für den JS-Interpreter den Backslash maskieren HtmlDatei.Writeline "

" & Butt & "

" HtmlDatei.Writeline "

" & dateiname & "

" HtmlDatei.Writeline "

" & Txt & "

" HtmlDatei.Writeline "" End sub function cleanup(text) 'das jeweilige zeichen sollte 3 mal gesucht werden, bevor es als überflüssig gilt If instr(1,text,"*")>0 then 'suche nach "*" 'testcleanup = Replace(Text, "*", "", 1, 5) 'if not len(text)-len(testcleanup) > 1 then text = Replace(Text, "*", "") end if If instr(1,text,"-")>0 then 'suche nach "-" 'testcleanup = Replace(Text,"-", "", 1, 5) 'if not len(text)-len(testcleanup) > 1 then text = Replace(Text,"-", "") end if If instr(1,text,"=")>0 then 'suche nach "=" 'testcleanup = Replace(Text, "=", "", 1, 5) 'if not len(text)-len(testcleanup) > 1 then text = Replace(Text, "=", "") end if cleanup = text end function