Erreur 424 [VBS]

  • Auteur de la discussion negoksa
  • Date de début
N

negoksa

Nouveau membre
Bonjour a tous,
je suis ici pour vous demander un petit coup de patte.

J'ai récupéré sur la toile un script de surveillance de dossier,d'après la description il aurait juste fallu mettre
"X" "Y" ou X est le dossier a surveiller et Y le dossier ou sera créé le fichier de compte-rendu.

Sauf que le script me retourne des erreurs 424 que je vois pas comment résoudre.
Après analyse via vbs factory , il me dit que c'est de cette ligne que découlent toutes les erreurs de mon script.

[cpp]Set objArgs = Wscript.Arguments[/cpp]

Je ne posterai pas le script en entier pour des raisons de lisibilités (1069 lignes)
mais je peux les mettre si quelqu'un juge cela utile

Cordialement Nego.
 
zeb

zeb

Modérateur
Salut,

Cette ligne me semble particulièrement anodine.
Le libellé associé à l'erreur 424, c'est bien "Objet requis" ?
Si oui, je ne vois pas pourquoi Wscript pose problème puisqu'il n'a pas besoin d'être instancié (
Vous devez être connecté pour voir les liens.
).

Comment lances-tu ton programme ?
 
N

negoksa

Nouveau membre
Bonjour Zeb,

effectivement cette ligne est tout a fait anodine,

Je lance mon script via un raccourci, le créateur du script indiquait qu'il fallait seulement aller dans propriétés et après le chemin du fichier rajouter le répertoire a surveiller et le répertoire pour le compte rendu

C'est peut être de la que viens le problème même si j'en doute.

Quand au libellé c'est bien "Objet requis".

Si jamais tu as une idée je suis preneur, si tu le souhaites je peux poster une partie plus étendue du script au lieu de cette petite ligne

 
zeb

zeb

Modérateur
Et qu'en dit le créateur du script ?
Tu peux toujours poster le code complet. ;)
 
N

negoksa

Nouveau membre
Vas pour le code complet ;)


[cpp]'*****************************************************************************************
'* Programme permettant de lister l'ensemble des données du disque dur et de faire *
'* un historique des modifications *
'*****************************************************************************************
'========================================================================================*
'= DATE ! *
'=------------!--------------------------------------------------------------------------*
'= 20/08/2004 ! CREATION DU PROGRAMME *
'========================================================================================*
'-----------------------------------------------------------------------------------------
'- Déclaration des variables
'-----------------------------------------------------------------------------------------
Dim ObjetFso, Resultat
Dim ObjTextFicRef
Dim ErrNumber, ErrSource, ErrDescription, PremiereExecution
Dim NbreFichierSansAcces, Titre, NbreFichiertrouver, HeureDebut, FicHisto
Dim NbreFicCreer, NbreFicModif, NbreFicSup, dateTravail
Dim PresenceMAJ
Dim FicAnalyser, RepTravail, FicCptRendu, FicComp, FicCompTemp, FicRef, FicRefTemp
'Const FicRef = "D:\REF-LDQ.txt"
'Const FicRefTemp = "D:\REF-LDQ-Temp.txt"
'Const RepTravail = "D:\"
'Const FicCptRendu = "D:\CptRendu-LDQ.txt"
'Const FicComp = "D:\COMP-LDQ.TXT"

'Const RepTravail = "D:\"
'Const FicCptRendu = "D:\CptRendu-LDQ.txt"
'Const FicComp = "D:\COMP-LDQ.TXT"
'Const FicCompTemp = "D:\COMP-LDQ-temp.TXT"
'Const FicXml = "RESULTAT-LDQ.XML"
'Const FicRef = "D:\REF-LDQ.txt"
'Const FicRefTemp = "D:\REF-LDQ-Temp.txt"
'Const FicAnalyser = "D:\kuthf"
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const TristateUsedefault = -2
Const TristateTrue = -1
Const TristateFalse = 0
Const PosFic = 66 'Position du premier caractère contenant le nom du fichier
' dans le fichier de reférence
Const Limitetime = 0.001


'-----------------------------------------------------------------------------------------
'- initialisation des variables
'-----------------------------------------------------------------------------------------
Set ObjetFso = CreateObject("Scripting.FileSystemObject")
HeureDebut = FormatDateTime(Time(),vbLongTime)
dateTravail = Date()
PresenceMAJ = "False"

'-----------------------------------------------------------------------------------------
'- corps du programme
'-----------------------------------------------------------------------------------------
ProcPrincipale
Titre = "Compte rendu d'exécution" & Chr(13) & Chr(10)
Message = Chr(9) & "- Nombre de fichier non traité par manque d'autorisation : " _
& NbreFichierSansAcces & Chr(13) & Chr(10) & Chr(9) _
& "- Nombre de fichier " & " trouver et ecrit : " & NbreFichiertrouver

MsgBox(Titre & Message)

'=========================================================================================
'= Procedure principale =
'=========================================================================================

Sub ProcPrincipale
Dim Source, Destination
NomProcedureFonction = "Sub ProcPrincipale"
' --> Récupération des arguments;

Set objArgs = Wscript.Arguments
If objArgs.Count <> 2 Then
NomProcedureFonction = "Test des arguments en entree."
AfficheMessageErreur NomProcedureFonction,8
Resultat = "False"
Exit Sub
End If
FicAnalyser = objArgs(0)
RepTravail = objArgs(1)
FicCptRendu = RepTravail & "CptRendu-LDQ.txt"
FicComp = RepTravail & "COMP-LDQ.TXT"
FicCompTemp = RepTravail & "COMP-LDQ-temp.TXT"
FicRef = RepTravail & "REF-LDQ.txt"
FicRefTemp = RepTravail & "REF-LDQ-Temp.txt"

