'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