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

' **************************************************
' * 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 "<html>" & vbcrlf & "<head>" & vbcrlf
headerTxt="<SCRIPT type=""text/javascript"" LANGUAGE=""JavaScript"">" & vbcrlf
headerTxt=headerTxt & " function executeCommands(commandParms)" & vbcrlf
headerTxt=headerTxt & " {var oShell = new ActiveXObject(""Shell.Application"");" & vbcrlf
headerTxt=headerTxt & " var commandtoRun = ""Notepad.exe"";" & vbcrlf
headerTxt=headerTxt & " oShell.ShellExecute(commandtoRun, commandParms);}" & vbcrlf
headerTxt=headerTxt & "</SCRIPT>" & vbcrlf
HtmlDatei.writeline headerTxt
HtmlDatei.writeline "</head><body>"
HtmlDatei.writeline "<h2>Liste der Scripte</h2>"
HtmlDatei.writeline "<FORM name=""Form1"">"

HtmlDatei.writeline "<table border='1'>"
CollectFiles IFolder 'übergibt das Folder-Objekt
HtmlDatei.Write liste
HtmlDatei.writeline "</table></FORM>"
HtmlDatei.writeline "</body>"
HtmlDatei.writeline "</html>"

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 "<tr>"
HtmlDatei.Writeline "<td><p>" & tpfad & "</p></td>"
Butt = "<input type=""Button"" name=""Butt2"" value=""open"" onClick=""executeCommands("
Butt = Butt & Zeile & chr(39) & tpfad & "\" & dateiname & chr(39) & ")"" >"
Butt = Replace(Butt, "\", "\\") 'Für den JS-Interpreter den Backslash maskieren
HtmlDatei.Writeline "<td><p>" & Butt & "</p></td>"
HtmlDatei.Writeline "<td><p>" & dateiname & "</p></td>"
HtmlDatei.Writeline "<td><p>" & Txt & "</p></td>"
HtmlDatei.Writeline "</tr>"
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

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