'MsgBox("FicCptRendu : " & FicCptRendu)

'Cinématique de la procédure:
'===========================
' --> Test des arguments en entrée
' --> Suppression du fichier de comparaison
' --> Suppression du fichier de comparaison temporaire
' --> Suppression du fichier de référence temporaire
' --> Création du fichier Historique à partir du fichier de référence
' --> Suppression du fichier de référence

'-----------------------------------------------------------------------------------------
'- Suppression du fichier de comparaison -
'-----------------------------------------------------------------------------------------
' MsgBox("SupFic(FicComp)")
Resultat = SupFic(FicComp)
If Resultat = "False" Then
Exit Sub
End If

'-----------------------------------------------------------------------------------------
'- Suppression du fichier de comparaison temporaire -
'-----------------------------------------------------------------------------------------
' MsgBox("SupFic(FicCompTemp)")
Resultat = SupFic(FicCompTemp)
If Resultat = "False" Then
Exit Sub
End If

'-----------------------------------------------------------------------------------------
'- Suppression du fichier temporaire -
'-----------------------------------------------------------------------------------------
' MsgBox("SupFic(FicRefTemp)")
Resultat = SupFic(FicRefTemp)
If Resultat = "False" Then
Exit Sub
End If

'-----------------------------------------------------------------------------------------
'- test l'existance du fichier de reference -
'-----------------------------------------------------------------------------------------
' MsgBox("Test Existance du fichier de référence")
If ObjetFso.FileExists(FicRef) Then
' ---> Création du fichier historique à partir du fichier de référence
' MsgBox("CopieFicRef(FicRef,ObjetFso,RepTravail)")
Resultat = CopieFicRef(FicRef,ObjetFso,RepTravail)
If Resultat = "False" Then
Exit Sub
End If
' ---> Suppression du fichier de référence
' MsgBox("ObjetFso.DeleteFile FicRef,True")
ObjetFso.DeleteFile FicRef,True
If err.Number > 0 Then
AfficheMessageErreur NomProcedureFonction,0
Exit Sub
End If
PremiereExecution = "False"
Else
PremiereExecution = "True"
End If

'-----------------------------------------------------------------------------------------
'- Création du fichier de référence -
'-----------------------------------------------------------------------------------------
' MsgBox("Création du fichier de référence")
Set FileObjRef = ObjetFso_OpenTextFile(FicRef,ForAppending,True,TristateUseDefault)
Resultat = ListeRep(FicAnalyser,FileObjRef)
If Resultat = "True" Then
' MsgBox("Vrai")
End If
If Resultat = "False" Then
' MsgBox("Faux")
End If

FileObjRef.Close
Set FileObjRef = Nothing

'-----------------------------------------------------------------------------------------
'- Suppression du fichier temporaire -
'-----------------------------------------------------------------------------------------
' MsgBox("Suppression du fichier temporaire")
Resultat = SupFic(FicRefTemp)
If Resultat = "False" Then
Exit Sub
End If

'-----------------------------------------------------------------------------------------
'- Tri du fichier de référence par une commande DOS -
'-----------------------------------------------------------------------------------------
' MsgBox("TrieFichier")
Resultat = TrieFichier(FicRef,66,FicRefTemp)
If Resultat = "False" Then
Exit Sub
End If

'-----------------------------------------------------------------------------------------
'- Test l'existence du fichier de référence temporaire -
'-----------------------------------------------------------------------------------------
' MsgBox("TestExistanceFic(FicRefTemp)")
Resultat = TestExistanceFic(FicRefTemp)
If Resultat = "False" Then
Exit Sub
End If

'-----------------------------------------------------------------------------------------
'- Suppression du fichier Référence -
'-----------------------------------------------------------------------------------------
' MsgBox("SupFic(FicRef)")
Resultat = SupFic(FicRef)
If Resultat = "False" Then
Exit Sub
End If

'-----------------------------------------------------------------------------------------
'- Copie du fichier référence temporaire a la place du fichier reference -
'-----------------------------------------------------------------------------------------
' MsgBox("CopyFic(FicRefTemp, FicRef)")
Resultat = CopyFic(FicRefTemp, FicRef)
If Resultat = "False" Then
Exit Sub
End If

'-----------------------------------------------------------------------------------------
'- Suppression du fichier Référence temporaire -
'-----------------------------------------------------------------------------------------
' MsgBox("SupFic(FicRefTemp)")
Resultat = SupFic(FicRefTemp)
If Resultat = "False" Then
Exit Sub
End If

'-----------------------------------------------------------------------------------------
'- Comparaison de 2 documents -
'-----------------------------------------------------------------------------------------

If PremiereExecution = "False" Then
CompareDocument
End If
'-----------------------------------------------------------------------------------------
'- Tri du fichier de comparaison par une commande DOS -
'-----------------------------------------------------------------------------------------
If PresenceMAJ = "True" Then
Resultat = TrieFichier(FicComp,1,FicCompTemp)
If Resultat = "False" Then
Exit Sub
End If
End If
'-----------------------------------------------------------------------------------------
'- Teste l'existence du fichier de comparaison temporaire -
'-----------------------------------------------------------------------------------------
If PresenceMAJ = "True" Then
' MsgBox("TestExistanceFic(FicCompTemp)")
Resultat = TestExistanceFic(FicCompTemp)
If Resultat = "False" Then
Exit Sub
End If
End If

