'======================================================================='
' Script de découpage XML par compte                         11/02/2015 '
' Auteur : Yann RAOUL - Turbo S.A                                       '
'                                                                       ' 
' Découpe le relevé XML de type CAMT053 contenant plusieurs comptes     '
' en plusieurs relevés mono compte                                      ' 
'                                                                       ' 
'======================================================================='

'---------------------------------------------------------------------------------------------------------------
'
' Paramètres 
'
' Log   						Indique si l'on doit inscrire les traces du script dans un fichier Log
' Suppression_Fichier_Origine   Indique si l'on doit supprimer le fichier d'origine ou non
' Chemin_Complet_Fichier_Log   	Chemin complet du fichier de log
' Dossiers_Destination  		Dossiers de destination des fichiers découpés. 
'                               Si présence de plusieurs dossiers, les indiquer séparés par des ";"
'                               Exemple : "C:\DOSSIER1;C:\DOSSIER2" etc
'                               Si la valeur est une chaine vide ( = "") , 
'								le chemin sera le chemin du fichier à découper
'
'---------------------------------------------------------------------------------------------------------------

Dim Log, Suppression_Fichier_Origine, Chemin_Complet_Fichier_Log, Dossiers_Destination
Log = true
Suppression_Fichier_Origine = False
Chemin_Complet_Fichier_Log = "log_script_decoupage_xml_par_compte.txt"
Dossiers_Destination = "C:\Suite Entreprise v2\AFB;C:\Suite Entreprise v2\AFB2"

'---------------------------------------------------------------------------------------------------------------

'---------------------------------------------------------------------------------------------------------------
' Test du fichier de log
'---------------------------------------------------------------------------------------------------------------

Set fso = CreateObject("Scripting.FileSystemObject")
If Log = True Then
    Dim Dossier_Log
    Dossier_Log = fso.GetParentFolderName(Chemin_Complet_Fichier_Log)
    If Dossier_Log <> "" And fso.FolderExists(Dossier_Log) = False Then
        Wscript.Echo "Erreur : Le chemin de fichier de log '" & Dossier_Log & "' est inconnu ou inaccessible"
        WScript.Quit
    End If
End If
'---------------------------------------------------------------------------------------------------------------

wLog("-------------------------------------------------------")
wLog("1/ Récupération du fichier source depuis les arguments du script")

Set oArgs=WScript.Arguments

If oArgs.count = 0 Then 
	Fin("Erreur : Veuillez indiquer un nom de fichier en paramètre de ce script.")
Else
    Chemin_Complet_Fichier_Source = oArgs(0)
End If

'---------------------------------------------------------------------------------------------------------------
wLog("2/ Récupération et validation des dossiers de destination")

Dim array_Dossiers_Destination()

If Dossiers_Destination <> "" Then
	Dim Folders 
	Folders = Split(Dossiers_Destination,";")
	Dim i
	i = -1
	For Each Folder in Folders
		i = i + 1
		Redim Preserve array_Dossiers_Destination(i)
		array_Dossiers_Destination(i) = Folder
	Next
	
    For Each Dossier_Destination in array_Dossiers_Destination
        If fso.FolderExists(Dossier_Destination) = False Then
			Fin("Erreur : le dossier de destination '" & Dossier_Destination & "' est inconnu ou inaccessible")
		End If 
    Next
Else
    Redim Preserve array_Dossiers_Destination(0)
    array_Dossiers_Destination(0) =  Mid(fso.GetParentFolderName(Chemin_Complet_Fichier_Source), 1, Len(fso.GetParentFolderName(Chemin_Complet_Fichier_Source)))
End If

If fso.FileExists(Chemin_Complet_Fichier_Source) = False Then
    Fin("Erreur : le fichier à découper '" & Chemin_Complet_Fichier_Source & "' est inconnu ou inaccessible")
End If

'---------------------------------------------------------------------------------------------------------------

wLog("3/ Instanciation du parseur XML et chargement du fichier source")

Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Async = "false"
xmlDoc.Load(Chemin_Complet_Fichier_Source)

'---------------------------------------------------------------------------------------------------------------

wLog("4/ Récupération des IBAN de chaque relevé")

Set Nodes = xmlDoc.selectNodes ("//Document/BkToCstmrStmt/Stmt/Acct/Id/IBAN")
Nombre_Statements = Nodes.length

If Nombre_Statements < 1 Then
	Fin("Découpage non nécessaire")
End If

Set lstIBAN = New List

For Each Node in Nodes
	If lstIBAN.Contains(Node.Text) = False Then
		lstIBAN.Add(Node.Text)
	End If
Next

'---------------------------------------------------------------------------------------------------------------

wLog("5/ Balayage par IBAN trouvé")

