http://dieseyer.de • all rights reserved • © 2003 v3.7

'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, CDnr
Dim Liste, LstType, Text, objArgs

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 )
WScript.Quit
End If
 
Text = ""
CDnr = 0


For Each i in DriveList
if 4 = i.DriveType AND i.IsReady Then

CDnr = CDnr +1
Text = i.DriveLetter

CDlw = CDlw & vbTab & i.DriveLetter & ":"& vbTab & i.VolumeName & vbCRLF

End If
Next

if CDnr = 1 Then
CDlw = Text
Else


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

End If


CDlw = Left( CDlw, 1) & ":"

CDlw = UCase( CDlw )

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

Liste = UCase( Liste )
Text = "Wie soll die Inhaltsliste zur CD in " & CDlw & " heißen?" & vbCRLF & vbCRLF
Liste = InputBox( Text , WScript.ScriptName, Liste )
Liste = UCase( Liste )

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 )

Sub ListeAnz ( Datei )
WSHShell.Run Datei
WScript.Sleep 1000
WshShell.SendKeys ( "^F" )
End Sub
http://dieseyer.de • all rights reserved • © 2003 v3.7