'-----------------------------------------------------------------------------------------
'- Création du fichier XML -
'-----------------------------------------------------------------------------------------
If PremiereExecution = "False" Then
' MsgBox("CreationXml")
CreationXml
End If

'-----------------------------------------------------------------------------------------
'- Suppression du fichier de référence temporaire -
'-----------------------------------------------------------------------------------------
' MsgBox("SupFic(FicRefTemp)")
Resultat = SupFic(FicRefTemp)
If Resultat = "False" Then
Exit Sub
End If

'-----------------------------------------------------------------------------------------
'- Création du compte rendu d'exécution -
'-----------------------------------------------------------------------------------------
CreationCompteRendu
End Sub
'=========================================================================================
'= Fonction =
'=========================================================================================

'-----------------------------------------------------------------------------------------
' Fonction permettant de Tester l'existance d'un fichier -
'-----------------------------------------------------------------------------------------
Function TestExistanceFic(Fichier)
Dim Debut, Fin

Dim Compteur
On Error Resume Next
Debut = Time
Compteur = 0
NomProcedureFonction = "Function TestExistanceFic(Fichier) avec Fichier = " & Fichier
Do
Compteur = Compteur + 1
Fin = Time
If Err.Number > 0 Then
ErrNumber = Err.Number
ErrSource = Err.Source
ErrDescription = Err.Description
AfficheMessageErreur NomProcedureFonction,0
TestExistanceFic = "False"
End If
Temp = Fin - Debut
If Temp >= Limitetime Then
AfficheMessageErreur NomProcedureFonction,6
TestExistanceFic = "False"
Exit Do
End If
Loop Until ObjetFso.FileExists(Fichier) = True

End Function

'-----------------------------------------------------------------------------------------
' Fonction permettant de Copier un fichier -
'-----------------------------------------------------------------------------------------
Function CopyFic(Source, Destination)
On Error Resume Next
NomProcedureFonction = "Function CopyFic(Source, Destination) avec Source = " _
& Source & " Destination = " & Destination
ObjetFso.CopyFile Source, Destination, True
If Err.Number > 0 Then
ErrNumber = Err.Number
ErrSource = Err.Source
ErrDescription = Err.Description
AfficheMessageErreur NomProcedureFonction,0
CopyFic = "False"
End If
End Function

'-----------------------------------------------------------------------------------------
' Fonction permettant de Supprimer un fichier -
'-----------------------------------------------------------------------------------------
Function SupFic(Fichier)
On Error Resume Next
NomProcedureFonction = "Function SupFic(Fchier) avec Fichier = " & Fichier
ObjetFso.DeleteFile Fichier, True
If Err.Number > 0 Then
If Err.number = 53 Then
' AfficheMessageErreur NomProcedureFonction,2
SupFic = "True"
Else
ErrNumber = Err.Number
ErrSource = Err.Source
ErrDescription = Err.Description
AfficheMessageErreur NomProcedureFonction,0
SupFic = "False"
End If
End If
End Function

'-----------------------------------------------------------------------------------------
' Fonction permettant de faire une lecture de fichier -
'-----------------------------------------------------------------------------------------
Function LectureFic(ObjFile)
On Error Resume Next
NomProcedureFonction = "Function LectureFic(ObjFile)"
LectureFic = ObjFile.Readline
If Err.Number > 0 Then
ErrNumber = Err.Number
ErrSource = Err.Source
ErrDescription = Err.Description
AfficheMessageErreur NomProcedureFonction,0
CopieFicRef = "False"
Exit Function
End If
End Function

'-----------------------------------------------------------------------------------------
' Fonction permettant de faire le trie dans le fichier de référence -
'-----------------------------------------------------------------------------------------
Function TrieFichier(Source,Position,Destination)
On Error Resume Next
Dim Commande
NomProcedureFonction = "Function TrieFichier(Source,Position,Destination), avec " _
& "Source: " & Source & ", Position : " & Position & ", Destination : " _
& Destination
Set Objshell = CreateObject("WScript.Shell")
Commande = "cmd /k SORT /+" & Position & " " & Source & " /O " & Destination

Resultat = ObjShell.run(Commande,1,true)
' MsgBox("Shell.run Commande,0 = " & Resultat)
Set Objshell = Nothing
If Err.Number > 0 Then
ErrNumber = Err.Number
ErrSource = Err.Source
ErrDescription = Err.Description
AfficheMessageErreur NomProcedureFonction,0
TrieFichier = "False"
Exit Function
End If
End Function

'-----------------------------------------------------------------------------------------
'- Fonction permettant de récupérer l'ensemble des fichiers et répertoire
'-----------------------------------------------------------------------------------------
Function ListeRep(folderspec,ObjText)
On Error Resume Next
' MsgBox("ListeRep(folderspec,ObjText)")
NomProcedureFonction = "Function ListeRep(folderspec,ObjText) avec folderspec = "
Set ObjetFolder = ObjetFso.GetFolder(folderspec)
Set ObjSubFolder = ObjetFolder.SubFolders
Resultat = ListeFic(ObjetFolder,ObjText,folderspec)
If Resultat = "False" Then
ListeRep = "False"
Exit Function
End If

If Resultat = "False" Then
ListeRep = "False"
Exit Function
End If
For Each f1 in ObjSubFolder
RepCourant = folderspec & f1.name
RepActuel = folderspec & f1.name & "\"
Set ObjetFolder1 = ObjetFso.GetFolder(RepActuel)
Set ObjSubFolder1 = ObjetFolder1.SubFolders
Resultat = ListeRep(RepActuel,ObjText)
If Resultat = "False" Then
ListeRep = "False"
Exit Function
End If
Next
' MsgBox("Fin ListeRep(folderspec,ObjText)")
End Function

