Kann eine Batchdatei Metadaten auf P2 Karten ändern?

 Option Explicit

 Const sXmlFolder = "\Metadata"                  'Ordner-Pfad der Xml-Dateien auf P2-Karte  

 Const iCountClipNr = 5                          'Anzahl Stellen für Clip-Nr. (z.B. 5 für "00001")  

 Const DRIVE_REMOVABLE = 2                       'WMI-Service-DriveTypen  
 Const DRIVE_FIXED = 3
 Const DRIVE_REMOTE = 4
 Const DRIVE_CDROM = 5
 Const DRIVE_RAMDISK = 6

 Const FILE_READONLY = 1                         'Datei-Attribut ReadOnly  

 Const sErrMsg1 = "Laufwerk mit Metadaten nicht gefunden!"  
 Const sErrMsg2 = "Datei (%1) enthält kein Erstellungs-Datum"  
 Const sErrMsg3 = "Test-Knoten in Xml-Vorlage nicht vorhanden!"  

 Dim oFso, oDrive, oFolder, oFile, oDateList, oDoc, oTemplate, oDocNode, oTemplateNode
 Dim aNode, aNodes, sTemplate, sSqlDrive, sClipNr, iCountNode, i

'Main Beg  
    'Benötigte Klassen erzeugen  
    Set oFso = CreateObject("Scripting.FileSystemObject")  
    Set oDateList = CreateObject("Scripting.Dictionary")  
    Set oDoc = CreateObject("Microsoft.XMLDOM")  
    Set oTemplate = CreateObject("Microsoft.XMLDOM")  
    
    oDoc.async = False:  oTemplate.async = False
    
    sSqlDrive = "Select * From Win32_Volume Where Capacity<>NULL And DriveType=" & DRIVE_REMOVABLE  

    'P2-Karten-Laufwerk ermitteln  
    For Each oDrive In GetObject("winmgmts:\\.\root\CIMV2").ExecQuery(sSqlDrive)  
        If oFso.FolderExists(oDrive.DriveLetter & sXmlFolder) Then
            Set oFolder = oFso.GetFolder(oDrive.DriveLetter & sXmlFolder)
        End If
    Next
    
    'Test P2-Karten-Laufwerk gefunden ?  
    If IsEmpty(oFolder) Then Call Abbort(sErrMsg1)
    
    Call InitTemplate
    
    'CreationDates der XML-Dateien erfassen/auflisten  
    For Each oFile In oFolder.Files
        If LCase(oFso.GetExtensionName(oFile.Name)) = "mxf" Then    'xml ?  
            oDoc.Load oFile.Path
                    
            Set oDocNode = oDoc.DocumentElement.SelectSingleNode("//ClipMetadata/Access/CreationDate")  
                                
            If oDocNode Is Nothing Then
                Call Abbort(Replace(sErrMsg2, "%1", oFile.Name))  
            Else
                oDateList.Add oDocNode.Text, ""  
            End If
        End If
    Next
    
    'XML-Dateien auswerten, in Vorlage übernehmen und speichern, alte XML-Dateien mit Endung '.bak' sichern  
    For Each oFile In oFolder.Files
        With oFile
            If LCase(oFso.GetExtensionName(.Name)) = "mxf" Then     'xml ?  
                oDoc.Load .Path:  oTemplate.loadXML sTemplate
                
                For Each aNode In aNodes
                    Set oTemplateNode = oTemplate.DocumentElement.SelectSingleNode("//ClipMetadata/" & aNode(0))  
                       
                    If oTemplateNode Is Nothing Then
                        Call Abbort(sErrMsg3)
                    Else
                        Set oDocNode = oDoc.DocumentElement.SelectSingleNode("//ClipMetadata/" & aNode(0))  
                            
                        If Not oDocNode Is Nothing Then
                            If oDocNode.nodeName = "CreationDate" Then  
                                sClipNr = GetClipNr(oDocNode.Text)
                            End If
                            
                            iCountNode = UBound(aNode)
                            
                            If iCountNode = 0 And oDocNode.Text <> "" Then  
                                oTemplateNode.Text = oDocNode.Text
                            ElseIf iCountNode > 0 Then
                                For i = 1 To iCountNode
                                    If InStr(1, oDocNode.Text, aNode(i), vbTextCompare) < 1 Then
                                        Exit For
                                    End If
                                Next
                                If i > iCountNode Then oTemplateNode.Text = oDocNode.Text
                            End If
                        End If
                    End If
                Next
               
                With oTemplate.DocumentElement.SelectSingleNode("//ClipMetadata/UserClipName")  
                    .Text = .Text & sClipNr
                End With
                              
               .Attributes = .Attributes And Not FILE_READONLY
                oTemplate.Save .Path
                oDoc.Save .Path & ".bak"  
               .Attributes = .Attributes Or FILE_READONLY
            End If
        End With
    Next

    MsgBox "Fertig!", vbInformation, "Hinweis . . .":  WScript.Quit 0  
