http://dieseyer.de • all rights reserved • © 2011 v11.4

'v6.3======================================================================
'
' VBScript Quelldatei
'
' NAME: Searchallmp3s.vbs
'
' AUTOR: Michal Wende , Werne
' DATUM : 09.03.06
'
' KOMMENTAR: Durchsucht alle Festplattenlaufwerke nach .mp3 und .wma Dateien
' und schreibt den Pfad dieser Dateien in die
' "Alle MP3s vom aktuellen Datum.txt"
'==========================================================================

' #### Variablendeklarationen ####
Public s
Dim Counter,Drive,helpme,dateiname
Dim myfsObject,mp3File,mp3counter
Dim startzeit,endzeit

' #### Start des Programmes ####

dateiname = "Alle MP3s vom " & Date & ".txt"
Set myfsObject=CreateObject("Scripting.FileSystemObject")
Set mp3File=myfsObject.CreateTextFile(dateiname, 1)

mp3counter=0
startzeit = Time ' startet die Zeitmessung

For Counter = 2 to 25
Drive = chr( 65 + Counter ) & ":\"
helpme=ShowDriveType(Drive) & vbCRlf
If Not helpme = vbCrlf then
RecurseFiles(Drive)
End If
Next

mp3File.WriteLine "Insgesamt wurden " & mp3counter & " mp3 b.z.w wma Dateien auf Ihren Festplatten gefunden!"
mp3File.Close

endzeit = Time ' beendet die Zeitmessung

MsgBox "Fertig! Ich habe " & mp3counter & " .mp3 b.z.w .wma Dateien in " &TimeDiff(startzeit, endzeit) &" gefunden!"
' #### Ende des Programmes ####


'**************** Funktionen ***************************************************************

Function ShowDriveType(drvpath)
Dim fso, d
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set d = fso.GetDrive(drvpath)
Select Case d.DriveType
Case 0: ' "Unbekannter Datenträger"
Case 1: ' "Wechseldatenträger"
Case 2: ShowDriveType = d.DriveLetter & ":\" ' "Festplattenlaufwerke"
Case 3: ' "Netzwerklaufwerk"
Case 4: ' "CD-ROM/DVD"
Case 5: ' "RAM Disk"
End Select

End Function


Function RecurseFiles(aFolder) 'aFolder = Pfadname zum Ordner mit \ am Ende
Dim fils, fil, fols, fol,mycoll,fos,folders
'On Error Resume Next

Set fos = CreateObject("Scripting.FileSystemObject")
Set folder = fos.GetFolder(aFolder)
Set fils = folder.Files

If Err.Number <> 0 Then Exit Function
' Jetzt wird jede gefundene Datei abgearbeitet
For Each fil In fils
mycoll=fos.BuildPath(aFolder,fil.name)
if LCase(right(mycoll, 3))="mp3" OR LCase(right(mycoll, 3))="wma"Then
mp3File.WriteLine(mycoll)
mp3counter = mp3counter + 1
end if

Next

'Prüfe auf Unterordner und durchlaufe sie,falls vorhanden

Set fols = folder.SubFolders

For each fol in fols
If Lcase(fol.Name) <> "recycled" Then ' Alle ausser dem Papierkorb
RecurseFiles(fol)
End If
mycoll=fos.BuildPath(aFolder,fol.name)
Next
End Function

'============================================================================
' TimeDiff berechnet die Zeitspanne zwischen 2 Uhrzeiten (startdate,enddate)
'============================================================================
'Aufruf:
'Dim startzeit,endzeit
'startzeit = time
'Programmcode ...
'endzeit = time
'MsgBox "Ausführungsdauer des Programmes : " &TimeDiff(startzeit, endzeit)

Function TimeDiff(ByVal startDate, ByVal endDate)
' lokale Variablen
Dim std, min, sek
Dim sekDiff

' berechne den Zeitunterschied in Sekunden
sekDiff = DateDiff("s", CDate(startDate), CDate(endDate))
' StdStd:MinMin:SekSek
' Rückgabe des Zeitunterschiedes in der Form hh:mm:ss
std = CLng(sekDiff \ 3600)
If std > 0 Then sekDiff = sekDiff - std * 3600
If std < 10 Then std = CStr("0" & std)

min = CLng(sekDiff \ 60)
If min > 0 Then sekDiff = sekDiff - min * 60
If min < 10 Then min = CStr("0" & min)

sek = CLng(Abs(sekDiff))
If sek < 10 Then sek = CStr("0" & sek)

TimeDiff = std & " Std: " & min & " Min: " & sek & " Sek:"

End Function



http://dieseyer.de • all rights reserved • © 2011 v11.4