Datenträger nach MP3s durchsuchen - Inhalt inkl. MusikTitel, Dauer, Interpret, Album, Jahr, kbits, Genre in eine .mdb schreiben

In Anlehnung an die Anleitung der letzten Woche nun eine Abwandlung für .mdb (damit man später per asp(x) eine Website mit Suchfunktion basteln kann....

Das Vorwort nennt schon alle relevanten Ideen...
Erklärungen zur Veränderungen finden sich in dieser Anleitung...

Dieser Code stellt auch nicht der letzten Weisheit Schluss dar, sondern soll hauptsächlich dazu dienen, Teile oder den gesamten Code als Grundlage für eigene Projekte zu verwenden...

Daher hier einfach nur der Code, der - unverändert - nur für XP funktioniert...:

Welches Ergebnis erhält man durch diesen Code?
Es wird ein Gesamtes Laufwerk bzw. bestimmter Ordner inkl. aller Unterordner auf Dateien durchsucht, die mit Eurem Musikplayer (in meinem Fall Winamp) standardmäßig geöffnet werden.
(m3u - Dateien werden von der Suche ausgespart).
Dann wird eine Datenbank erstellt, die 2 Tabellen enthält.
In der 1. Tabelle befinden sich die Ordnernamen (da ich meine Alben jeweils in eigene Unterordner gespeichert habe)
In der 2. Tabelle befinden sich alle Musiktitel inkl. Dauer, Interpret, Album, Jahr, kbits, Genre.
Zur späteren Verknüpfung der beiden Tabellen haben die jeweiligen Titel den selben Indexwert, wie ihn der Ordner hat.
Wenn im m3-Tag das Album bzw. der Interpret fehlt, wird der Ordner ausgelesen und entsprechendes in die Tabelle eingetragen
(bei mir nennen sich alle Ordner nach folgendem Muster:
LW:\Musik\A\#Allman Brothers\cd_Allman Brothers - Idlewild South

Was ist anzupassen?
Bei Verwendung von XP: NICHTS!

Bei Verwendung von Vista / 7 folgenden Teil

id = indexwert
Titel = objFolder.GetDetailsOf(strFileName, 0)
Dauer = objFolder.GetDetailsOf(strFileName, 21)
Interpret = objFolder.GetDetailsOf(strFileName, 16)
Album = objFolder.GetDetailsOf(strFileName, 17)
Jahr = objFolder.GetDetailsOf(strFileName, 18)
bit = objFolder.GetDetailsOf(strFileName, 22)
Genre = objFolder.GetDetailsOf(strFileName, 20)

nach dieser Liste...

Ordner_in_mdb.hta

<head>
<meta name="author" content="Edi Pfisterer aka urobe73_administrator.de">  
<meta name="generator" content="Ulli Meybohms HTML EDITOR">  
<title>Edis Dateiliste 2 Access</title>
<HTA:APPLICATION
SCROLL="yes"  
SINGLEINSTANCE="yes"  
WINDOWSTATE="normal"  
>
</head>
<script language="VBScript">  
'Const myDB = "a2000.mdb"  

Sub CreateNewMDB(FileName, Format)
  Dim Engine
  Set Engine = CreateObject("DAO.DBEngine.36")  
  Engine.CreateDatabase FileName, ";LANGID=0x0409;CP=1252;COUNTRY=0", Format  
End Sub

function dbanlegen(mydb)
CreateNewMDB mydb, 64
end function

function TabelleAnlegen(mydb)

on Error resume next
    Set Conn = CreateObject("ADODB.Connection")  

    Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & myDb  

  '  conn.Execute "DROP TABLE Alben"  

    Conn.Execute ("CREATE TABLE Alben(" & _  
            "Id INTEGER      NOT NULL," & _  
            "Name   VARCHAR(255)  NOT NULL)")  

    Conn.Execute ("CREATE TABLE tbMusiktitel(" & _  
            "MusiktitelId INTEGER  ," & _  
            "Musiktitel   VARCHAR(255)  NOT NULL," & _  
            "Dauer   VARCHAR(255) ," & _  
            "Interpret   VARCHAR(255) ," & _  
            "Album   VARCHAR(255) ," & _  
            "Jahr   VARCHAR(255) ," & _  
            "kbits   VARCHAR(255) ," & _  
            "Genre  VARCHAR(255) )")  

    conn.Close

end function

function dbEintrag1(id,Titel,Dauer,Interpret,Album,Jahr,bit,Genre,Ordnername,mydb)

on Error resume next
Titel = replace(Titel,"'"," ")  
Interpret = replace(Interpret,"'"," ")  
Album = replace(Album,"'"," ")  
Genre = replace(Genre,"'"," ")  

    Set Conn = CreateObject("ADODB.Connection")  

    Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & myDb  
    sql ="INSERT INTO [tbMusiktitel] (MusikTitelid, MusikTitel, Dauer, Interpret, Album, Jahr, kbits, Genre) VALUES (" & id & ",'" & Titel & "','" & Dauer & "','" & Interpret & "','" & Album & "','" & Jahr & "','" & bit & "','" & Genre & "')"  

   conn.Execute (sql)
 '   MsgBox sql  

    conn.Close

end function

function dbEintrag(id,Album,mydb)

on Error resume next
Album = replace(Album,"'"," ")  
    Set Conn = CreateObject("ADODB.Connection")  

    Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & myDb  
    sql ="INSERT INTO [Alben] (id, Name) VALUES (" & id & ",'" & Album & "')"  

    conn.Execute (sql)
   ' MsgBox sql  

    conn.Close

end function





Set objFSO = CreateObject("Scripting.FileSystemObject")  
kopfzeile = 0
indexwert = 0
function meineVids(pfad,dateiname)
mydb = replace(dateiname,"csv","mdb")  
        if kopfzeile = 0 then
        call dbAnlegen(mydb)
        call TabelleAnlegen(mydb)
        set logbuch1 =objFSO.opentextfile(dateiname, 2, true,0)
        logbuch1.write "Index;Ordnername;Musiktitel;Interpret;Album;Jahr;Dauer;bit;Genre"  
        logbuch1.close
        kopfzeile = 1
        end if

            If radiobutton(0).Checked Then
                showall = "ja"  
            End If
            If radiobutton(1).Checked Then
                showall = "nein"  
            End If

        Set objFolder = objFSO.GetFolder(pfad)
        Set colSubfolders = objFolder.Subfolders

        For Each objSubfolder in colSubfolders
       on Error resume next
                 ordnerzeichen = ordner_zeichen.value
                 vollername = objFSO.GetAbsolutePathName(objSubfolder)
                 indexwert = indexwert+1
                 if showAll = "ja" then  

                    ausgabe2 = indexwert & ";" & left(vollername,ordnerzeichen) & punktaln(vollername,ordnerzeichen) & vbcrlf  

                 end if
                 ausgabe1 = ausgabe2 & detail(vollername, showall, indexwert,mydb)

                set logbuch1 =objFSO.opentextfile(dateiname, 8, true,0)  ' 8 zum anfügen  
                logbuch1.write ausgabe1
                logbuch1.close
                dateinameneu = dateiname

           call dbEintrag(indexwert, vollername,mydb)
         call meineVids(vollername,dateinameneu)
        Next

end function

function punktaln(ordnername, anzeigezeichen)
        anzeigezeichen = anzeigezeichen+1   'damit er checkt, dass anzeigezeichen eine zahl ist...  
        if len(ordnername) >=  anzeigezeichen then
        anzeige = "... "  
        end if
        punktaln = anzeige
end function

function Detail(ordnername, lang, indexwert, mydb)
        dateitypen = split(Dateityp.value,";")  

        showAll = lang
            If urlbutton(0).Checked Then
                link = "ein"  
            End If
            If urlbutton(1).Checked Then
                link = "aus"  
            End If
        durchlauf = 1

        Dim arrHeaders(34)
        Set objShell = CreateObject("Shell.Application")  
        Set objFolder = objShell.Namespace(ordnername)
        For i = 0 to 33
            arrHeaders(i) = objFolder.GetDetailsOf(objFolder.Items, i)
        Next
        For Each strFileName in objFolder.Items
                ordnerzeichen = ordner_zeichen.value
                dateizeichen = datei_zeichen.value

            for i = 0 to UBound(dateitypen)
                                if (instr(1, objFolder.GetDetailsOf(strFileName, 2), dateitypen(i), 1) >= 1) OR _
                (instr(1, strFileName, dateitypen(i), 1) >= 1)  then
                nemmas = 1
                end if
            next

             if nemmas = 1 then
                if durchlauf = 1 AND showAll <> "ja" then  

                        feedback = feedback & vbcrlf & indexwert & ";" & left(ordnername,ordnerzeichen) & punktaln(ordnername,ordnerzeichen) & vbcrlf  
                        feedback_DVD = feedback

                        durchlauf = 2
                end if

                     id = indexwert
                    Titel = objFolder.GetDetailsOf(strFileName, 0)
                    Dauer = objFolder.GetDetailsOf(strFileName, 21)
                    Interpret = objFolder.GetDetailsOf(strFileName, 16)
                    Album = objFolder.GetDetailsOf(strFileName, 17)
                    Jahr = objFolder.GetDetailsOf(strFileName, 18)
                    bit = objFolder.GetDetailsOf(strFileName, 22)
                    Genre = objFolder.GetDetailsOf(strFileName, 20)

                    if len(Album) <= 2 then
                            beginnAlbum = instr(Ordnername,"-")+1  
                            Album = LTRIM(mid(Ordnername,beginnAlbum,200))
                    end if

                    if len(Interpret) <= 2 then
                         BeginnInterpret = instrRev(Ordnername,"\")+1  
                         EndeInterpret = instr(Ordnername,"-")-1  
                         Interpret = TRIM(mid(Ordnername,beginnInterpret,EndeInterpret - BeginnInterpret))
                         Interpret = Replace(Interpret,"cd_","")  
                    end if


                feedback2 = id & ";" & " ;" & left(Titel ,dateizeichen) _  
                    & punktaln(Titel ,dateizeichen) & "; " _  
                    & Dauer& "; " _  
                    &  Interpret & ";" &  Album & ";" _  
                    & Jahr & ";" & bit & ";" _  
                    & Genre & ";"  

                    if link = "ein" then  
                    feedback3 = Chr(34) & "=hyperlink(" & Chr(34)  & Chr(34)& ordnername & "\" & Titel _  
                    & Chr(34)  & Chr(34) & ";"  & Chr(34)  & Chr(34) & "klick " &  Chr(34)  & Chr(34)& ")"  & Chr(34)  
                    end if

                    if instr(1, objFolder.GetDetailsOf(strFileName, 0),"m3u", 1) =0 then  
                    feedback = feedback & feedback2 & feedback3 & vbcrlf



                    call dbeintrag1(id,Titel,Dauer,Interpret,Album,Jahr,bit,Genre,Ordnername, mydb)

                    end if

                     if instr(1, objFolder.GetDetailsOf(strFileName, 0),"vob", 1)>=1 then feedback = feedback_DVD & "ist eine DVD" & vbcrlf  

            end if
            nemmas = 0
        Next

        Detail = feedback
end function

Sub Aufgabe1

        woissndes = pfad.value
        dateiname = replace(woissndes,"\","_")  
        dateiname = replace(dateiname,":","_")  
        dateiname = dateiname & "_" & dateityp.value & ".csv"  

        call meineVids(woissndes,dateiname)

         DataArea.InnerHTML = "<a href='" & dateiname & "'>CSV</a> und " & "<a href='" & replace(dateiname,"csv","mdb") & "'>MDB</a>   erfolgreich angelegt"  


End Sub

</script>


<body bgcolor=#FAF8AF>
<font face=verdana>
Pfad: <input type="Text" name="pfad" value="C:\" size="" maxlength=""><br><br>  


Was erscheint als Typ, wenn man den Mauszeiger über eine gesuchte Datei bewegt: <input type="Text" name="Dateityp" value="audio" size="25" maxlength="20"> <br>  
<font size = 1>
(es können auch mehrere Typen, durch <b>;</b> getrennt, angegeben werden!)<br>
Beispiele: Irfan;Windows Media;excel;word;winamp ...</font><br><br>


Die Anzeige der Ordner wird auf <input type="Text" name="ordner_zeichen" value="200" size="" maxlength=""> eingeschränkt!<br><br>  

Die Anzeige der Dateinamen wird auf <input type="Text" name="datei_zeichen" value="200" size="" maxlength=""> eingeschränkt!<br><br>  

Sollen auch Ordner angezeigt werden, die den gewünschten Dateityp NICHT enthalten?
Ja <input type="radio" name="radiobutton" value="0"> Nein <input type="radio" name="radiobutton" value="1" checked><br><br>  
Sollen in der .csv-Datei Links zu den Dateien erscheinen?
Ja <input type="radio" name="urlbutton" value="0"> Nein <input type="radio" name="urlbutton" value="1" checked><br><br>  
<br>


<input type="button" value="Datei anlegen" name="run_button" onClick="Aufgabe1"><br>  
<font size = 1>(Die Verarbeitung kann mehrere Minuten dauern... Bitte um etwas Geduld)</font>

<br><br><br>
<b>
<div id="dataarea"></div>  
</b>
</font>
</body>

Anmerkungen oder Fragen sind wie immer herzlich willkommen...

lg
Edi

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 140293

Url: https://administrator.de/contentid/140293

Ausgedruckt am: 05.11.2024 um 02:11 Uhr

1 Kommentar

Sehr geile Idee und sieht gut aus.
Habs zwar noch nicht versucht, werds bei Gelegenheit tun.

OT: Am coolsten find ich den Teil des Codes:

woissndes = pfad.value

:D
Eindeutig eindeutig..