http://dieseyer.de • all rights reserved • © 2011 v11.4
'v3.7*****************************************************
' File: CDdurchsuchen.vbs
' Autor: dieseyer@gmx.de
' dieseyer.de
'
' Das Skript sucht nach einem CD-Laufwerk und schreibt
' eine Inhaltsliste, die durchsucht werden kann.
' Oder man zieht eine Datei auf das Skript, die sich dann
' durchsuchen lässt.
'*********************************************************
Option Explicit
Dim WshShell, fso, FileOut, DriveList, i, CDlw
Dim Liste, LstType, Text, objArgs
LstType = ".html"
LstType = ".txt"
Set WshShell = WScript.CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set DriveList = fso.Drives
Set objArgs = WScript.Arguments
For i = 0 to objArgs.Count - 1
Liste = objArgs(i)
Exit For
Next
Set objArgs = nothing
if fso.FileExists( Liste ) then
ListeAnz ( Liste )
End If
For Each i in DriveList
if 4 = i.DriveType AND i.IsReady Then
CDlw = CDlw & vbTab & i.DriveLetter & ":"& vbTab & i.VolumeName & vbCRLF
End If
Next
CDlw = "Die CD-Laufwerke enthalten folgende CD's:" & vbCRLF & vbCRLF & CDlw
CDlw = CDlw & "Von welchem Laufwerk soll eine Inhaltsliste erzeugt werden?"
CDlw = InputBox( CDlw, WScript.ScriptName)
If CDlw = "" then
MsgBox ". . . das ist das Ende!", , Wscript.ScriptName
Wscript.Quit
End If
CDlw = Left( CDlw, 1) & ":"
Set i = fso.GetDrive( CDlw )
if not 4 = i.DriveType OR not i.IsReady Then
MsgBox UCase( CDlw ) & " ist kein CD-Laufwerk!" & vbCRLF & vbCRLF & ". . . das ist das Ende!", , WScript.ScriptName
Wscript.Quit
End If
Liste = i.VolumeName
if not fso.FileExists( Liste & "1" & LstType ) then
Liste = Liste & "1" & LstType
Else
Text = "Zu der CD " & Liste & " in Laufwerk " & UCase( CDlw ) & " existieren folgende Inhaltslisten:" & vbCRLF & vbCRLF
For i = 1 to 9
if fso.FileExists( Liste & i & LstType ) then
Text = Text & Liste & i & LstType & vbCRLF
End If
Next
Text = Text & vbCRLF
Text = Text & "[JA]" & vbTab & " Eine weitere Datei anlegen (notfalls eine Löschen)." & vbCRLF
Text = Text & "[Nein]" & vbTab & " Alle Dateien löschen und eine " & Liste & "1" & LstType & " erstellen." & vbCRLF
Text = MsgBox( Text, 3 + 32, WScript.ScriptName )
if Text = vbCancel then
MsgBox ". . . das ist das Ende!", , Wscript.ScriptName
Wscript.Quit
End If
if Text = vbNo then
For i = 1 to 9
if fso.FileExists( Liste & i & LstType ) then fso.DeleteFile( Liste & i & LstType ), true
Next
Liste = Liste & "1" & LstType
End If
if Text = vbYes then
For i = 9 to 1 Step -1
if not fso.FileExists( Liste & i & LstType ) then Text = i
Next
If Text < 1 then
MsgBox "Es gibt bereits 9 " & Liste & " Dateien - es MUSS gelöscht werden!" & vbCRLF & vbCRLF & ". . . das ist das Ende!", , Wscript.ScriptName
Wscript.Quit
End If
Liste = Liste & Text & LstType
End If
End If
Set FileOut = fso.OpenTextFile( Liste, 8, True)
FileOut.WriteLine Liste & " - Verzeichnis vom " & Now
FileOut.WriteLine " "
FileOut.Close
Set FileOut = nothing
WSHShell.Run "%comspec% /c dir " & CDlw & "\ /s /b >> " & Liste, ,True
ListeAnz ( Liste )
Wscript.Quit
Sub ListeAnz ( Datei )
WSHShell.Run Datei
WScript.Sleep 1000
WshShell.SendKeys ( "^F" )
End Sub
http://dieseyer.de • all rights reserved • © 2011 v11.4