[ VBS ] Fuite mémoire ?

[pedrosky]

Bonjour à tous,

J'ai fait un petit script en Visual Basic Script afin de vérifier toute les 5 secondes la présence d'un dossier sur le réseau.
Selon le statut, cela modifie 2 clefs de la base de registre.

J'ai essayé de faire au mieux en fonction des tutoriaux glanés sur le www et j'ai finalisé un script qui - converti en exécutable - fait le job (j'ai l'impression).
Cependant, en regardant l'évolution de l'allocation de la mémoire vive pour ce petit exe, je me rend compte qu'il grimpe progressivement et continuellement, quelques kilo toutes les 5 secondes environs. C'est pas énorme, il part à 3700K et grimpe petit à petit après.
Vu qu'il est destiné à rester actif tout le temps, cela est surement problématique ?

Je soupçonne donc une fuite mémoire, mais je ne comprend pas d'où cela peut venir.
J'ai essayer de libérer les objets à la fin de chaque cycle de 5 sec mais le résultat est le même.

Avez vous des idées ?

Ci dessous le code :

Dim Obj
Dim fso
Dim rep

Set fso = CreateObject("Scripting.FileSystemObject")
Set Obj = CreateObject("WScript.Shell")

Clef_1 = "HKEY_LOCAL_MACHINE\SOFTWARE\TEST\Clef_1"
Clef_2 = "HKEY_LOCAL_MACHINE\SOFTWARE\TEST\Clef_2"
path_reseau="Y:\"
path_1_reseau="Y:"
path_2_reseau="\\Données"
path_1_local="C:"
path_2_local="\\Users\\Pierre\\Documents\\Données"


CheckNas()

Function CheckNas() ' Vérifier la présence du serveur
	reseau_exists = fso.FolderExists(path_reseau)
	Read_1 = Obj.RegRead(Clef_1)
	if (reseau_exists) and Read_1 = path_1_reseau then ' Si accéssible et configuré
			'Obj.Popup "NAS accessible et déja configuré" & vbLf & "Fermeture automatique dans de 3 secondes", 3, "This is your Message Box", 0 + vbSystemModal + vbInformation
			Continue()
		elseif (reseau_exists) and Read_1 = path_1_local then ' Si accéssible et non configuré
			NasAccessible()
		elseif not (reseau_exists) and Read_1 = path_1_reseau then ' Si non accéssible et non configuré
			NasNonAccessible()
		elseif not (reseau_exists) and Read_1 = path_1_local then ' Si non accéssible et configuré
			'Obj.Popup "NAS non accessible et déja configuré" & vbLf & "Fermeture automatique dans 3 secondes", 3, "This is your Message Box", 0 + vbSystemModal + vbInformation
			Continue()
		end if
	end Function

Function Continue() ' Attendre 5 secondes Continuer de vérifier la présence du serveur
	WScript.Sleep 5000
	CheckNas()
	end Function

Function NasAccessible() ' Configurer pour travailler les projets en réseau
	rep = MsgBox("Le Serveur est accéssible" & vbLf & "Voulez vous basculer en Réseau ?", vbYesNoCancel + vbQuestion + vbSystemModal, "NAS accéssible")
	if rep = vbYes then
		Obj.RegWrite Clef_1, path_1_reseau, "REG_SZ"
		Obj.RegWrite Clef_2, path_2_reseau, "REG_SZ"
	ElseIf rep = vbNo Then
	ElseIf rep = vbCancel then
		Quit()
		end if
	Continue()
	end Function

Function NasNonAccessible() ' Configurer pour travailler les projets en local
	rep = MsgBox("Le Serveur n'est pas accéssible" & vbLf & "Voulez vous basculer en Local ?", vbYesNoCancel + vbQuestion + vbSystemModal, "NAS non accéssible")
	if rep = vbYes then
		Obj.RegWrite Clef_1, path_1_local, "REG_SZ"
		Obj.RegWrite Clef_2, path_2_local, "REG_SZ"
	ElseIf rep = vbNo Then
	ElseIf rep = vbCancel then
		Quit()
		end if
	Continue()
	end Function