'-----------------------------------------------------------------------------------------
'- Fonction permettant de copier le fichier de référence vers le fichier d'historisation -
'-----------------------------------------------------------------------------------------
Function CopieFicRef(Source,ObjFso,RepCopie)
Dim Destination, DateJour, HeureJour
On Error Resume Next
CopieFicRef = "True"
NomProcedureFonction = "Function CopieFicRef(Source,ObjFso,RepCopie), avec Source : " _
& Source & ", RepCopie : " & RepCopie
'-----------------------------------------------------------------------------------------
'- Détermination du nom du fichier de référence -
'-----------------------------------------------------------------------------------------
Destination= "HISTO-" & Year(Date()) & FormatNombre(Month(Date()),2) _
& FormatNombre(Day(Date()),2) & "-" & FormatNombre(Hour(Now()),2) _
& FormatNombre(Minute(Now()),2) & FormatNombre(Second(Now()),2) & ".txt"
FicHisto = Destination
'-----------------------------------------------------------------------------------------
'- teste l'existence du fichier d'historisation -
'-----------------------------------------------------------------------------------------
If Err.Number > 0 Then
ErrNumber = Err.Number
ErrSource = Err.Source
ErrDescription = Err.Description
AfficheMessageErreur NomProcedureFonction,0
CopieFicRef = "False"
Exit Function
End If

NomComplet = RepCopie & Destination
If ObjFso.FileExists(NomComplet) Then
AfficheMessageErreur NomProcedureFonction,4
CopieFicRef = "False"
Exit Function
End If
ObjFso.CopyFile Source, NomComplet, False
If Err.Number > 0 Then
ErrNumber = Err.Number
ErrDescription = Err.Description
ErrSource = Err.source
AfficheMessageErreur NomProcedureFonction,0
CopieFicRef = "False"
Exit Function
End If
End Function

'-----------------------------------------------------------------------------------------
'- Fonction permettant de lister les fichiers d'un répertoire et de ses sous repertoire -
'-----------------------------------------------------------------------------------------

Function ListeFic(ObjFolder,ObjText,Texte)
Dim ObjetFichier, CollectionFichier
Dim DateCreation, DateModification, TailleFic, NomFichier
Dim TabNomFichier()
On Error Resume Next
NomProcedureFonction = "Function ListeFic(ObjFolder,ObjText,Texte)"
Set ObjetFichier = ObjFolder.Files
For Each CollectionFichier in ObjetFichier
If IsEmpty(CollectionFichier.DateCreated) = True Then
DateCreation = "01/01/0001 00:00:00"
Else
DateCreation = CollectionFichier.DateCreated
End If
If Len(DateCreation)< 15 Then
DateCreation = DateCreation & " 00:00:00"
End If
If IsEmpty(CollectionFichier.DateLastModified) = True Then
DateModification = "01/01/0001"
Else
DateModification = CollectionFichier.DateLastModified
End If
If Len(DateModification)< 15 Then
DateModification = DateModification & " 00:00:00"
End If
If IsEmpty(CollectionFichier.DateLastModified) = True Then
TailleFic = 0
Else
TailleFic = CollectionFichier.size
End If
NomFichier = CollectionFichier.Name
If NomFichier <> "" Then
TailleFic = FormatNombre(TailleFic,15)
If TailleFic = "False" Then
ListeFic = "False"
MsgBox("erreur pour l'enregistrement : " _
& CollectionFichier.Name)
Exit Function
End If
' --> Suppression des caractères indésirables
TailleNomFichier = Len(NomFichier)
ReDim TabNomFichier(TailleNomFichier-1)
For i=0 To TailleNomFichier - 1
TabNomFichier(i)=Mid(NomFichier,i+1,1)
If TabNomFichier(i) = "&" Then
TabNomFichier(i) = " "
End If
Next

NomFichier = ""
For i=0 To TailleNomFichier - 1
NomFichier = NomFichier & TabNomFichier(i)
Next

Resultat = EcritureLigne(ObjText, DateCreation & " -- " _
& DateModification & " -- " & TailleFic _
& " -- " & Texte & NomFichier)
NbreFichiertrouver = NbreFichiertrouver + 1
Else
NbreFichierSansAcces = NbreFichierSansAcces + 1
End If
Next
End Function
'-----------------------------------------------------------------------------------------
'- Formatage d'un chiffre sur X caractères
'-----------------------------------------------------------------------------------------

Function FormatNombre(Chiffre, NombreCar)
On Error Resume Next
Dim NbreCarChiffre
NomProcedureFonction = "Function FormatNombre(Chiffre, NombreCar) avec Chiffre = " _
& Chiffre & ", et NombreCar = " & NombreCar
If (Chiffre = "") or (NombreCar = "") Then
AfficheMessageErreur NomProcedureFonction,3
FormatNombre = "False"
Exit Function
End If
If (not IsNumeric(Chiffre)) or (not IsNumeric(NombreCar)) Then
AfficheMessageErreur NomProcedureFonction,2
FormatNombre = "False"
Exit Function
End If
NbreCarChiffre = Len(Chiffre)
If NbreCarChiffre < NombreCar Then
For ind01 = 1 to NombreCar - NbreCarChiffre
ResultatTemp = ResultatTemp & "0"
Next
FormatNombre = ResultatTemp & Chiffre
Else
FormatNombre = Chiffre
End If
If Err.Number > 0 Then
ErrNumber = Err.Number
ErrSource = Err.Source
ErrDescription = Err.Description
AfficheMessageErreur NomProcedureFonction,0
FormatNombre = "False"
Exit Function
End If
End Function

