Télécharger

Téléchargé 8 fois

Vote des utilisateurs

Voir les 8 commentaires

Détails

Moncef Ben Othman

Modérateur

5833 points

Voir tous les téléchargements de l'auteur

Licence : Freeware

Mise en ligne le 20 juin 2015

Plate-forme : Windows

Langue : Français

Référencé dans

VBS

Navigation

Retourner à la liste des ressources Retourner à l'accueil des téléchargements Ajouter un LOGICIELAjouter un FRAMEWORKAjouter un CODE SOURCE

MsgBoxPlus

Diviser le texte à afficher sur plusieurs boites de message

Nos ressources disponibles

La longueur du texte qu'affiche la boite MsgBox ne pouvant pas dépasser les 1024 caractères, on trouve ici une alternative pour palier à cette limitation. D'autre descriptions et commentaires accompagnent le code.

Signaler un problème

ProgElecT

Expert éminent sénior

Le 03/06/2015 à 22:42

Salut

34 boites de dialogue à la suite

c'est un vrai roman ton fichier WUpdate.log, heureusement que tu fournis StopWScript.vbs

l_autodidacte

Modérateur

Le 04/06/2015 à 17:38

juste pour signaler que la fonction Popup de l'objet WScript ne connait pas cette limitation de 1024 caractères

Justement, l'intérêt du code vient du fait que Popup ou Echo affiche tout mais en sortant de l'écran(haut et bas) et on ne voit ni la barre de titres ni le bouton OK et pas mal d'autres lignes si le texte est très long.

hackoofr

Expert éminent

Le 03/06/2015 à 23:15

pour le partage l_autodidacte

Envoyé par ProgElecT

Salut

34 boites de dialogue à la suite

c'est un vrai roman ton fichier WUpdate.log, heureusement que tu fournis StopWScript.vbs

Voici un code pour arrêter sélectivement un vbscript qui tourne

Code :

Sélectionner tout

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Option Explicit
Dim Titre,Copyright,fso,ws,NomFichierLog,temp,PathNomFichierLog,OutPut,Count,strComputer
If AppPrevInstance() Then 
    MsgBox "Il y a une instance déjà en cours" & VbCrLF & CommandLineLike(WScript.ScriptName),VbExclamation,"Il y a une instance déjà en cours"    
    WScript.Quit   
Else 
Copyright = "[© Hackoo © 2015 ]"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject( "Wscript.Shell" )
NomFichierLog="Killed Process.txt"
temp = ws.ExpandEnvironmentStrings("%temp%")
PathNomFichierLog = temp & "\" & NomFichierLog
Set OutPut = fso.CreateTextFile(temp & "\" & NomFichierLog,1)
strComputer = "."
    Call Find("wscript.exe")
    Call Explorer(PathNomFichierLog)
End If
'***************************************************************************************************
Function Explorer(File)
    Dim ws
    Set ws = CreateObject("wscript.shell")
    ws.run "Explorer "& File & "\",1,True
end Function
'***************************************************************************************************
Sub Find(MyProcess)
    Dim colItems,objItem,Processus,Question
    Titre = " Processus "& DblQuote(MyProcess) &" en cours d'exécution "
    Set colItems = GetObject("winmgmts:").ExecQuery("Select * from Win32_Process " _
    & "Where Name like '%"& MyProcess &"%' AND NOT commandline like " & CommandLineLike(WScript.ScriptFullName) & "",,48)
    Count = 0 
    For Each objItem in colItems
        Count= Count + 1
        'Processus = Mid(objItem.CommandLine,InStr(objItem.CommandLine,""" """) + 2) 'Extraction du chemin du script en ligne de commande
        Processus = objItem.CommandLine 'Replace(Processus,chr(34),"")
        Question = MsgBox ("Voulez-vous arrêter ce script : " & DblQuote(Processus) & " ?" ,VBYesNO+VbQuestion,Titre+Copyright)
        If Question = VbYes then
            objItem.Terminate(0)'Tuer ce processus
            OutPut.WriteLine Processus
        else
            Count= Count - 1 'décrementer le compteur de -1
        End if
    Next
OutPut.WriteLine String(100,"*")
OutPut.WriteLine count & Titre & "ont été arrêtés"
OutPut.WriteLine String(100,"*") & VbCrLF 
End Sub
'**************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**************************************************************************
Function AppPrevInstance()   
    With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")   
        With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
            " AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")   
            AppPrevInstance = (.Count > 1)   
        End With   
    End With   