Function Quit() ' Quitter le programme
		rep = Obj.Popup( "Attention !" & vbLf & vbLf & "La vérification de présence du serveur n'est plus éffective" & vbLf & "Fermeture automatique dans de 3 secondes", 5, "Procédure arrétée", vbOKCancel + vbSystemModal + vbExclamation )
		if rep = vbYes then
		ElseIf rep = vbCancel then
			Continue()
			end if
	End Function

Set Obj = Nothing ' Destruction des Objs
Set fso = Nothing ' Destruction des Objs
WScript.Quit ' Quiter le programme

-----

[cherbe]

bonjour
Je n'ai pas scruté ton code car je ne pense pas qu'il soit en cause.
Quand j'ai commencé à programmer il y a longtemps, on faisait le test d'une commande DOS en boucle qui finissait par absorber toute la mémoire. C'est donc un problème lié au système.
Tu devrais limiter le nombre d'exécutions et killer puis redémarrer ton programme à l'aide du gestionnaire de tâches Windows.

[Jack]

Je n'y connais pas grand chose en VB, mais je vois que la fonction "Continue" appelle la fonction "CheckNas" qui elle-même peut appeler la fonction "Continue". Il y a une sorte de récursivité indirecte il me semble et ta pile doit enfler, ce qui expliquerait cette fuite de mémoire.

[pedrosky]

Je comprend ce que tu veut dire Jack,
Mais dans l’exécution de la fonction CheckNas(), une fois la fonction Continue() appelée, la fonction CheckNas() ne se termine-t-elle pas ?

[A voir en vidéo sur Futura]

[webours]

Il semble que ton script soit correct quant à l'exécution des tâches, les boucles sont encadrées pour permettre une sortie.
Pour éviter la fuite de mémoire, s'il est nécessaire de tuer les objets , il faudrait les tuer avant de sortir de la fonction.
Les objets sont créés au début du programme et tués à la fin du programme mais tant que la boucle CheckNas() ... Continue() est opérationnelle, aucun objet n'est tué.
Il serait plus logique de créer les objets en début de la fonction CheckNas en GLOBAL pour que les autres fonctions puissent y avoir accès et les tuer dans la fonction Continue() avant que cette fonction n'appelle CheckNas()

[webours]

Je comprend ce que tu veut dire Jack,
Mais dans l’exécution de la fonction CheckNas(), une fois la fonction Continue() appelée, la fonction CheckNas() ne se termine-t-elle pas ?

Il me semble que VBS n'est pas un langage événementiel donc pour sortir de cette boucle, il faut utiliser les étiquettes de renvoi.

debut:
CheckNas()
Continue()
GOTO:debut

Pour utiliser ce type de programmation séquentielle, il faut supprimer de la fonction CheckNas() l'appel à la fonction Continue() et supprimer de la fonction Continue() l'appel de la fonction CheckNas()

[pedrosky]

Hey Jack !

Tu avais raison , j'ai l'impression que lorsque l'on fait appel à une fonction ( ex: Continue() ) dans une autre fonction ( ex: CheckNas() ), la première (CheckNas) reste active tant que la deuxième (Continue) n'est pas finie.
Mais comme je fait aussi appel à CheckNas() dans Continue(), cela doit recréer une nouvelle instance de CheckNas(), puis Continue(), puis CheckNas(), puis... etc.
Du coup, cela s'empile indéfiniment.

J'ai alors fait une boucle While avec le contenu de la fonction Continue(), qui reste active tant qu'un flag ( Dim master = run ) ne change pas de valeur.
J'ai viré Continue() et tout les appels qu'il y a avait dans le code.

De ce fait, avant chaque nouveau tour de la boucle While, toutes les fonctions sont proprement finie.
Il n'y a donc plus de fuite mémoire et le programme reste stable.

