'v5.C=========================================================================================== ' ' NAME: convert-b4s-to-m3u.vbs ' ' AUTOR: Michael Wende - wende@helimail.de ' dieseyer.de ' DATUM: 28.12.05 ' ' KOMMENTAR: Wandelt in einem angegebenen Ordner alle .4bs Winampplaylistdatei(en) ' in m3u Playlist(en). Die Idee kam mir, als ich einige Winamp Playlisten ' für die Sylvesterparty auf CD brennen wollte. Mir fiel auf, dass ich ' noch einige .b4s Winamp3 Playlisten auf meinem Rechner habe. Mittlerweile ' habe ich Winamp 5 im Einsatz. Zu meinem Entsetzen kann Winamp 5 diese nicht ' abspielen oder konvertieren. Auch mein Brennprogramm Nero kann mit .b4s ' Dateien nichts anfangen. Bei meiner Suche im Internet kam ich auf ein ' Freewaretool "veeXChange" von www.krank.hu. Mein Virenscanner meinte aber, ' dass diese .zip Datei verseucht sei und löschte sie wieder. ' So kam ich auf die Idee, mir ein geeignetes Skript selbst zu schreiben... '================================================================================================== ' Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl Dim myxmlstr,myxmlstr2,myxmlstr3 Dim myfsObject,dateiname,m3uFile,textziel Dim Ordner,Song,Laenge,arg,antwort Dim strfiles(),vonAnfang,bisEnde,i,anzfiles Set myfsObject=CreateObject("Scripting.FileSystemObject") Set oFs=CreateObject("Scripting.FileSystemObject") arg = BrowseForFile("Bitte Ordner mit .b4s Playlisten auswählen!","Ordnerwahl") If arg = "" Then WScript.Quit End If If Mid(arg,Len(arg),Len(arg))= "\" then ' Ist Backslash am Ende,dann OK textziel = arg Else textziel = arg & "\" ' sonst Backslash anhängen End If Redim strfiles(0) strfiles(0)="" anzfiles=0 walkdirs(textziel) If anzfiles > 0 Then antwort= MsgBox("Fertig! m3u Playliste(n) wurden erstellt. Möchten Sie jetzt die .b4s Playlisten löschen?",VbYesNo,"Achtung!") If antwort = VbYes Then vonAnfang =LBound(strfiles) : bisEnde = UBound(strfiles) For i=vonAnfang To bisEnde ' MsgBox strfiles(i) & " wird gelöscht!" oFs.DeleteFile(strfiles(i)) Next MsgBox "Alle .b4s Winamp3 Playlisten wurden gelöscht!" End If Else MsgBox "Sorry, ich konnte leider keine .b4s Winamp3 Playlisten finden!" End If ' Ende des Programmes ' ********* Funktionen und Unterprogramme (Subs) ********************************************************** '********************************************************* Sub walkdirs(arg) '********************************************************* If oFs.FolderExists(arg) Then Set thisDir = oFs.GetFolder(arg) Set subDirs = thisDir.SubFolders Set theseFiles = thisDir.Files If subDirs.Count > 0 Then For Each dirName in subDirs walkdirs(dirName) Next End If For Each fileName in theseFiles If oFs.GetExtensionName(fileName) = "b4s" Then If strfiles(0) = "" Then strfiles(0) = fileName Else Redim Preserve strfiles(Ubound(strfiles,1) + 1) strfiles(Ubound(strfiles,1)) = fileName End If End If walkdirs(fileName) Next ElseIf oFs.FileExists(arg) Then If oFs.GetExtensionName(arg) = "b4s" Then convertFile(arg) End If End If End Sub ' walkdirs(arg) '********************************************************* Sub convertFile(fname) '********************************************************* 'Zur Veranschaulichung konvertiert wird von Beispiel1 nach Beispiel2 'Beispiel1 .b4s Winampplaylist ' ' ' ' ' CREAM - N.S.U. ' 615000 ' ' CREAM - Sleepy Time Time ' 412000 ' 'Beispiel2 .m3u Winampplaylist '#EXTM3U '#EXTINF:615,CREAM - N.S.U. '01 - CREAM - N.S.U..mp3 '#EXTINF:412,CREAM - Sleepy Time Time '02 - CREAM - Sleepy Time Time.mp3 Dim m3ufile,sMP3,oFS,oFile,oM3U m3ufile = Left(fname, Len(fname) - 4) & ".m3u" ' = Ausgabedatei Set oFS = CreateObject("Scripting.FileSystemObject") Set m3uFile=oFS.CreateTextFile(m3ufile, 1) ' Ausgabedatei öffnen Set oFile = oFS.GetFile(fname) Set oM3U = oFile.OpenAsTextStream m3uFile.WriteLine("#EXTM3U") ' Den Anfang einer .m3u Datei schreiben anzfiles=anzfiles + 1 ' zähle die Anzahl der .b4s Dateien Ordner="":Song="":Laenge="" ' Was ich jetzt öfter belege, initialisieren do while not oM3U.AtEndOfStream ' .b4s Datei lesen und .m3u Datei erstellen sMP3 = oM3U.ReadLine If IsinStr("") if IsinStr("", sMP3)= True Then Song = stripfromxml( sMP3,"","") if IsinStr("", sMP3)= True Then Laenge = stripfromxml( sMP3,"","") ' Die 3 relevanten Daten werden aus der .b4s (XML)Datei extrahiert ' und den Variablen Song,Ordner,Laenge übergeben If Song <> "" And Laenge <> "" Then Song = HtmlDecode(Song) ' Sonderzeichen der XML .b4s Datei dekodieren m3uFile.WriteLine "#EXTINF:" & Laenge & ","& Song Song="" : Laenge = "" If Ordner <> "" Then Ordner = Mid(Ordner,2,Len(Ordner)-2) Ordner = HtmlDecode(Ordner) ' Sonderzeichen der XML .b4s Datei dekodieren m3uFile.WriteLine Ordner Ordner="" End If End If Loop m3uFile.Close End Sub ' convertFile(fname) '********************************************************* Function stripfromxml (xmlstring,xmlpart1,xmlpart2) '********************************************************* Dim pos1,pos2,thename thename="" pos1 = instr(xmlstring,xmlpart1) If pos1 Then thename = mid(xmlstring,pos1+len(xmlpart1),Len(xmlstring)) End If pos2 = instr(thename,xmlpart2) If pos2 then thename = mid(thename,1,(pos2)-1) If xmlpart1="" then thename = striplastzeroes(thename) ' Länge wird mit 6 Ziffern angegeben, deshalb letzte Nullen löschen stripfromxml = thename ' das kann zu falschen Songlängen führen. siehe unten. End Function ' stripfromxml (xmlstring,xmlpart1,xmlpart2) '********************************************************* Function BrowseForFile(strPrompt,strtitle) '********************************************************* 'Benutzt die "Shell.Application" (nur anzutreffen in Win98 and neuer) 'um das Datei/Ordner Fenster aufzurufen. Nicht unter Win95. 'Shell32.ShellSpecialFolderKonstanten Const ssfPERSONAL = 5 'Meine Dokumente Const ssfDRIVES = 17 'Mein Computer Const SFVVO_SHOWALLOBJECTS = 1 Const SFVVO_SHOWEXTENSIONS = 2 Const SFVVO_SHOWFILES = 16384 Dim sh, fol, fs, lngView, strPath,i Set sh = CreateObject("Shell.Application") If Instr(TypeName(sh), "Shell") = 0 Then BrowseForFile = InputBox(strPrompt, strtitle, CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName) & "Pfad\Dateiname") Exit Function End If Set fs = CreateObject("Scripting.FileSystemObject") lngView = SFVVO_SHOWALLOBJECTS Or SFVVO_SHOWEXTENSIONS Or SFVVO_SHOWFILES strPath = "" Set fol = sh.BrowseForFolder(&0, strPrompt, lngView, ssfDRIVES) On Error Resume Next strPath = fol.ParentFolder.ParseName(fol.Title).Path If strPath = "" Then strPath = fol.Title Set fol = fol.ParentFolder strPath = fs.BuildPath(fol.ParentFolder.ParseName(fol.Title).Path, strPath) i = InStr(strPath, ":") strPath = Mid(strPath, i - 1, 1) & ":\" ' Nur Laufwerk:\ zurückgeben End If BrowseForFile = strPath End Function ' BrowseForFile(strPrompt,strtitle) '********************************************************* Function IsinStr(muster, zkette) '********************************************************* Dim regEx, retVal ' Variablen,die ich brauche. Set regEx = New RegExp ' Regulären Ausdruck erstellen. regEx.Pattern = muster ' Setze Muster. regEx.IgnoreCase = True ' Groß-Kleinschreibung ausschalten. retVal = regEx.Test(zkette) ' Führe Durchsuchung aus. if retVal Then IsinStr = True Else IsinStr = False End Function ' IsinStr(muster, zkette) '********************************************************* public Function HtmlDecode( sText) '********************************************************* 'Wie in HTML müssen auch in XML Sonderzeichen speziell formatiert werden. Die fünf Zeichen &, ', <, > und " 'werden wie in HTML angegeben: ' ' hex ´ oder ' ' & & ' < < ' > > ' " " 'Umlaute und das ß müssen aber so definiert werden: ' Ä Ä hex c4 ' Ö Ö hex d6 ' Ü Ü hex dc ' ä ä hex e4 ' ö ö hex f6 ' ü ü hex fc ' ß ß hex df ' € € hex 20ac ' Alles dies erledigt die Function HtmlDecode sText = Replace(sText, "Ä", "Ä") sText = Replace(sText, "Ö", "Ö") sText = Replace(sText, "Ü", "Ü") sText = Replace(sText, "ä", "ä") sText = Replace(sText, "ö", "ö") sText = Replace(sText, "ü", "ü") sText = Replace(sText, "ß", "ß") sText = Replace(sText, "€", "€") sText = Replace(sText, "?", "'") sText = Replace(sText, "<", "<") sText = Replace(sText, ">", ">") 'sText = Replace(sText, """, """") sText = Replace(sText, "$", "$") sText = Replace(sText, "&", "&") sText = Replace(sText, "´", "'") sText = Replace(sText, """, """") sText = Replace(sText, " ", " ") sText = Replace(sText, "&bsp;", " ") HtmlDecode = sText End Function ' HtmlDecode( sText) '********************************************************* Function striplastzeroes(strNumber) '********************************************************* ' Es kann sein, dass die Songlänge nicht richtig angegeben wird; denn ' in .b4s Playlisten werden 6 Ziffern für die Dateilänge verwendet. ' Ist ein Song 1000 Sekunden lang wird er nach der striplastzeroes Funktion ' auf 100 Sekunden gekürzt. Das ist jedoch nicht so schlimm, wie es scheint, ' da Winamp die falsche Songdauer automatisch korrigert. Dim MyLong1 MyLong1 = CLng(strNumber) If (MyLong1 mod 1000) <> 0 Then striplastzeroes = CStr(Mylong1/100) Else striplastzeroes = CStr(Mylong1/1000) End If End Function ' striplastzeroes(strNumber)