http://dieseyer.de • all rights reserved • © 2011 v11.4
'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) *******************
http://dieseyer.de • all rights reserved • © 2011 v11.4