'Main End  

 Sub Abbort(ByVal sMsg)
    MsgBox sMsg, vbExclamation, "Fehler . . .":  WScript.Quit 1  
 End Sub
 
 Sub InitTemplate()
    'Xml-Standard-Vorlage erstellen (Leerzeichen ersparen die Zeilenumbrüche)  
    sTemplate = sTemplate & " <ClipMetadata>"  
    sTemplate = sTemplate & "  <UserClipName>BT:();AT:();</UserClipName>"  
    sTemplate = sTemplate & "  <DataSource></DataSource>"  
    sTemplate = sTemplate & "  <Access>"  
    sTemplate = sTemplate & "   <Creator>AUT:();</Creator>"  
    sTemplate = sTemplate & "   <CreationDate></CreationDate>"  
    sTemplate = sTemplate & "   <LastUpdatePerson>RED:();</LastUpdatePerson>"  
    sTemplate = sTemplate & "   <LastUpdateDate></LastUpdateDate>"  
    sTemplate = sTemplate & "  </Access>"  
    sTemplate = sTemplate & "  <Device>"  
    sTemplate = sTemplate & "   <Manufacturer></Manufacturer>"  
    sTemplate = sTemplate & "   <SerialNo.></SerialNo.>"  
    sTemplate = sTemplate & "   <ModelName></ModelName>"  
    sTemplate = sTemplate & "  </Device>"  
    sTemplate = sTemplate & "  <Shoot>"  
    sTemplate = sTemplate & "   <StartDate></StartDate>"  
    sTemplate = sTemplate & "   <EndDate></EndDate>"  
    sTemplate = sTemplate & "   <Location>"  
    sTemplate = sTemplate & "    <PlaceName>ST:();</PlaceName>"  
    sTemplate = sTemplate & "   </Location>"  
    sTemplate = sTemplate & "  </Shoot>"  
    sTemplate = sTemplate & "  <Scenario>"  
    sTemplate = sTemplate & "   <ProgramName>ANR:();PNR:();EB:();</ProgramName>"  
    sTemplate = sTemplate & "  </Scenario>"  
    sTemplate = sTemplate & "  <News>"  
    sTemplate = sTemplate & "   <Reporter>ORT:();</Reporter>"  
    sTemplate = sTemplate & "   <Purpose>KAM:();TON:();</Purpose>"  
    sTemplate = sTemplate & "  </News>"  
    sTemplate = sTemplate & "  <MemoList>"  
    sTemplate = sTemplate & "   <Memo MemoID='0'>"  
    sTemplate = sTemplate & "    <Offset>0</Offset>"  
    sTemplate = sTemplate & "    <Text>B:();</Text>"  
    sTemplate = sTemplate & "   </Memo>"  
    sTemplate = sTemplate & "  </MemoList>"  
    sTemplate = sTemplate & "  <Thumbnail>"  
    sTemplate = sTemplate & "   <FrameOffset>0</FrameOffset>"  
    sTemplate = sTemplate & "   <ThumbnailFormat>BMP</ThumbnailFormat>"  
    sTemplate = sTemplate & "   <Width>80</Width>"  
    sTemplate = sTemplate & "   <Height>60</Height>"  
    sTemplate = sTemplate & "  </Thumbnail>"  
    sTemplate = sTemplate & " </ClipMetadata>"  

    'Test-Array - Xml-Knoten mit/ohne Vorgaben (ohne = Tags mit normalen Text-Inhalt)  
    aNodes = Array( _
             Array("UserClipName", "BT:", "AT:"), _  
             Array("DataSource"), _  
             Array("Access/Creator", "AUT:"), _  
             Array("Access/CreationDate"), _  
             Array("Access/LastUpdatePerson", "RED:"), _  
             Array("Access/LastUpdateDate"), _  
             Array("Device/Manufacturer"), _  
             Array("Device/SerialNo."), _  
             Array("Device/ModelName"), _  
             Array("Shoot/StartDate"), _  
             Array("Shoot/EndDate"), _  
             Array("Shoot/Location/PlaceName", "ST:"), _  
             Array("Scenario/ProgramName", "ANR:", "PNR:", "EB:"), _  
             Array("News/Reporter", "ORT:"), _  
             Array("News/Purpose", "KAM:", "TON:"), _  
             Array("MemoList/Memo/Offset"), _  
             Array("MemoList/Memo/Text", "B:"), _  
             Array("Thumbnail/FrameOffset"), _  
             Array("Thumbnail/ThumbnailFormat"), _  
             Array("Thumbnail/Width"), _  
             Array("Thumbnail/Height"))  
 End Sub

'Diese Funktion gibt die jeweilige Clip-Nr. anhand des Creation-Date zurück  
 Function GetClipNr(ByRef sCreationDate)
    Dim sDate, iCount

    iCount = 1
    
    For Each sDate In oDateList.Keys
        If StrComp(sCreationDate, sDate, vbTextCompare) > 0 Then iCount = iCount + 1
    Next

    GetClipNr = Right(String(iCountClipNr, "0") & iCount, iCountClipNr)  
 End Function