Dim IBAN
For Each IBAN In lstIBAN.GetArray

	IBAN = Replace(IBAN," ","")
	Dim Chemin_Complet_Fichier_Destination
	Dim Nom_Fichier_Source_Sans_Extension,Extension_Fichier_Source
	Nom_Fichier_Source_Sans_Extension = fso.GetBaseName(Chemin_Complet_Fichier_Source)
	Extension_Fichier_Source = fso.GetExtensionName(Chemin_Complet_Fichier_Source)
	
	wLog("6/ Copie vers chaque dossier de destination")
	
	For Each Dossier_Destination in array_Dossiers_Destination
	
		Chemin_Complet_Fichier_Destination = Dossier_Destination & "\\" & Nom_Fichier_Source_Sans_Extension & "-" & IBAN & "." & Extension_Fichier_Source
		CopyFile Chemin_Complet_Fichier_Source, Chemin_Complet_Fichier_Destination
	
		wLog("7/ Ouverture du fichier copié")
		
		xmlDoc.Load(Chemin_Complet_Fichier_Destination)
		Set Nodes = xmlDoc.selectNodes ("//Document/BkToCstmrStmt/Stmt/Acct/Id/IBAN")
		
		wLog("8/ Suppression des relevés non liés à l'IBAN en cours de balayage")
				
		For Each node In nodes
		
			IBAN_Trouve = node.Text
			
			set p_node = node.parentNode.parentNode.parentNode
			
			If IBAN <> IBAN_Trouve Then
				p_node.parentNode.removeChild(p_node)	
			End If
			
		Next

		wLog("9/ Enregistrement des modifications du fichier")
		
		xmlDoc.Save(Chemin_Complet_Fichier_Destination)
	Next
	
Next

'---------------------------------------------------------------------------------------------------------------

If Suppression_Fichier_Origine = True Then
	wLog("10/ Suppression du fichier d'origine")
	SupprimeFichier(Chemin_Complet_Fichier_Source)
Else
	wLog("10/ Pas de suppression du fichier d'origine")
End If

Fin("Script terminé avec succès")

'---------------------------------------------------------------------------------------------------------------
'
' FONCTIONS
'
'---------------------------------------------------------------------------------------------------------------


'------------------------------------------------------------
' Copie dans un fichier
'------------------------------------------------------------

Sub CopyFile(SourceFile, DestinationFile)

    'Check to see if the file already exists in the destination folder
    Dim wasReadOnly
    wasReadOnly = False
    If fso.FileExists(DestinationFile) Then
        'Check to see if the file is read-only
        If fso.GetFile(DestinationFile).Attributes And 1 Then 
            'The file exists and is read-only.
			wLog("Suppression des attributs de lecture seule")
            'Remove the read-only attribute
            fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes - 1
            wasReadOnly = True
        End If

        wLog( "Fichier '" & DestinationFile & "' déjà présent, suppression avant copie")
        fso.DeleteFile DestinationFile, True
    End If

    'Copy the file
	wLog("Copie du fichier '" & SourceFile & "' vers '" & DestinationFile & "'")
    fso.CopyFile SourceFile, DestinationFile, True

    If wasReadOnly Then
        'Reapply the read-only attribute
        fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes + 1
    End If

End Sub

'------------------------------------------------------------
' Ecriture dans un fichier de log
'------------------------------------------------------------

Sub wLog(contenu)

	If Log = False Then Exit Sub

	DebutLigne = Date() & " " & Time() & " => "
	contenu = DebutLigne + contenu
	dim f
	Set f = fso.OpenTextFile(Chemin_Complet_Fichier_Log, 8, True) 
	f.Write( contenu & VbCrLf )
	f.Close

End Sub

Sub Fin(message)

    wLog(message)
    Wscript.Echo message
    wLog("Fin du script")
	wLog("-------------------------------------------------------")
    If InStr(1,message,"Erreur") Then
        WScript.Quit 1
    Else
        WScript.Quit
    End If
	
	
End Sub


'------------------------------------------------------------
' Classe List
'------------------------------------------------------------

Class List
  Private mArray

  Private Sub Class_Initialize()
    mArray = Empty
  End Sub

  ' Appends the specified element to the end of this list.
  Public Sub Add(element)
    If IsEmpty(mArray) Then
      ReDim mArray(0)
      mArray(0) = element
    Else
      If mArray(UBound(mArray)) <> Empty Then
        ReDim Preserve mArray(UBound(mArray)+1)        
      End If
      mArray(UBound(mArray)) = element
    End If
  End Sub
  
  
  '  Removes the element at the specified position in this list.
  Public Sub Remove(index)
    ReDim newArray(0)
    For Each atom In mArray
      If atom <> mArray(index) Then
        If newArray(UBound(newArray)) <> Empty Then
          ReDim Preserve newArray(UBound(newArray)+1)
        End If
        newArray(UBound(newArray)) = atom
      End If
    Next
    mArray = newArray
  End Sub

  ' Returns the number of elements in this list.
  Public Function Size
    Size = UBound(mArray)+1
  End Function

  ' Returns the element at the specified position in this list.
  Public Function GetItem(index)
    GetItem = mArray(index)
  End Function
  
  ' Checks if the item is present into the list
  Public Function Contains(item)
	If IsEmpty(mArray) Then
		Contains = False
	ElseIf UBound(mArray) = 0 Then
		Contains = False
	Else 
		For Each atom In mArray
			If atom = item Then
				Contains = True
			End If
		Next
		
		Contains = False
	End If
	
  End Function

  ' Removes all of the elements from this list.
  Public Sub Clear
    mArray = Empty
  End Sub

  ' Returns true if this list contains elements.
  Public Function HasElements
    HasElements = Not IsEmpty(mArray)
  End Function

  Public Function GetIterator
    Set iterator = New ArrayIterator
    iterator.SetArray = mArray
    GetIterator = iterator
  End Function

  Public Function GetArray
    GetArray = mArray
  End Function

End Class




' ----------------------------------------------------
'
' Sub de suppression du fichier
'
' Entrée :    - le chemin de fichier strCheminFichier 
'
' ----------------------------------------------------
Sub SupprimeFichier(strCheminFichier)

    'Suppression du fichier
    Set Ftxt = fso.GetFile(strCheminFichier)   
    Ftxt.delete

End Sub