'v6.3======================================================================
'
' VBSkript Quelldatei
'
' NAME:    Searchmp3text.vbs
'
' AUTOR:   Michael Wende , Werne
' DATUM  : 11.03.06
'
' KOMMENTAR:  Nach der Erfassung aller Mp3s auf Ihren Festplatten durch
'             Searchallmp3s.vbs in der Datei "Alle MP3s vom aktuellem Datum.txt"
'             (z.B. "Alle MP3s vom 11.03.06.txt") können Sie nun mit Searchmp3text.vbs
'             einen beliebigen Titel,(Interpret) suchen und mit dem Player Ihrer Wahl
'             abspielen.
'
'===========================================================================


' ***************** Start des Programmes ***********************************

Dim searchstr,MyDate,s,Lw             ' Ich brauche ein paar Variablen
Dim mytab(),mp3counter,filepath,z,wasplayed
Dim startpos,givelastfilepath,isda,msgtext

s=""                       

' Welchen Songtext suchen?
searchstr = InputBox("Bitte Mp3 - Suchbegriff (z.B. Titel) angeben!","Eingabe","Born to be wild")
searchstr=UCase(searchstr)

IF searchstr = "" Then wscript.Quit

Lw = CurrentDir()                   ' Die Datei "Alle Mp3s vom ....txt" sollte im aktuellen Qrdner sein.

isda=0                              ' Schalter,der überprüft,ob Datei vorhanden

' Nun wird die jeweils zuletzt angelegte Datei ausfindig gemacht und
' der Funktion readFile zur Verfügung gestellt.

RecurseFiles(Lw)    ' durchsucht aktuelles Laufwerk nach "Alle MP3s vom tt.mm.jj.txt"
                    ' und speichert sie mit dem Dateialter in die Tabelle mytab()
                    ' Die zuletzt gespeicherte Datei "Alle MP3s vom tt.mm.jj.txt",
                    ' ist die mit dem niedrigsten Abstandswert vom aktuellen Datum und
                    ' somit in Lbound(mytab) gespeichert;denn es soll immer die
                    ' letzte (aktuellste) Datei aufgerufen werden. 

If isda = 0 Then    ' Gibt es überhaupt schon eine "Alle MP3s vom tt.mm.jj.txt"?
  msgtext= "Es wurde keine Datei ""Alle MP3s vom ... .txt"" gefunden." &vbCrlf _
         & "Bitte zuerst Searchallmp3s.vbs aufrufen und dann noch einmal Searchmp3text.vbs starten!"
  MsgBox msgtext,vbOKOnly,"Achtung!"
  WScript.Quit()
End If


QSort mytab, Lbound(mytab), Ubound(mytab)                   ' Nun Tabellenwerte sortieren
   
   startpos=InStr(1,mytab(Lbound(mytab)),":")               ' Pfad zur Datei ausfiltern und
   givelastfilepath = Mid(mytab(Lbound(mytab)),startpos-1)  ' givelastfilepath übergeben

 wasplayed=0                                                ' Schalter,ob Song gespielt wurde
 readFile givelastfilepath,searchstr                        ' Jetzt Songtitel,Interpret suchen
                                                            ' und evtl. abspielen.

If wasplayed = 0 and Not s =""  Then
 MsgBox "Jetzt keine Musik hören? Na dann vielleicht beim nächsten Mal - Tschüss!"
End If 

If s ="" Then
 msgbox "Suchbegriff: " &searchstr &vbCrlf &" wurde leider nicht gefunden!"
End If

' ***************** Ende des Programmes ************************************


' ***************** Funktionen und Unterprogramme (Subs) *******************