'-----------------------------------------------------------------------------------------
'- Fonction permettant d'écrire une ligne dans un fichier -
'-----------------------------------------------------------------------------------------

Function EcritureLigne(ObjText,Text)
On Error Resume Next
NomProcedureFonction = "Function EcritureLigne(ObjText,Text), avec text: " & Text
EcrireLigne = ObjText.WriteLine(Text)
If Err.Number > 0 Then
ErrNumber = Err.Number
ErrSource = Err.Source
ErrDescription = Err.Description
AfficheMessageErreur NomProcedureFonction,0
End If
End Function

'-----------------------------------------------------------------------------------------
'- Fonction permettant de centrer un texte sur une longueur total de caractère -
'-----------------------------------------------------------------------------------------

Function CentreLigne(Texte,NbreCar)
On Error Resume Next
NomProcedureFonction = "Function CentreLigne(Texte,NbreCar) avec Texte: " & Texte _
& ", NbreCar: " & NbreCar
'-----------------------------------------------------------------------------------------
' Test si le nombre de caractère est numérique -
'-----------------------------------------------------------------------------------------
If IsNumeric(NbreCar) = "False" Then
AfficheMessageErreur NomProcedureFonction,2
CentreLigne = "False"
Exit Function
End If
LongueurblancTotal = NbreCar - Len(Texte)
CentreLigne = Texte
If LongueurblancTotal mod 2 > 0 Then
' on a un chiffre impaire, donc on rajoute (LongueurblancTotal/2)+1 blanc devant
For ind = 1 to Int(LongueurblancTotal/2) + 1
CentreLigne = " " & CentreLigne
Next
Else
For ind = 1 to Int(LongueurblancTotal/2)
CentreLigne = " " & CentreLigne
Next
End If
End Function
'=========================================================================================
'= Procedure =
'=========================================================================================

'-----------------------------------------------------------------------------------------
'- Procédure permettant de comparer le fichier de référence au dernier fichier créer -
'-----------------------------------------------------------------------------------------
Sub CreationXml
Dim Entete, LecComp, EtatFichier, LecXml
Dim EtatAjtTrouver, EtatSupTrouver, EtatModTrouver
Dim Text, NbrLigneXml01, NbrLigneXml02, NbrLigne
Dim FileObjXml, FileObjXml01, FileObjXml02
Const TextAbsMaj = "Il n'y a pas de Mise a jour depuis la derniere execution"
On Error Resume Next
'*********** POUR TEST
' PresenceMAJ = "True"
'************
EtatFichier = "Premier"
EtatFichierPrec = EtatFichier
NomProcedureFonction = "Sub CreationXml"
EtatAjtTrouver = "False"
EtatSupTrouver = "False"
EtatModTrouver = "False"
AvantDernierLigne = "False"
NumLigneTrouve = "False"
NbrLigneXml01 = 0
NbrLigneXml02 = 0
NbrLigne = 0
'---> Arrivé ici, cela signifie que l'on va créer le fichier XML et que ce n'est pas la
' première exécution.

If ObjetFso.FileExists(RepTravail & FicXml)= True Then
Entete = "True"
Else
Entete = "False"
End If

'--> On supprime la dernière ligne du fichier UNIQUEMENT si ce n'est pas la première
' fois que l'on écrit dans le fichier
' ---> Pour Supprimer la ligne "</RESULTAT>":
' --> Supprimer le fichier XML temporaire
' --> Copier le fichier XML vers le fichier XML temporaire
' --> Faire la lecture du fichier temporaire et ne pas copier le ligne
' "</RESULTAT>"
' --> Supprimer le fichier XML temporaire
' --> Fermeture du fichier XML
If Entete = "True" Then
' --> Supprimer le fichier XML temporaire
If ObjetFso.FileExists(RepTravail & FicXml & "temp")= True Then
Resultat = SupFic(RepTravail & FicXml & "temp")
End If
' --> Copier le fichier XML vers le fichier XML temporaire
Resultat = CopyFic(RepTravail & FicXml, RepTravail & FicXml & "temp")
' --> Déclaraton du fichier XML et XML temp
Set ObjFicXmlTmp = ObjetFso_OpenTextFile(RepTravail & FicXml & "temp",ForReading,TristateUseDefault)
Set ObjFicXml = ObjetFso_OpenTextFile(RepTravail & FicXml,ForWriting,True)

Do Until ObjFicXmlTmp.AtEndOfLine = True
LecXmlTmp = LectureFic(ObjFicXmlTmp)
If LecXmlTmp <> "</RESULTAT>" Then
Resultat = EcritureLigne(ObjFicXml,LecXmlTmp)
End If
Loop
ObjFicXmlTmp.close
ObjFicXml.close
Set ObjFicXmlTmp = Nothing
Set ObjFicXml = Nothing
End If
' --> Suppression du fichier Xml temporaire
Resultat = SupFic(RepTravail & FicXml & "temp")
If Resultat = "False" Then
Exit Sub
End If


Set FileObjXml = ObjetFso_OpenTextFile(RepTravail & FicXml,ForAppending,True,TristateUseDefault)
Set FileObjCompTemp = ObjetFso_OpenTextFile(FicCompTemp,ForReading,TristateUseDefault)