Merci à cherbe et webours pour votre aide et vos idées. De mon côté, ce problème est RESOLU !

Ci dessous le code qui va bien :

Dim Obj
Dim fso
Dim rep
Dim Clef_1
Dim Clef_2
Dim path_reseau
Dim path_1_reseau
Dim path_2_reseau
Dim path_1_local
Dim path_2_local
Dim reseau_exists
Dim Read_1
Dim master

Set fso = CreateObject("Scripting.FileSystemObject")
Set Obj = CreateObject("WScript.Shell")

Clef_1 = "HKEY_LOCAL_MACHINE\SOFTWARE\TEST\1"
Clef_2 = "HKEY_LOCAL_MACHINE\SOFTWARE\TEST\2"
path_reseau="Y:\"
path_1_reseau="Y:"
path_2_reseau="\\Données"
path_1_local="C:"
path_2_local="\\Users\\Pierre\\Documents\\Données"
master = "run"

While (master = "run")
	WScript.Sleep 5000
	CheckNas()
	Wend

Function CheckNas() ' Vérifier la présence du serveur
	reseau_exists = fso.FolderExists(path_reseau)
	Read_1 = Obj.RegRead(Clef_1)
	if (reseau_exists) and Read_1 = path_1_reseau then ' Si accéssible et configuré
		
		elseif (reseau_exists) and Read_1 = path_1_local then ' Si accéssible et non configuré
			NasAccessible()
		elseif not (reseau_exists) and Read_1 = path_1_reseau then ' Si non accéssible et non configuré
			NasNonAccessible()
		elseif not (reseau_exists) and Read_1 = path_1_local then ' Si non accéssible et configuré
		
		end if
	end Function

Function NasAccessible() ' Configurer pour travailler les projets en réseau
	rep = MsgBox("Le Serveur est accéssible" & vbLf & "Voulez vous basculer en Réseau ?", vbYesNoCancel + vbQuestion + vbSystemModal, "NAS accéssible")
	if rep = vbYes then
		Obj.RegWrite Clef_1, path_1_reseau, "REG_SZ"
		Obj.RegWrite Clef_2, path_2_reseau, "REG_SZ"
	ElseIf rep = vbNo Then
	ElseIf rep = vbCancel then
		Quit()
		end if
	end Function

Function NasNonAccessible() ' Configurer pour travailler les projets en local
	rep = MsgBox("Le Serveur n'est pas accéssible" & vbLf & "Voulez vous basculer en Local ?", vbYesNoCancel + vbQuestion + vbSystemModal, "NAS non accéssible")
	if rep = vbYes then
		Obj.RegWrite Clef_1, path_1_local, "REG_SZ"
		Obj.RegWrite Clef_2, path_2_local, "REG_SZ"
	ElseIf rep = vbNo Then
	ElseIf rep = vbCancel then
		Quit()
		end if
	end Function

Function Quit() ' Quitter le programme
		rep = Obj.Popup( "Attention !" & vbLf & vbLf & "La vérification de présence du serveur n'est plus éffective" & vbLf & "Fermeture automatique dans de 5 secondes", 5, "Procédure arrétée", vbOKCancel + vbSystemModal + vbExclamation )
		if rep = vbYes then
			master = "stop"
		ElseIf rep = vbCancel then
		ElseIf master = "run" then
			master = "stop"
			end if
	End Function

Set Obj = Nothing ' Destruction des Objs
Set fso = Nothing ' Destruction des Objs
WScript.Quit ' Quiter le programme

[Jack]

Hey Jack !

Tu avais raison , j'ai l'impression que lorsque l'on fait appel à une fonction ( ex: Continue() ) dans une autre fonction ( ex: CheckNas() ), la première (CheckNas) reste active tant que la deuxième (Continue) n'est pas finie.

Oui, c'est le principe de terminaison des fonctions: soit on exécute return soit on on arrive à "End function"