'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  

 

 

' die Inhalstlisten sollen diese Endung erhalten  

LstType = ".txt" 

 

Set WshShell  = WScript.CreateObject("WScript.Shell")        

Set fso       = CreateObject("Scripting.FileSystemObject")        

Set DriveList = fso.Drives        

 

 

' Einlesen der Argumente  

Set objArgs = WScript.Arguments  

  For i = 0 to objArgs.Count - 1  

    Liste = objArgs(i)  

    Exit For  ' Ein Argumente reicht  

  Next  

Set objArgs = nothing 

 

 

' wenn es die als Argument übergebene Datei gibt  

if fso.FileExists( Liste ) then  

  ListeAnz ( Liste )  
 
  WScript.Quit 

End If  

     

 

' Variable zurück setzen / löschen  

       Text = ""  

       CDnr = 0 

 

 

' Auf CD-Laufw. testen  

  For Each i in DriveList         

    if 4  = i.DriveType AND i.IsReady Then 

 

       CDnr = CDnr +1  ' Anzahl der CD-Laufw.  

 

       Text =                i.DriveLetter 

 

' Text für Abfrage zusammensetzen  

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

 

    End If            

  Next        

      

 

' Wenn nur ein CD-Laufw. gefunden wurde  

if CDnr = 1 Then   

  CDlw = Text 

 

' Wenn mehr als ein CD-Laufw. gefunden wurde  

Else 

 

 

' Text für Abfrage zusammensetzen  

  CDlw = "Die CD-Laufwerke enthalten folgende CD's:" & vbCRLF & vbCRLF & CDlw       

  CDlw = CDlw & "Von welchem Laufwerk soll eine Inhaltsliste erzeugt werden?"       

 

' Abfrage / CD-Laufw.-Auswahl  

  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 ) 

 

 

' CD-Laufw. auswählen (ansprechen)  

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 ' (potentieller) Inhaltslisten-Name  


 
 

' Text für Abfrage zusammensetzen  

Liste = UCase( Liste ) 

Text = "Wie soll die Inhaltsliste zur CD in   " & CDlw & "   heißen?" & vbCRLF & vbCRLF

 

' Abfrage: neuer Inhaltslisten-Name  

Liste = InputBox( Text , WScript.ScriptName, Liste ) 

Liste = UCase( Liste ) 

 
 
 

' Zum Inhaltslisten-Name wird immer eine Zahl (1..9) hinzu gefügt. 

' Gibt es Liste-1 noch nicht, wird diese jetzt verwendet.  

if not fso.FileExists( Liste & "1" & LstType ) then    

  Liste = Liste & "1" & LstType  

Else   

 

 

' Abfrage zum Inhaltslisten-Namen zusammensetzen  

      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    

    

 

' Abfrage zum Inhaltslisten-Namen  

  Text = MsgBox( Text, 3 + 32, WScript.ScriptName )   

 

 

' Abfrage => [Abbrechen] 

  if Text = vbCancel then   

    MsgBox ". . . das ist das Ende!", , Wscript.ScriptName       

    Wscript.Quit       

  End If   

 

 

' Abfrage => [Nein]: Dateien löschen  

  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   

 

 

' Abfrage => [Ja]: weitere Dateien erzeugen  

  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   

 

 

' Inhaltsliste-Kopf erstellen  

Set FileOut = fso.OpenTextFile( Liste, 8, True)  

    FileOut.WriteLine Liste & " - Verzeichnis vom " & Now  

    FileOut.WriteLine " "  

    FileOut.Close  

Set FileOut = nothing  

 

 

' Inhaltsliste-Kopf durch DIR füllen  

WSHShell.Run "%comspec% /c dir " & CDlw & "\ /s /b >> " & Liste, ,True 

 

ListeAnz ( Liste )  
 
 

 

'*********************************************************  

Sub ListeAnz ( Datei ) ' Anfang  

'*********************************************************  

  WSHShell.Run Datei 

  WScript.Sleep 1000  

  WshShell.SendKeys ( "^F" )  

End Sub ' ListeAnz ( Datei ) ' Ende  

'*********************************************************