End Function   
'**************************************************************************
Sub Pause(Minutes)    
    Wscript.Sleep(Minutes*1000*60)    
End Sub   
'**************************************************************************
Function StripProcPath(ProcessPath)   
    Dim arrStr : arrStr = Split(ProcessPath, "\")   
    StripProcPath = arrStr(UBound(arrStr))   
End Function   
'**************************************************************************
Function CommandLineLike(ProcessPath)   
    ProcessPath = Replace(ProcessPath, "\", "\\")   
    CommandLineLike = "'%" & ProcessPath & "%'"   
End Function
'**************************************************************************

ProgElecT

Expert éminent sénior

Le 04/06/2015 à 13:36

Salut

Je ne parvient pas à comprendre Set F = fso.OpenTextFile(".\WUpdate.log", 1, False), Le point pour indiquer le chemin/dossier ne fonctionne pas ni sur mon ordinateur chez moi, ni au travail.
Hier je pensais que c'était spécifique à ma configuration window, mais bien que différent au boulot, même réaction.
Donc j'ai remplacé par Set F = fso.OpenTextFile(fso.GetParentFolderName(wscript.ScriptFullName) & "\WUpdate.log", 1, False).
Si quelqu’un peut éclairer ma lanterne

Je pense intégrer la fonction à un programme de visualisation de commandes (jamais plus d'une dizaine), pour cela j'ai ajouté une variable Dim ReponsE ' Pour analyse de la réponse à la boite de dialogue, modifié l'appel à la boite de dialogue et enfin, en retour de boite de dialogue, une condition If .... Then qui permet de sortir de l'affichage à tout moment.

Code :

Sélectionner tout

1
2
3
			 ReponsE = MsgBox(RetMsg(Compt),btnType , sTitle _
			 & " (" & CStr(Compt+1) & "/" & CStr(nbMessages-tmp+1) & "   taille = " &Len(RetMsg(Compt)) & ")")
			 If btnType = vbOKCancel And ReponsE = vbCancel Then Exit Function

Avec cette petite modification dans la fonction, je l'appel maintenant de cette façon MsgBoxPlus text, vbOKCancel, "Test de boite de message",1300

omen999

Rédacteur

Le 04/06/2015 à 14:39

bonjour,
juste pour signaler que la fonction Popup de l'objet WScript ne connait pas cette limitation de 1024 caractères
évidemment, il faut être dans un contexte wsh

@ProgElect

Si quelqu’un peut éclairer ma lanterne

peut-être un problème de droits sur le répertoire cible ?

l_autodidacte

Modérateur

Le 04/06/2015 à 17:27

Normalement, si les deux fichiers(script et fichier de test) sont dans le même répertoire, on n'a pas besoin du (.) indiquant le dossier courant.
Il faut donc voir du côté des droits sur le dossier comme indiqué par omen999(salut).

Quelqu'un de bénévole pourrait-il faire le test sur sa machine et donner le résultat ? avec mes remerciements.

l_autodidacte

Modérateur

Le 07/06/2015 à 19:04

Une mise à jour du fichier source est disponible à la même adresse : MsgBoxPlus.
Les commentaires expliquent ce qui a été modifié.

l_autodidacte

Modérateur

Le 08/06/2015 à 17:42

ReponsE = MsgBox(RetMsg(Compt),btnType , sTitle _
& " (" & CStr(Compt+1) & "/" & CStr(nbMessages-tmp+1) & " taille = " &Len(RetMsg(Compt)) & "

")
If btnType = vbOKCancel And ReponsE = vbCancel Then Exit Function

Maintenant, plus besoin de cette modification avec la mise à jour que j'ai ajoutée : btnType = vbOkCancel par défaut avec la gestion de la réponse si vbCancel tout en supprimant le fichier StopWscript.vbs qui n'a plus de rôle.

Poster un commentaire

Developpez.com décline toute responsabilité quant à l'utilisation des différents éléments téléchargés.