'---> Ici on sait si le fichier existait avant, le fichier XML est créé automatiquement
' lors de la déclaration du fichier
If Entete = "False" Then
Text = "<?xml version='1.0' encoding='iso-8859-1' ?>"
'le script sort une erreur 424 non résolue'
Resultat = EcritureLigne(FileObjXml,Text)
If resultat = "False" Then
Exit Sub
End If
Text = "<RESULTAT>"
'erreur 424 ici également'
Resultat = EcritureLigne(FileObjXml,Text)
If resultat = "False" Then
Exit Sub
End If
End If
' ---> Ecriture de la balise de date dans tous les cas
Text = "<DATE>" & dateTravail & " " & HeureDebut
'erreur 424'
Resultat = EcritureLigne(FileObjXml,Text)
If Resultat = "False" Then
Exit Sub
End If

If PresenceMAJ = "False" Then
'Ecriture de la balise du jour
' MsgBox("Ecriture de la notification d'abscence de mis à jours")
Text = "<NOTA>" & TextAbsMaj & "</NOTA></DATE>"
Resultat = EcritureLigne(FileObjXml,Text)
If resultat = "False" Then
Exit Sub
End If
Text = "</RESULTAT>"
Resultat = EcritureLigne(FileObjXml,Text)
If resultat = "False" Then
Exit Sub
End If
Exit Sub
End If
'Ecriture des fichiers
Do
LecComp = LectureFic(FileObjCompTemp)
EtatFichier = Mid(LecComp,1,5)

Select Case EtatFichier
Case "<MOD>"
If EtatFichier <> EtatFichierPrec Then
If EtatFichierPrec <> "Premier" Then
Select Case EtatFichierPrec
Case "<MOD>"
Text = "</MOD>"
Case "<AJT>"
Text = "</AJT>"
Case "<SUP>"
Text = "</SUP>"
End Select
Resultat = EcritureLigne(FileObjXml,Text)
End If
End If
If EtatModTrouver = "False" Then
Text = "<MOD>" & Mid(LecComp,6)
Resultat = EcritureLigne(FileObjXml,Text)
EtatModTrouver = "True"
Else
Text = Mid(LecComp,6)
Resultat = EcritureLigne(FileObjXml,Text)
End If
Case "<SUP>"
If EtatFichier <> EtatFichierPrec Then
If EtatFichierPrec <> "Premier" Then
Select Case EtatFichierPrec
Case "<MOD>"
Text = "</MOD>"
Case "<AJT>"
Text = "</AJT>"
Case "<SUP>"
Text = "</SUP>"
End Select
Resultat = EcritureLigne(FileObjXml,Text)
End If
End If
If EtatSupTrouver = "False" Then
' Text = "<SUP><NOM>" & Mid(LecComp,6) & "</NOM>"
Text = "<SUP>" & Mid(LecComp,6)
Resultat = EcritureLigne(FileObjXml,Text)
EtatSupTrouver = "True"
Else
' Text = "<NOM>" & Mid(LecComp,6) & "</NOM>"
Text = Mid(LecComp,6)
Resultat = EcritureLigne(FileObjXml,Text)
End If
Case "<AJT>"
If EtatFichier <> EtatFichierPrec Then
If EtatFichierPrec <> "Premier" Then
Select Case EtatFichierPrec
Case "<MOD>"
Text = "</MOD>"
Case "<AJT>"
Text = "</AJT>"
Case "<SUP>"
Text = "</SUP>"
End Select
Resultat = EcritureLigne(FileObjXml,Text)
End If
End If
If EtatAjtTrouver = "False" Then
Text = "<AJT>" & Mid(LecComp,6)
Resultat = EcritureLigne(FileObjXml,Text)
EtatAjtTrouver = "True"
Else
Text = Mid(LecComp,6)
EtatAjtTrouver = EcritureLigne(FileObjXml,Text)
End If
End Select
If Resultat = "False" Then
Exit Sub
End If
EtatFichierPrec = EtatFichier
Loop Until FileObjCompTemp.AtEndOfLine = True
'--- Ajout de la fin de la dernier balise
Select Case EtatFichierPrec
Case "<MOD>"
Text = "</MOD>"
Case "<AJT>"
Text = "</AJT>"
Case "<SUP>"
Text = "</SUP>"
End Select
Resultat = EcritureLigne(FileObjXml,Text)
If Resultat = "False" Then
Exit Sub
End If
Text = "<STAT><NBRAJT>" & NbreFicCreer & "</NBRAJT>" & "<NBRMOD>" _
& NbreFicModif & "</NBRMOD><NBRSUP>" & NbreFicSup & "</NBRSUP></STAT></DATE>"
Resultat = EcritureLigne(FileObjXml,Text)
If Resultat = "False" Then
Exit Sub
End If
Text = "</RESULTAT>"
Resultat = EcritureLigne(FileObjXml,Text)
If Resultat = "False" Then
Exit Sub
End If


FileObjXml.close
FileObjCompTemp.Close
If Err.Number > 0 Then
ErrNumber = Err.Number
ErrSource = Err.Source
ErrDescription = Err.Description
AfficheMessageErreur NomProcedureFonction,0
Exit Sub
End If

End Sub

'-----------------------------------------------------------------------------------------
'- Procédure permettant de comparer le fichier de référence au dernier fichier créer -
'-----------------------------------------------------------------------------------------
Sub CompareDocument
Dim LecR, LecH, FicR, FicH
Dim FileObjHisto, FileObjRef, FileObjComp
Dim LectureFicR, LectureFicH
Dim DateCreationR, DateModificationR, TailleFichierR
Dim DateCreationH, DateModificationH, TailleFichierH
On Error Resume Next
NomProcedureFonction = "Sub CompareDocument"
' --> Déclaration des fichiers & initialisation des variables
Set FileObjHisto = ObjetFso_OpenTextFile(RepTravail & FicHisto,ForReading,TristateUseDefault)
Set FileObjRef = ObjetFso_OpenTextFile(FicRef,ForReading,TristateUseDefault)
Set FileObjComp = ObjetFso_OpenTextFile(FicComp,ForAppending,True,TristateUseDefault)
LectureFicR = "True"
LectureFicH = "True"