Public Function readFile(fname,Suchbegriff)
 Dim Insatz,oFS,oFile,inputfile,neudatei,MyShell
 Dim MyPos,getit,zaehl 

 SET MyShell=CreateObject("Wscript.Shell")
 Set oFS = CreateObject("Scripting.FileSystemObject")
 Set oFile = oFS.GetFile(fname)
 Set inputfile = oFile.OpenAsTextStream      ' Eingabedatei öffnen
 zaehl=0                                     ' Am Anfang Zaehler auf Null
 
 Do while not inputfile.AtEndOfStream   ' bis Ende Eingabedatei lesen und neue Ausgabedatei erstellen und 
  Insatz = inputfile.ReadLine            
  MyPos = Instr(1, Lcase(Insatz), Lcase(Suchbegriff))   
       If Mypos > 0 Then
          zaehl = zaehl + 1
          s = s & zaehl & ". Übereinstimmung in " & Insatz & " gefunden" &vbCrlf
          getit=  msgbox(s & "Jetzt abspielen?",vbyesno,"Song abspielen?")
          If getit = vbYes Then
           myShell.Run """" & Insatz & """", , True 
           wasplayed = 1
           Exit Do
          End If
       End if
 Loop
  inputfile.Close
 End Function


Sub QSort(aData, iaDataMin, iaDataMax)
  Dim Temp 
  Dim Buffer 
  Dim iaDataFirst
  Dim iaDataLast
  Dim iaDataMid

  iaDataFirst = iaDataMin                        ' Lege Größe fest
  iaDataLast = iaDataMax

  If iaDataMax <= iaDataMin Then Exit Sub        ' Fehler!  
  iaDataMid = (iaDataMin + iaDataMax) \ 2        ' Finde die Mitte der Tabelle

  Temp = aData(iaDataMid)                        ' Der Startpunkt der Sortierung in der
                                                 ' Annahme, daß die Tabelle bereits
                                                 ' teilweise sortiert vorliegt!

  Do While iaDataFirst <= iaDataLast
      'Vergleiche hier
        Do While aData(iaDataFirst) < Temp
          iaDataFirst = iaDataFirst + 1
          If iaDataFirst = iaDataMax Then Exit Do
      Loop

      'Vergleiche hier
       Do While Temp < aData(iaDataLast)
          iaDataLast = iaDataLast - 1
          If iaDataLast = iaDataMin Then Exit Do
      Loop

      If iaDataFirst <= iaDataLast Then           ' wenn kleinstes Element  
          Buffer = aData(iaDataFirst)             ' <= dem größten Element
          aData(iaDataFirst) = aData(iaDataLast)  ' dann tausche Elemente
          aData(iaDataLast) = Buffer
          iaDataFirst = iaDataFirst + 1  
          iaDataLast = iaDataLast - 1 
      End If
  Loop

  If iaDataMin < iaDataLast Then                 ' Rekursion falls nötig
      QSort aData, iaDataMin, iaDataLast
  End If

  If iaDataFirst < iaDataMax Then                ' Rekursion falls nötig
      QSort aData, iaDataFirst, iaDataMax
  End If

End Sub 'QSort Ende

Function RecurseFiles(aFolder)             'aFolder = Pfadname zum Ordner mit \ am Ende
Dim fils, fil, fols, fol,mycoll,fos,folders
Dim mp3counter,MyPos
    'On Error Resume Next
    Set fos = CreateObject("Scripting.FileSystemObject")
    Set folder = fos.GetFolder(aFolder)
    Set fils = folder.Files

     mp3counter=0
     If Err.Number <> 0 Then Exit Function

    ' Jetzt wird jede gefundene Datei abgearbeitet
    For Each fil In fils
       
       mycoll=fos.BuildPath(aFolder,fil.name)
     ' MsgBox Mycoll
      MyPos = Instr(1, mycoll, "Alle MP3s vom", 1)
      
      if  MyPos  > 0 Then
        ReDim Preserve mytab(mp3counter)
        mytab(mp3counter) = FileAge(mycoll) & mycoll    
        mp3counter = mp3counter + 1
        isda = 1
      end if

    Next

End Function

Function CurrentDir()
    Dim newfso
    Set newfso = WScript.CreateObject("Scripting.FileSystemObject")
    CurrentDir = newfso.GetAbsolutePathName(".")
End Function 

Function FileAge(sPath)
 ' Gibt Alter der Datei in Tagen an
 With CreateObject("Scripting.FileSystemObject")._
  GetFile(sPath)
  FileAge = CLng(Now) - CLng(.DateLastModified)
  'FileAge = CDbl(Now) - CDbl(.DateLastModified)
 End With
End Function

' ***************** Ende Funktionen und Unterprogramme (Subs) *******************