'---Lecture des fichiers
LecR = LectureFic(FileObjRef)
FicR = Mid(LecR, 66)
LecH = LectureFic(FileObjHisto)
FicH = Mid(LecH, 66)
While FileObjRef.AtEndOfLine <> True And FileObjHisto.AtEndOfLine <> True
'-- Test si un fichier a été ajouter
If LCase(FicR) < LCase(FicH) Then
PresenceMAJ = "True"
Text = "<AJT><NOM>" & FicR & "</NOM>"
NbreFicCreer = NbreFicCreer + 1
Result = EcritureLigne(FileObjComp,Text)
Do
LecR = LectureFic(FileObjRef)
FicR = Mid(LecR, 66)
If LCase(FicR) < LCase(FicH) Then
Text = "<AJT><NOM>" & FicR & "</NOM>"
Result = EcritureLigne(FileObjComp,Text)
NbreFicCreer = NbreFicCreer + 1
Else
LectureFicR = "False"
LectureFicH = "True"
End If
Loop Until LCase(FicR) >= LCase(FicH) or FileObjRef.AtEndOfLine = True
Else
'-- Test si un fichier a été supprimer
If LCase(FicR) > LCase(FicH) Then
PresenceMAJ = "True"
Text = "<SUP><NOM>" & FicH & "</NOM>"
Result = EcritureLigne(FileObjComp,Text)
NbreFicSup = NbreFicSup + 1
Do
LecH = LectureFic(FileObjHisto)
FicH = Mid(LecH, 66)
If LCase(FicR) > LCase(FicH) Then
Text = "<SUP><NOM>" & FicH & "</NOM>"
Result = EcritureLigne(FileObjComp,Text)
NbreFicSup = NbreFicSup + 1
Else
LectureFicH = "False"
LectureFicR = "True"
Exit Do
End If
Loop Until LCase(FicH) >= LCase(FicR) or FileObjHisto.AtEndOfLine = True
Else
'-- Test si FicH = FicR
If LCase(FicR) = LCase(FicH) Then
LectureFicR = "True"
LectureFicH = "True"
DateCreationR = Mid(LecR, 1, 19)
DateModificationR = Mid(LecR, 24, 19)
TailleFichierR = Mid(LecR, 47, 15)
DateCreationH = Mid(LecH, 1, 19)
DateModificationH = Mid(LecH, 24, 19)
TailleFichierH = Mid(LecH, 47, 15)
'-- Test si les fichiers ont été modifiés
If (DateModificationR <> DateModificationH)_
or (DateCreationR <> DateCreationH) _
or (TailleFichierR <> TailleFichierH) Then
PresenceMAJ = "True"
Text = "<MOD><NOM>" & FicH
NbreFicModif = NbreFicModif + 1
If TailleFichierR <> TailleFichierH Then
Text = Text & "<MODTAILLE>" _
& "<TAILLE-AV>" & TailleFichierH & "</TAILLE-AV>" _
& "<TAILLE-AP>" & TailleFichierR & "</TAILLE-AP>" _
& "</MODTAILLE>"
End If
If DateCreationR <> DateCreationH Then
Text = Text & "<MODDTCR>" _
& "<DATECR-AV>" & DateCreationH & "</DATECR-AV>" _
& "<DATECR-AP>" & DateCreationR & "</DATECR-AP>" _
& "</MODDTCR>"
End If
If DateModificationR <> DateModificationH Then
Text = Text & "<MODDTMO>" _
& "<DATEMO-AV>" & DateModificationH & "</DATEMO-AV>" _
& "<DATEMO-AP>" & DateModificationR & "</DATEMO-AP>" _
& "</MODDTMO>"
End If
Text = Text & "</NOM>"
Result = EcritureLigne(FileObjComp,Text)

End If
LecR = LectureFic(FileObjRef)
FicR = Mid(LecR, 66)
LecH = LectureFic(FileObjHisto)
FicH = Mid(LecH, 66)
Else
PresenceMAJ = "False"
End If
End If
End If
Wend
FileObjHisto.close
FileObjRef.Close
FileObjComp.Close
Set FileObjHisto = Nothing
Set FileObjRef = Nothing
Set FileObjComp = Nothing

End Sub

'-----------------------------------------------------------------------------------------
'- Procedure permettant de créeer le compte rendu d'exécution -
'-----------------------------------------------------------------------------------------
Sub CreationCompteRendu
Dim FileObjCpt, TabCptRendu(24)
Const TailleLigne = 100
On Error Resume Next
NomProcedureFonction = "Sub CreationCompteRendu"
'-----------------------------------------------------------------------------------------
'- Création d'un tableau contenant l'ensemble des lignes à écrire dans le compte rendu -
'-----------------------------------------------------------------------------------------

For ind = 1 to 48
TabCptRendu(0) = TabCptRendu(0) & "*"
Next
TabCptRendu(0) = CentreLigne(TabCptRendu(0),TailleLigne)
TabCptRendu(1) = "* COMPTE RENDU D'EXECUTION DU " & FormatNombre(Day(Date()),2) _
& "/" & FormatNombre(Month(Date()),2) & "/" & Year(Date()) & " *"
TabCptRendu(1) = CentreLigne(TabCptRendu(1),TailleLigne)
TabCptRendu(2) = TabCptRendu(0)
TabCptRendu(3) = ""
TabCptRendu(4) = TabCptRendu(3)
TabCptRendu(5) = Chr(9) & "- DATE D'EXECUTION : " _
& FormatDateTime(Date(),vbLongDate)
TabCptRendu(6) = TabCptRendu(3)
TabCptRendu(7) = Chr(9) & "- HEURE DE DEBUT D'EXECUTION : " _
& HeureDebut
TabCptRendu(8) = TabCptRendu(3)
TabCptRendu(9) = Chr(9) & "- HEURE DE FIN D'EXECUTION : " _
& FormatDateTime(Time(),vbLongTime)
TabCptRendu(10) = TabCptRendu(3)
TabCptRendu(11) = Chr(9) & "- NOMBRE DE FICHIERS LISTEES : " _
& NbreFichiertrouver
TabCptRendu(12) = TabCptRendu(3)
TabCptRendu(13) = Chr(9) & "- NOMBRE DE FICHIERS N'AYANT PAS PU ETRE ACCEDE : " _
& NbreFichierSansAcces
TabCptRendu(14) = TabCptRendu(3)
TabCptRendu(15) = Chr(9) & "- NOM DU FICHIER HISTORIQUE CREER : " _
& FicHisto
TabCptRendu(16) = TabCptRendu(3)
TabCptRendu(17) = Chr(9) & "- NOMBRE DE FICHIER CREE DEPUIS LA DERNIERE EXECUTION : " _
& NbreFicCreer
TabCptRendu(18) = TabCptRendu(3)
TabCptRendu(19) = Chr(9) & "- NOMBRE DE FICHIER MODIFIE DEPUIS LA DERNIERE EXECUTION : " _
& NbreFicModif
TabCptRendu(20) = TabCptRendu(3)
TabCptRendu(21) = Chr(9) & "- NOMBRE DE FICHIER SUPPRIME DEPUIS LA DERNIERE EXECUTION : " _
& NbreFicSup
TabCptRendu(22) = TabCptRendu(3)
For ind = 1 to TailleLigne
TabCptRendu(23) = TabCptRendu(23) & "="
Next
TabCptRendu(24) = TabCptRendu(3)
' MsgBox(FicCptRendu)
Set FileObjCpt = ObjetFso_OpenTextFile(FicCptRendu,ForAppending,True,TristateUseDefault)
For ind = 0 to UBound(TabCptRendu,1)
resultat = EcritureLigne(FileObjCpt,TabCptRendu(ind))
Next
If Err.Number > 0 Then
ErrNumber = Err.Number
ErrSource = Err.Source
ErrDescription = Err.Description
AfficheMessageErreur NomProcedureFonction,0
Exit Sub
End If

End Sub


'-----------------------------------------------------------------------------------------
'- Procedure permettant d'afficher les messages
'-----------------------------------------------------------------------------------------

Sub AfficheMessageErreur(Fonction,NumErreur)
On Error Resume Next
Dim TabMessageErreur(10)
Dim Message
' Liste des message d'erreur
TabMessageErreur(0) = Chr(9) & "- Origine de la source d'erreur: " & ErrSource _
& Chr(13) & Chr(10) & Chr(9) & "- Numéro de l'erreur : " & ErrNumber _
& Chr(13) & Chr(10) & Chr(9) & "- Description de l'erreur : " & ErrDescription
TabMessageErreur(1) = "Erreur de lecture dans l'écriture du fichier"
TabMessageErreur(2) = "L'une des variables passées en paramètre de la fonction " _
& "n'est pas numérique"
TabMessageErreur(3) = "Tous les paramètres obligatoires ne sont pas alimentés"
TabMessageErreur(4) = "Le fichier historique existe déjà, Arrêt du programme sans suppression" _
& "du fichier de référence."
TabMessageErreur(5) = "Le fichier temporaire n'existe pas"
TabMessageErreur(6) = "Le Temp impartie est dépassé"
TabMessageErreur(7) = "Le nombre de fichier lu dans le fichier XML est différentes entre " _
& "les 2 dernière lecture"
TabMessageErreur(8) = "Les paramètres en entrée sont en nombre insuffisant." & Chr(13) _
& Chr(10) & "Pour exécuter le Script,il faut le lancer avec les paramètres suivants: " _
& " Surveillance.vbs 'X''Y' où" & Chr(13) & Chr(10) & Chr(9) & " - X: Représente " _
& " le disque à analyser." & Chr(13) & Chr(10) & Chr(9) & " - Y: le reperoire où " _
& "seront créés les fichiers de résultats."
If (1 =< NumErreur =< UBound(TabMessageErreur,1)) = False Then
Numerreur = 0
End If
Message = "Erreur dans la " & Fonction & "." & Chr(13) & Chr(10) _
& TabMessageErreur(NumErreur)

MsgBox(Message)
End Sub[/cpp]


Et le créateur du script n'a pas donné signe de vie depuis 2004 Alors :D Je pense qu'il a du déserté et que ça fait longtemps qu'il a laissé son script a la merci de tous ^^
 
N

negoksa

Nouveau membre
Quelqu'un aurait t'il une idée ? même si ce n'est pas grand chose , je bloque toujours dessus.

Cordialement Nego.
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Dernières actus
Derniers messages publiés
Statistiques globales
Discussions
730 131
Messages
6 717 941
Membres
1 586 382
Dernier membre
alejandrooo
Partager cette page
Haut