Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Recherche news groupe FR pour problème VBS / Search news group FR problem VBS

7 réponses
Avatar
Blaise Cacramp
Bonjour ou bonsoir, selon.

Je cherche pour un script VBS un moyen pour faire patienter un utilisateur
lors d'une opération qui prend un certain temps (en l'occurence un mise à
jour).
Je pense au pointeur "hourglass" ou à un message sans devoir cliquer sur un
"Ok".

J'ai trouvé un magnifique code (que je place plus loin dans le fil) qui
fonctionne parfaitement, sauf sur les postes de travail où l'utisateur n'a
pas le droit de modifier la base de registre.
Ce code n'est pas documenté / commenté.

Pouvez-vous m'aider, un grand merci

Literal translation (google)
--------------------
Hello or good, depending.

I'm looking for a VBS script to wait a user during an operation which takes
some time (in this case an update).
I think the pointer "hourglass" or to a message without having to click on
OK.

I found a wonderful code (which I place later in the thread) which works
perfectly, except for jobs where utisateur has no right to modify the
registry.
This code is not documented / commented.

Can you help me, thank you

Cdt, Blaise
---- ---- ----

7 réponses

Avatar
Michel__D
Bonjour,

L'accés à la base de registre n'est la que pour permettre de modifier le
message d'attente pendant la période d'attente si tu souhaite afficher
un message fixe tu n'a pas besoin d'accéder à la base de registre, mais
la question serait plutôt de comprendre ce que fait le script.


"Blaise Cacramp" a écrit dans le message de news:%
Bonjour ou bonsoir, selon.

Je cherche pour un script VBS un moyen pour faire patienter un utilisateur
lors d'une opération qui prend un certain temps (en l'occurence un mise à
jour).
Je pense au pointeur "hourglass" ou à un message sans devoir cliquer sur un
"Ok".

J'ai trouvé un magnifique code (que je place plus loin dans le fil) qui
fonctionne parfaitement, sauf sur les postes de travail où l'utisateur n'a
pas le droit de modifier la base de registre.
Ce code n'est pas documenté / commenté.

Pouvez-vous m'aider, un grand merci

Literal translation (google)
--------------------
Hello or good, depending.

I'm looking for a VBS script to wait a user during an operation which takes
some time (in this case an update).
I think the pointer "hourglass" or to a message without having to click on
OK.

I found a wonderful code (which I place later in the thread) which works
perfectly, except for jobs where utisateur has no right to modify the
registry.
This code is not documented / commented.

Can you help me, thank you

Cdt, Blaise
---- ---- ----





Avatar
Blaise Cacramp
Bonjour ou bonsoir, selon.

Oui, c'est vrai que je n'ai pas pris le temps d'analyser. Faut dire que le
code n'était déjà pas indenté ni aéré. J'ai normalement les capacités
d'analyser, je vais m'y atteler. Merci quand même


Cdt, Blaise
---- ---- ----


"Michel__D" a écrit dans le message de
news: gkpjjo$jhr$
Bonjour,

L'accés à la base de registre n'est la que pour permettre de modifier le
message d'attente pendant la période d'attente si tu souhaite afficher
un message fixe tu n'a pas besoin d'accéder à la base de registre, mais
la question serait plutôt de comprendre ce que fait le script.


"Blaise Cacramp" a écrit dans le message de
news:%
Bonjour ou bonsoir, selon.

Je cherche pour un script VBS un moyen pour faire patienter un
utilisateur
lors d'une opération qui prend un certain temps (en l'occurence un mise à
jour).
Je pense au pointeur "hourglass" ou à un message sans devoir cliquer sur
un
"Ok".

J'ai trouvé un magnifique code (que je place plus loin dans le fil) qui
fonctionne parfaitement, sauf sur les postes de travail où l'utisateur
n'a
pas le droit de modifier la base de registre.
Ce code n'est pas documenté / commenté.

Pouvez-vous m'aider, un grand merci

Literal translation (google)
--------------------
Hello or good, depending.

I'm looking for a VBS script to wait a user during an operation which
takes
some time (in this case an update).
I think the pointer "hourglass" or to a message without having to click
on
OK.

I found a wonderful code (which I place later in the thread) which works
perfectly, except for jobs where utisateur has no right to modify the
registry.
This code is not documented / commented.

Can you help me, thank you

Cdt, Blaise
---- ---- ----








Avatar
Edreux \(ILINFO\)
Bonsoir,

je n'ai pas essayé votre script, mais vous pouvez essayer de lire / écrire
dans HKEY_CURRENT_USER au lieu de HKEY_LOCAL_MACHINE.
ca devrait régler votre problème d'accès à la base de registre:

oBarCat.Add oBarCat.Count, " sStatusMsg = Replace(oShell.RegRead(" &
Chr(34) & "HKLMSYSTEMProgressBarMSG" & Chr(34) & "), VbCrLf," & Chr(34) &
"<br>" & Chr(34) & ") "

[...]
oShell.RegWrite "HKLMSYSTEMProgressBarMSG", sMessageToDisplay, "REG_SZ"
[...]

Cordialement,
Emmanuel Dreux
http://www.ilinfo.fr


"Blaise Cacramp" a écrit dans le message de
news:%
http://www.visualbasicscript.com/m_40519/mpage_1/key_/tm.htm#40519

Option Explicit

Dim oBar

Set oBar = New ProgressBar
oBar.StartBar "La mise à jour est en cours, veuillez patienter quelques
secondes."
WScript.Sleep (3000)
oBar.SetLine "So is this."
WScript.Sleep (3000)
oBar.CloseBar

Class ProgressBar
Dim oBarCat, sProgressBarHTAFile, sProgressBarRunFile,
sProgressBarSleepFile, sInitialTempBuild
Public Sub StartBar(sMessageToDisplay)
Dim sInitialTemp, i

ExecuteGlobal "Dim oShell, oFSO, oEnv"

Set oShell = CreateObject("Wscript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oEnv = oShell.Environment("Process")
For i = 1 To 16
sInitialTempBuild = sInitialTempBuild & Chr(fRand(97,122))
Next
sInitialTemp = oFSO.GetDriveName(oEnv("TEMP")) & "" & sInitialTempBuild
& "" & oFSO.GetFileName(fGetTempName)
sProgressBarHTAFile = Left(sInitialTemp,(Len(sInitialTemp)-4)) & ".hta"
sProgressBarRunFile = Left(sProgressBarHTAFile,
Len(sProgressBarHTAFile)-4) & ".run"
sProgressBarSleepFile = Left(sProgressBarHTAFile,
Len(sProgressBarHTAFile)-4) & "sleep.vbs"
Set oBarCat = CreateObject("Scripting.Dictionary")
oBarCat.Add oBarCat.Count, "<html>"
oBarCat.Add oBarCat.Count, "<head>"
oBarCat.Add oBarCat.Count, "<title id=" & Chr(34) & "title" & Chr(34) &
">Please Wait</title>"
oBarCat.Add oBarCat.Count, "<HTA:APPLICATION "
oBarCat.Add oBarCat.Count, " ID=" & Chr(34) & "StatusBar" & Chr(34) &
""
oBarCat.Add oBarCat.Count, " APPLICATIONNAME=" & Chr(34) & "StatusBar"
& Chr(34) & ""
oBarCat.Add oBarCat.Count, " SCROLL=" & Chr(34) & "NO" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " SINGLEINSTANCE=" & Chr(34) & "YES" &
Chr(34) & ""
oBarCat.Add oBarCat.Count, " CAPTION=" & Chr(34) & "NO" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " BORDER=" & Chr(34) & "NO" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " BORDERSTYLE=" & Chr(34) & "NORMAL" &
Chr(34) & ""
oBarCat.Add oBarCat.Count, " SYSMENU=" & Chr(34) & "NO" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " CONTEXTMENU=" & Chr(34) & "NO" & Chr(34)
& ""
oBarCat.Add oBarCat.Count, " SHOWINTASKBAR=" & Chr(34) & "NO" &
Chr(34) & ""
oBarCat.Add oBarCat.Count, " />"
oBarCat.Add oBarCat.Count, "<SCRIPT Language=" & Chr(34) & "VBScript" &
Chr(34) & ">"
oBarCat.Add oBarCat.Count, "Dim oShell, iTimer1, iTimer2,
sStatusBarAsciiText, sPID, iCID, sStatusMsg"
oBarCat.Add oBarCat.Count, "Set oShell = CreateObject(" & Chr(34) &
"Wscript.Shell" & Chr(34) & ")"
oBarCat.Add oBarCat.Count, "sPID = " & Chr(34) & "" & Chr(34) & ":iCID =
10"
oBarCat.Add oBarCat.Count, "Sub Window_Onload"
oBarCat.Add oBarCat.Count, " window.resizeTo 320,250"
oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) &
"Scripting.FileSystemObject" & Chr(34) & ").CreateTextFile(" & Chr(34) &
sProgressBarRunFile & Chr(34) & ")"
oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) &
"Scripting.FileSystemObject" & Chr(34) & ").CreateTextFile(" & Chr(34) &
sProgressBarSleepFile & Chr(34) & ")"
oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) &
"Scripting.FileSystemObject" & Chr(34) & ").OpenTextFile(" & Chr(34) &
sProgressBarSleepFile & Chr(34) & ",2).WriteLine " & Chr(34) &
"WScript.Sleep(1000)" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " iTimer1 = window.setInterval(" & Chr(34) &
"Do_Refresh" & Chr(34) & ",175)"
oBarCat.Add oBarCat.Count, " iTimer2 = window.setInterval(" & Chr(34) &
"Do_Nothing" & Chr(34) & ",500)"
oBarCat.Add oBarCat.Count, "End Sub"
oBarCat.Add oBarCat.Count, "Sub Do_Nothing"
oBarCat.Add oBarCat.Count, " If CreateObject(" & Chr(34) &
"Scripting.FileSystemObject" & Chr(34) & ").FileExists(" & Chr(34) &
sProgressBarRunFile & Chr(34) & ") Then"
oBarCat.Add oBarCat.Count, " Dim oWMIService, cItems, oItem"
oBarCat.Add oBarCat.Count, " Set oWMIService = GetObject(" & Chr(34) &
"winmgmts:.rootCIMV2" & Chr(34) & ")"
oBarCat.Add oBarCat.Count, " Set cItems = oWMIService.ExecQuery(" &
Chr(34) & "SELECT Name, ExecutablePath, CommandLine FROM Win32_Process
where Name = 'mshta.exe'" & Chr(34) & ")"
oBarCat.Add oBarCat.Count, " For Each oItem in cItems"
oBarCat.Add oBarCat.Count, " If oItem.CommandLine =
document.Location.pathname Then"
oBarCat.Add oBarCat.Count, " oShell.AppActivate oItem.Handle"
oBarCat.Add oBarCat.Count, " End If"
oBarCat.Add oBarCat.Count, " Next"
oBarCat.Add oBarCat.Count, " Else"
oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) &
"Scripting.FileSystemObject" & Chr(34) & ").DeleteFile " & Chr(34) &
sProgressBarSleepFile & Chr(34) & ", True "
oBarCat.Add oBarCat.Count, " window.clearInterval(iTimer1)"
oBarCat.Add oBarCat.Count, " window.clearInterval(iTimer2)"
oBarCat.Add oBarCat.Count, " self.Close"
oBarCat.Add oBarCat.Count, " End If"
oBarCat.Add oBarCat.Count, "End Sub"
oBarCat.Add oBarCat.Count, "Sub Do_Refresh"
oBarCat.Add oBarCat.Count, " Select Case iCID"
oBarCat.Add oBarCat.Count, " Case 10"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText =" & Chr(34) &
"ooooo" & Chr(34) & ":iCID = 0"
oBarCat.Add oBarCat.Count, " Case 0"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) &
"oooon" & Chr(34) & ":iCID = 1"
oBarCat.Add oBarCat.Count, " Case 1"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) &
"ooono" & Chr(34) & ":iCID = 2"
oBarCat.Add oBarCat.Count, " Case 2"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) &
"oonoo" & Chr(34) & ":iCID = 3"
oBarCat.Add oBarCat.Count, " Case 3"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) &
"onooo" & Chr(34) & ":iCID = 4"
oBarCat.Add oBarCat.Count, " Case 4"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) &
"noooo" & Chr(34) & ":iCID = 5"
oBarCat.Add oBarCat.Count, " Case 5"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) &
"onooo" & Chr(34) & ":iCID = 6"
oBarCat.Add oBarCat.Count, " Case 6"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) &
"oonoo" & Chr(34) & ":iCID = 7"
oBarCat.Add oBarCat.Count, " Case 7"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) &
"ooono" & Chr(34) & ":iCID = 8"
oBarCat.Add oBarCat.Count, " Case 8"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) &
"oooon" & Chr(34) & ":iCID = 1"
oBarCat.Add oBarCat.Count, " End Select "
oBarCat.Add oBarCat.Count, " Stats.innerHTML = sStatusBarAsciiText"
oBarCat.Add oBarCat.Count, " On Error Resume Next"
oBarCat.Add oBarCat.Count, " oShell.RegRead(" & Chr(34) &
"HKLMSYSTEMProgressBarMSG" & Chr(34) & ")"
oBarCat.Add oBarCat.Count, " iRegErr = Err.Number"
oBarCat.Add oBarCat.Count, " On Error Goto 0"
oBarCat.Add oBarCat.Count, " If iRegErr = 0 then"
oBarCat.Add oBarCat.Count, " sStatusMsg = Replace(oShell.RegRead(" &
Chr(34) & "HKLMSYSTEMProgressBarMSG" & Chr(34) & "), VbCrLf," & Chr(34)
& "<br>" & Chr(34) & ") "
oBarCat.Add oBarCat.Count, " Else"
oBarCat.Add oBarCat.Count, " sStatusMsg = " & Chr(34) & "" & Chr(34)
& ""
oBarCat.Add oBarCat.Count, " End if"
oBarCat.Add oBarCat.Count, " MyMsg.innerHTML = sStatusMsg"
oBarCat.Add oBarCat.Count, " End Sub"
oBarCat.Add oBarCat.Count, "</SCRIPT>"
oBarCat.Add oBarCat.Count, "<style>"
'start colors
oBarCat.Add oBarCat.Count, "body,td,a
{font-family:Arial;font-size:12px;text-decoration:none;color:black;}"
oBarCat.Add oBarCat.Count, "body
{filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0,
StartColorStr='#9999FF', EndColorStr='#FFFFFF')}"
'end colors
oBarCat.Add oBarCat.Count, ".pix {width: 1px; height 1px;}"
oBarCat.Add oBarCat.Count, "</style>"
oBarCat.Add oBarCat.Count, "</head>"
oBarCat.Add oBarCat.Count, "<body>"
oBarCat.Add oBarCat.Count, "<center>"
oBarCat.Add oBarCat.Count, "<table width=" & Chr(34) & "275" & Chr(34) &
">"
oBarCat.Add oBarCat.Count, " <tr><td>"
oBarCat.Add oBarCat.Count, " <fieldset><legend align=" & Chr(34) &
"center" & Chr(34) & "><b> Quelques instants svp </b></legend>"
oBarCat.Add oBarCat.Count, " <br><center>"
oBarCat.Add oBarCat.Count, " <span id= " & Chr(34) & "Stats" &
Chr(34) & " style=" & Chr(34) & "font-family: wingdings;font-weight:
bold;font-size:20px;" & Chr(34) & "></span>"
oBarCat.Add oBarCat.Count, " </center><br><br>"
oBarCat.Add oBarCat.Count, " </fieldset>"
oBarCat.Add oBarCat.Count, " </td></tr>"
oBarCat.Add oBarCat.Count, "</table>"
oBarCat.Add oBarCat.Count, "<span id= " & Chr(34) & "MyMsg" & Chr(34) & "
style=" & Chr(34) & "font-family: Ariel;font-size:12px;" & Chr(34) &
"></span>"
oBarCat.Add oBarCat.Count, "</body>"
oBarCat.Add oBarCat.Count, "</html>"
subWriteFile sProgressBarHTAFile, Join(oBarCat.Items,VbCrLf)
oShell.RegWrite "HKLMSYSTEMProgressBarMSG", sMessageToDisplay,
"REG_SZ"
oShell.Run sProgressBarHTAFile, 1, False
End Sub

Public Sub CloseBar()
fKillFile sProgressBarRunFile
Dim sProgressBarHTAFileKiller
subKillRegKey "HKLMSYSTEMProgressBar","DELETE"
sProgressBarHTAFileKiller = oFSO.GetDriveName(oEnv("TEMP")) &
"htakiller.vbs"
subWriteFile sProgressBarHTAFileKiller, "On Error Resume Next"
subWriteFile sProgressBarHTAFileKiller, "wscript.sleep(10000)"
subWriteFile sProgressBarHTAFileKiller, "Set oFSO =
CreateObject(""Scripting.FileSystemObject"")"
subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFile " & Chr(34) &
sProgressBarHTAFile & Chr(34) & ", True"
subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFolder " & Chr(34) &
oFSO.GetDriveName(oEnv("TEMP")) & "" & sInitialTempBuild & Chr(34) & ",
True"
subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFile " & Chr(34) &
sProgressBarHTAFileKiller & Chr(34) & ", True"
oShell.Run "%comspec% /c cscript.exe " & sProgressBarHTAFileKiller, 0,
False
End Sub

Public Sub SetLine(sNewText)
oShell.RegWrite "HKLMSYSTEMProgressBarMSG", sNewText, "REG_SZ"
End Sub

Private Function fGetTempName()
Dim iFilenameCharacters, iHighestASCiiValue, iLowestASCiiValue
Dim iCharASCiiValue, sTmpFileName, oTempNameDic
Set oTempNameDic = CreateObject("Scripting.Dictionary")
iFilenameCharacters = 8
iHighestASCiiValue = 126
iLowestASCiiValue = 46
sTmpFileName = ""
Randomize
Do
iCharASCiiValue = Int(((iHighestASCiiValue - iLowestASCiiValue + 1) *
Rnd) + iLowestASCiiValue)
Select Case True
Case iCharASCiiValue = 47
Case iCharASCiiValue > 57 And iCharASCiiValue < 95
Case iCharASCiiValue = 96
Case iCharASCiiValue > 122 And iCharASCiiValue < 126
Case Else
oTempNameDic.Add oTempNameDic.Count,Chr(iCharASCiiValue)
End Select
Loop While oTempNameDic.Count < iFilenameCharacters
fGetTempName = oEnv("TEMP") & "" & Join(oTempNameDic.Items,"") & ".tmp"
oTempNameDic.RemoveAll
End Function

Private Function fKillFile(sFileToKill)
Dim iErr, sErr
Select Case True
Case InStr(sFileToKill, "*") <> 0
If oFSO.FolderExists(oFSO.GetParentFolderName(sFileToKill)) Then
On Error Resume Next
oFSO.DeleteFile sFileToKill, True
iErr = Err.Number
sErr = Err.Description
On Error GoTo 0
If iErr = 53 Then iErr = 0
End If
Case oFSO.FileExists(sFileToKill)
On Error Resume Next
oFSO.DeleteFile sFileToKill, True
iErr = Err.Number
sErr = Err.Description
On Error GoTo 0
End Select
Select Case iErr
Case 0
fKillFile = 0
Case Else
fKillFile = sErr
End Select
End Function

Private Function fRand(iLowerLimit,iUpperLimit)
ExecuteGlobal "Dim bRandomized"
If bRandomized <> True Then Randomize
bRandomized = True
fRand = Int((iUpperLimit - iLowerLimit + 1)*Rnd() + iLowerLimit)
End Function

Private Sub subWriteFile(sFileToWrite, sTextToWrite)
Dim oFileToWrite
subCreateFile sFileToWrite
Set oFileToWrite = oFSO.OpenTextFile(sFileToWrite,8)
oFileToWrite.WriteLine sTextToWrite
oFileToWrite.Close
End Sub

Private Sub subCreateFile(sFileToCreate)
subCreateFolder oFSO.GetParentFolderName(sFileToCreate)
If Not oFSO.FileExists(sFileToCreate) Then
oFSO.CreateTextFile(sFileToCreate)
End Sub

Private Sub subCreateFolder(sFolderPathToCreate)
If Trim(sFolderPathToCreate) <> "" Then
If oFSO.FolderExists(sFolderPathToCreate) Then
Exit Sub
Else
subCreateFolder(oFSO.GetParentFolderName(sFolderPathToCreate))
End If
oFSO.CreateFolder(sFolderPathToCreate)
End If
End Sub

Private Sub subKillRegKey(ByVal sKeyToDelete, sDeleteConfirmation)
Dim aSubKeys, sSubKey, iSubkeyCheck, sKeyToKill, iElement
Dim aKeyPathSubSection, hKeyRoot, oWMIReg, sKeyRoot
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
If sDeleteConfirmation <> "DELETE" Then Exit Sub
aKeyPathSubSection = Split(sKeyToDelete, "")
Select Case UCase(aKeyPathSubSection(0))
Case "HKEY_CLASSES_ROOT", "HKCR"
hKeyRoot = HKEY_CLASSES_ROOT
sKeyRoot = "HKEY_CLASSES_ROOT"
Case "HKEY_CURRENT_USER", "HKCU"
hKeyRoot = HKEY_CURRENT_USER
sKeyRoot = "HKEY_CURRENT_USER"
Case "HKEY_LOCAL_MACHINE", "HKLM"
hKeyRoot = HKEY_LOCAL_MACHINE
sKeyRoot = "HKEY_LOCAL_MACHINE"
Case "HKEY_USERS", "HKU"
hKeyRoot = HKEY_USERS
sKeyRoot = "HKEY_USERS"
Case "HKEY_CURRENT_CONFIG"
hKeyRoot = HKEY_CURRENT_CONFIG
sKeyRoot = "HKEY_CURRENT_CONFIG"
Case Else
subKillRegKey = 1
Exit Sub
End Select
For iElement = 1 To UBound(aKeyPathSubSection)
sKeyToKill = sKeyToKill & "" & aKeyPathSubSection(iElement)
Next
If Left(sKeyToKill,1) = "" Then sKeyToKill = Right(sKeyToKill,
Len(sKeyToKill)-1)
On Error Resume Next
Set oWMIReg =
GetObject("winmgmts:{impersonationLevel=impersonate}!.rootdefault:StdRegProv")
iSubkeyCheck = oWMIReg.EnumKey(hKeyRoot, sKeyToKill, aSubKeys)
If iSubkeyCheck = 0 And IsArray(aSubKeys) Then
For Each sSubKey In aSubKeys
If Err.Number <> 0 Then
Err.Clear
Exit Sub
End If
subKillRegKey sKeyRoot & "" & sKeyToKill & "" & sSubKey, "DELETE"
Next
End If
oWMIReg.DeleteKey hKeyRoot, sKeyToKill
End Sub
End Class



Avatar
Blaise Cacramp
Bonjour ou bonsoir, selon.

Merci pour la suggestion : le script fonctionne en remplaçant HKCM par HKCU,
mais je dois attendre lundi pour pouvoir l'essayer au bureau


Cdt, Blaise
---- ---- ----


"Edreux (ILINFO)" a écrit dans le message de news:
%
Bonsoir,

je n'ai pas essayé votre script, mais vous pouvez essayer de lire / écrire
dans HKEY_CURRENT_USER au lieu de HKEY_LOCAL_MACHINE.
ca devrait régler votre problème d'accès à la base de registre:

oBarCat.Add oBarCat.Count, " sStatusMsg = Replace(oShell.RegRead(" &
Chr(34) & "HKLMSYSTEMProgressBarMSG" & Chr(34) & "), VbCrLf," & Chr(34)
&
"<br>" & Chr(34) & ") "

[...]
oShell.RegWrite "HKLMSYSTEMProgressBarMSG", sMessageToDisplay, "REG_SZ"
[...]

Cordialement,
Emmanuel Dreux
http://www.ilinfo.fr


"Blaise Cacramp" a écrit dans le message de
news:%
http://www.visualbasicscript.com/m_40519/mpage_1/key_/tm.htm#40519

Option Explicit

Dim oBar

Set oBar = New ProgressBar
oBar.StartBar "La mise à jour est en cours, veuillez patienter quelques
secondes."
WScript.Sleep (3000)
oBar.SetLine "So is this."
WScript.Sleep (3000)
oBar.CloseBar

Class ProgressBar
Dim oBarCat, sProgressBarHTAFile, sProgressBarRunFile,
sProgressBarSleepFile, sInitialTempBuild
Public Sub StartBar(sMessageToDisplay)
Dim sInitialTemp, i

ExecuteGlobal "Dim oShell, oFSO, oEnv"

Set oShell = CreateObject("Wscript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oEnv = oShell.Environment("Process")
For i = 1 To 16
sInitialTempBuild = sInitialTempBuild & Chr(fRand(97,122))
Next
sInitialTemp = oFSO.GetDriveName(oEnv("TEMP")) & "" & sInitialTempBuild
& "" & oFSO.GetFileName(fGetTempName)
sProgressBarHTAFile = Left(sInitialTemp,(Len(sInitialTemp)-4)) & ".hta"
sProgressBarRunFile = Left(sProgressBarHTAFile,
Len(sProgressBarHTAFile)-4) & ".run"
sProgressBarSleepFile = Left(sProgressBarHTAFile,
Len(sProgressBarHTAFile)-4) & "sleep.vbs"
Set oBarCat = CreateObject("Scripting.Dictionary")
oBarCat.Add oBarCat.Count, "<html>"
oBarCat.Add oBarCat.Count, "<head>"
oBarCat.Add oBarCat.Count, "<title id=" & Chr(34) & "title" & Chr(34) &
">Please Wait</title>"
oBarCat.Add oBarCat.Count, "<HTA:APPLICATION "
oBarCat.Add oBarCat.Count, " ID=" & Chr(34) & "StatusBar" & Chr(34) &
""
oBarCat.Add oBarCat.Count, " APPLICATIONNAME=" & Chr(34) &
"StatusBar" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " SCROLL=" & Chr(34) & "NO" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " SINGLEINSTANCE=" & Chr(34) & "YES" &
Chr(34) & ""
oBarCat.Add oBarCat.Count, " CAPTION=" & Chr(34) & "NO" & Chr(34) &
""
oBarCat.Add oBarCat.Count, " BORDER=" & Chr(34) & "NO" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " BORDERSTYLE=" & Chr(34) & "NORMAL" &
Chr(34) & ""
oBarCat.Add oBarCat.Count, " SYSMENU=" & Chr(34) & "NO" & Chr(34) &
""
oBarCat.Add oBarCat.Count, " CONTEXTMENU=" & Chr(34) & "NO" & Chr(34)
& ""
oBarCat.Add oBarCat.Count, " SHOWINTASKBAR=" & Chr(34) & "NO" &
Chr(34) & ""
oBarCat.Add oBarCat.Count, " />"
oBarCat.Add oBarCat.Count, "<SCRIPT Language=" & Chr(34) & "VBScript" &
Chr(34) & ">"
oBarCat.Add oBarCat.Count, "Dim oShell, iTimer1, iTimer2,
sStatusBarAsciiText, sPID, iCID, sStatusMsg"
oBarCat.Add oBarCat.Count, "Set oShell = CreateObject(" & Chr(34) &
"Wscript.Shell" & Chr(34) & ")"
oBarCat.Add oBarCat.Count, "sPID = " & Chr(34) & "" & Chr(34) & ":iCID =
10"
oBarCat.Add oBarCat.Count, "Sub Window_Onload"
oBarCat.Add oBarCat.Count, " window.resizeTo 320,250"
oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) &
"Scripting.FileSystemObject" & Chr(34) & ").CreateTextFile(" & Chr(34) &
sProgressBarRunFile & Chr(34) & ")"
oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) &
"Scripting.FileSystemObject" & Chr(34) & ").CreateTextFile(" & Chr(34) &
sProgressBarSleepFile & Chr(34) & ")"
oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) &
"Scripting.FileSystemObject" & Chr(34) & ").OpenTextFile(" & Chr(34) &
sProgressBarSleepFile & Chr(34) & ",2).WriteLine " & Chr(34) &
"WScript.Sleep(1000)" & Chr(34) & ""
oBarCat.Add oBarCat.Count, " iTimer1 = window.setInterval(" & Chr(34) &
"Do_Refresh" & Chr(34) & ",175)"
oBarCat.Add oBarCat.Count, " iTimer2 = window.setInterval(" & Chr(34) &
"Do_Nothing" & Chr(34) & ",500)"
oBarCat.Add oBarCat.Count, "End Sub"
oBarCat.Add oBarCat.Count, "Sub Do_Nothing"
oBarCat.Add oBarCat.Count, " If CreateObject(" & Chr(34) &
"Scripting.FileSystemObject" & Chr(34) & ").FileExists(" & Chr(34) &
sProgressBarRunFile & Chr(34) & ") Then"
oBarCat.Add oBarCat.Count, " Dim oWMIService, cItems, oItem"
oBarCat.Add oBarCat.Count, " Set oWMIService = GetObject(" & Chr(34) &
"winmgmts:.rootCIMV2" & Chr(34) & ")"
oBarCat.Add oBarCat.Count, " Set cItems = oWMIService.ExecQuery(" &
Chr(34) & "SELECT Name, ExecutablePath, CommandLine FROM Win32_Process
where Name = 'mshta.exe'" & Chr(34) & ")"
oBarCat.Add oBarCat.Count, " For Each oItem in cItems"
oBarCat.Add oBarCat.Count, " If oItem.CommandLine =
document.Location.pathname Then"
oBarCat.Add oBarCat.Count, " oShell.AppActivate oItem.Handle"
oBarCat.Add oBarCat.Count, " End If"
oBarCat.Add oBarCat.Count, " Next"
oBarCat.Add oBarCat.Count, " Else"
oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) &
"Scripting.FileSystemObject" & Chr(34) & ").DeleteFile " & Chr(34) &
sProgressBarSleepFile & Chr(34) & ", True "
oBarCat.Add oBarCat.Count, " window.clearInterval(iTimer1)"
oBarCat.Add oBarCat.Count, " window.clearInterval(iTimer2)"
oBarCat.Add oBarCat.Count, " self.Close"
oBarCat.Add oBarCat.Count, " End If"
oBarCat.Add oBarCat.Count, "End Sub"
oBarCat.Add oBarCat.Count, "Sub Do_Refresh"
oBarCat.Add oBarCat.Count, " Select Case iCID"
oBarCat.Add oBarCat.Count, " Case 10"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText =" & Chr(34) &
"ooooo" & Chr(34) & ":iCID = 0"
oBarCat.Add oBarCat.Count, " Case 0"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) &
"oooon" & Chr(34) & ":iCID = 1"
oBarCat.Add oBarCat.Count, " Case 1"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34)
& "ooono" & Chr(34) & ":iCID = 2"
oBarCat.Add oBarCat.Count, " Case 2"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34)
& "oonoo" & Chr(34) & ":iCID = 3"
oBarCat.Add oBarCat.Count, " Case 3"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34) &
"onooo" & Chr(34) & ":iCID = 4"
oBarCat.Add oBarCat.Count, " Case 4"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34)
& "noooo" & Chr(34) & ":iCID = 5"
oBarCat.Add oBarCat.Count, " Case 5"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34)
& "onooo" & Chr(34) & ":iCID = 6"
oBarCat.Add oBarCat.Count, " Case 6"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34)
& "oonoo" & Chr(34) & ":iCID = 7"
oBarCat.Add oBarCat.Count, " Case 7"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34)
& "ooono" & Chr(34) & ":iCID = 8"
oBarCat.Add oBarCat.Count, " Case 8"
oBarCat.Add oBarCat.Count, " sStatusBarAsciiText = " & Chr(34)
& "oooon" & Chr(34) & ":iCID = 1"
oBarCat.Add oBarCat.Count, " End Select "
oBarCat.Add oBarCat.Count, " Stats.innerHTML = sStatusBarAsciiText"
oBarCat.Add oBarCat.Count, " On Error Resume Next"
oBarCat.Add oBarCat.Count, " oShell.RegRead(" & Chr(34) &
"HKLMSYSTEMProgressBarMSG" & Chr(34) & ")"
oBarCat.Add oBarCat.Count, " iRegErr = Err.Number"
oBarCat.Add oBarCat.Count, " On Error Goto 0"
oBarCat.Add oBarCat.Count, " If iRegErr = 0 then"
oBarCat.Add oBarCat.Count, " sStatusMsg = Replace(oShell.RegRead("
& Chr(34) & "HKLMSYSTEMProgressBarMSG" & Chr(34) & "), VbCrLf," &
Chr(34) & "<br>" & Chr(34) & ") "
oBarCat.Add oBarCat.Count, " Else"
oBarCat.Add oBarCat.Count, " sStatusMsg = " & Chr(34) & "" &
Chr(34) & ""
oBarCat.Add oBarCat.Count, " End if"
oBarCat.Add oBarCat.Count, " MyMsg.innerHTML = sStatusMsg"
oBarCat.Add oBarCat.Count, " End Sub"
oBarCat.Add oBarCat.Count, "</SCRIPT>"
oBarCat.Add oBarCat.Count, "<style>"
'start colors
oBarCat.Add oBarCat.Count, "body,td,a
{font-family:Arial;font-size:12px;text-decoration:none;color:black;}"
oBarCat.Add oBarCat.Count, "body
{filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0,
StartColorStr='#9999FF', EndColorStr='#FFFFFF')}"
'end colors
oBarCat.Add oBarCat.Count, ".pix {width: 1px; height 1px;}"
oBarCat.Add oBarCat.Count, "</style>"
oBarCat.Add oBarCat.Count, "</head>"
oBarCat.Add oBarCat.Count, "<body>"
oBarCat.Add oBarCat.Count, "<center>"
oBarCat.Add oBarCat.Count, "<table width=" & Chr(34) & "275" & Chr(34) &
">"
oBarCat.Add oBarCat.Count, " <tr><td>"
oBarCat.Add oBarCat.Count, " <fieldset><legend align=" & Chr(34) &
"center" & Chr(34) & "><b> Quelques instants svp </b></legend>"
oBarCat.Add oBarCat.Count, " <br><center>"
oBarCat.Add oBarCat.Count, " <span id= " & Chr(34) & "Stats" &
Chr(34) & " style=" & Chr(34) & "font-family: wingdings;font-weight:
bold;font-size:20px;" & Chr(34) & "></span>"
oBarCat.Add oBarCat.Count, " </center><br><br>"
oBarCat.Add oBarCat.Count, " </fieldset>"
oBarCat.Add oBarCat.Count, " </td></tr>"
oBarCat.Add oBarCat.Count, "</table>"
oBarCat.Add oBarCat.Count, "<span id= " & Chr(34) & "MyMsg" & Chr(34) &
" style=" & Chr(34) & "font-family: Ariel;font-size:12px;" & Chr(34) &
"></span>"
oBarCat.Add oBarCat.Count, "</body>"
oBarCat.Add oBarCat.Count, "</html>"
subWriteFile sProgressBarHTAFile, Join(oBarCat.Items,VbCrLf)
oShell.RegWrite "HKLMSYSTEMProgressBarMSG", sMessageToDisplay,
"REG_SZ"
oShell.Run sProgressBarHTAFile, 1, False
End Sub

Public Sub CloseBar()
fKillFile sProgressBarRunFile
Dim sProgressBarHTAFileKiller
subKillRegKey "HKLMSYSTEMProgressBar","DELETE"
sProgressBarHTAFileKiller = oFSO.GetDriveName(oEnv("TEMP")) &
"htakiller.vbs"
subWriteFile sProgressBarHTAFileKiller, "On Error Resume Next"
subWriteFile sProgressBarHTAFileKiller, "wscript.sleep(10000)"
subWriteFile sProgressBarHTAFileKiller, "Set oFSO =
CreateObject(""Scripting.FileSystemObject"")"
subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFile " & Chr(34) &
sProgressBarHTAFile & Chr(34) & ", True"
subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFolder " & Chr(34) &
oFSO.GetDriveName(oEnv("TEMP")) & "" & sInitialTempBuild & Chr(34) & ",
True"
subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFile " & Chr(34) &
sProgressBarHTAFileKiller & Chr(34) & ", True"
oShell.Run "%comspec% /c cscript.exe " & sProgressBarHTAFileKiller, 0,
False
End Sub

Public Sub SetLine(sNewText)
oShell.RegWrite "HKLMSYSTEMProgressBarMSG", sNewText, "REG_SZ"
End Sub

Private Function fGetTempName()
Dim iFilenameCharacters, iHighestASCiiValue, iLowestASCiiValue
Dim iCharASCiiValue, sTmpFileName, oTempNameDic
Set oTempNameDic = CreateObject("Scripting.Dictionary")
iFilenameCharacters = 8
iHighestASCiiValue = 126
iLowestASCiiValue = 46
sTmpFileName = ""
Randomize
Do
iCharASCiiValue = Int(((iHighestASCiiValue - iLowestASCiiValue + 1) *
Rnd) + iLowestASCiiValue)
Select Case True
Case iCharASCiiValue = 47
Case iCharASCiiValue > 57 And iCharASCiiValue < 95
Case iCharASCiiValue = 96
Case iCharASCiiValue > 122 And iCharASCiiValue < 126
Case Else
oTempNameDic.Add oTempNameDic.Count,Chr(iCharASCiiValue)
End Select
Loop While oTempNameDic.Count < iFilenameCharacters
fGetTempName = oEnv("TEMP") & "" & Join(oTempNameDic.Items,"") & ".tmp"
oTempNameDic.RemoveAll
End Function

Private Function fKillFile(sFileToKill)
Dim iErr, sErr
Select Case True
Case InStr(sFileToKill, "*") <> 0
If oFSO.FolderExists(oFSO.GetParentFolderName(sFileToKill)) Then
On Error Resume Next
oFSO.DeleteFile sFileToKill, True
iErr = Err.Number
sErr = Err.Description
On Error GoTo 0
If iErr = 53 Then iErr = 0
End If
Case oFSO.FileExists(sFileToKill)
On Error Resume Next
oFSO.DeleteFile sFileToKill, True
iErr = Err.Number
sErr = Err.Description
On Error GoTo 0
End Select
Select Case iErr
Case 0
fKillFile = 0
Case Else
fKillFile = sErr
End Select
End Function

Private Function fRand(iLowerLimit,iUpperLimit)
ExecuteGlobal "Dim bRandomized"
If bRandomized <> True Then Randomize
bRandomized = True
fRand = Int((iUpperLimit - iLowerLimit + 1)*Rnd() + iLowerLimit)
End Function

Private Sub subWriteFile(sFileToWrite, sTextToWrite)
Dim oFileToWrite
subCreateFile sFileToWrite
Set oFileToWrite = oFSO.OpenTextFile(sFileToWrite,8)
oFileToWrite.WriteLine sTextToWrite
oFileToWrite.Close
End Sub

Private Sub subCreateFile(sFileToCreate)
subCreateFolder oFSO.GetParentFolderName(sFileToCreate)
If Not oFSO.FileExists(sFileToCreate) Then
oFSO.CreateTextFile(sFileToCreate)
End Sub

Private Sub subCreateFolder(sFolderPathToCreate)
If Trim(sFolderPathToCreate) <> "" Then
If oFSO.FolderExists(sFolderPathToCreate) Then
Exit Sub
Else
subCreateFolder(oFSO.GetParentFolderName(sFolderPathToCreate))
End If
oFSO.CreateFolder(sFolderPathToCreate)
End If
End Sub

Private Sub subKillRegKey(ByVal sKeyToDelete, sDeleteConfirmation)
Dim aSubKeys, sSubKey, iSubkeyCheck, sKeyToKill, iElement
Dim aKeyPathSubSection, hKeyRoot, oWMIReg, sKeyRoot
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
If sDeleteConfirmation <> "DELETE" Then Exit Sub
aKeyPathSubSection = Split(sKeyToDelete, "")
Select Case UCase(aKeyPathSubSection(0))
Case "HKEY_CLASSES_ROOT", "HKCR"
hKeyRoot = HKEY_CLASSES_ROOT
sKeyRoot = "HKEY_CLASSES_ROOT"
Case "HKEY_CURRENT_USER", "HKCU"
hKeyRoot = HKEY_CURRENT_USER
sKeyRoot = "HKEY_CURRENT_USER"
Case "HKEY_LOCAL_MACHINE", "HKLM"
hKeyRoot = HKEY_LOCAL_MACHINE
sKeyRoot = "HKEY_LOCAL_MACHINE"
Case "HKEY_USERS", "HKU"
hKeyRoot = HKEY_USERS
sKeyRoot = "HKEY_USERS"
Case "HKEY_CURRENT_CONFIG"
hKeyRoot = HKEY_CURRENT_CONFIG
sKeyRoot = "HKEY_CURRENT_CONFIG"
Case Else
subKillRegKey = 1
Exit Sub
End Select
For iElement = 1 To UBound(aKeyPathSubSection)
sKeyToKill = sKeyToKill & "" & aKeyPathSubSection(iElement)
Next
If Left(sKeyToKill,1) = "" Then sKeyToKill = Right(sKeyToKill,
Len(sKeyToKill)-1)
On Error Resume Next
Set oWMIReg =
GetObject("winmgmts:{impersonationLevel=impersonate}!.rootdefault:StdRegProv")
iSubkeyCheck = oWMIReg.EnumKey(hKeyRoot, sKeyToKill, aSubKeys)
If iSubkeyCheck = 0 And IsArray(aSubKeys) Then
For Each sSubKey In aSubKeys
If Err.Number <> 0 Then
Err.Clear
Exit Sub
End If
subKillRegKey sKeyRoot & "" & sKeyToKill & "" & sSubKey, "DELETE"
Next
End If
oWMIReg.DeleteKey hKeyRoot, sKeyToKill
End Sub
End Class






Avatar
Christophe RIT [MS]
Bonsoir,

Pourquoi ne pas cascader les scprits ? Par exemple :


Dim objShell, oExec, strCmd
Set objShell = CreateObject("WScript.Shell")


strcmd = "cscript test.vbs"
Set oExec = objShell.Exec(strCmd)

Do While oExec.Status = 0
' Attend la sortie du script test
WScript.Sleep 10
Loop

Une idée à prendre où à laisser qui m'est venue en 10 min :) Je vous laisse
juge de son application.

HTH,
C.


"Blaise Cacramp" wrote in message
news:%
Bonjour ou bonsoir, selon.

Je cherche pour un script VBS un moyen pour faire patienter un utilisateur
lors d'une opération qui prend un certain temps (en l'occurence un mise à
jour).
Je pense au pointeur "hourglass" ou à un message sans devoir cliquer sur
un "Ok".

J'ai trouvé un magnifique code (que je place plus loin dans le fil) qui
fonctionne parfaitement, sauf sur les postes de travail où l'utisateur n'a
pas le droit de modifier la base de registre.
Ce code n'est pas documenté / commenté.

Pouvez-vous m'aider, un grand merci

Literal translation (google)
--------------------
Hello or good, depending.

I'm looking for a VBS script to wait a user during an operation which
takes some time (in this case an update).
I think the pointer "hourglass" or to a message without having to click on
OK.

I found a wonderful code (which I place later in the thread) which works
perfectly, except for jobs where utisateur has no right to modify the
registry.
This code is not documented / commented.

Can you help me, thank you

Cdt, Blaise
---- ---- ----





Avatar
Blaise Cacramp
Merci, cela fonctionne à moitié. Mais comme j'ai une autre voie plus simple
qui fonctionne.

Merci encore
Avatar
tiab
Christophe RIT [MS] a écrit le 17/01/2009 à 19h20 :
Bonsoir,

Pourquoi ne pas cascader les scprits ? Par exemple :


Dim objShell, oExec, strCmd
Set objShell = CreateObject("WScript.Shell")


strcmd = "cscript test.vbs"
Set oExec = objShell.Exec(strCmd)

Do While oExec.Status = 0
' Attend la sortie du script test
WScript.Sleep 10
Loop

Une idée à prendre où à laisser qui m'est venue en
10 min :) Je vous laisse
juge de son application.

HTH,
C.


"Blaise Cacramp" wrote in message
news:%
Bonjour ou bonsoir, selon.

Je cherche pour un script VBS un moyen pour faire patienter un utilisateur
lors d'une opération qui prend un certain temps (en l'occurence un mise
à
jour).
Je pense au pointeur "hourglass" ou à un message sans devoir
cliquer sur
un "Ok".

J'ai trouvé un magnifique code (que je place plus loin dans le fil) qui
fonctionne parfaitement, sauf sur les postes de travail où l'utisateur
n'a
pas le droit de modifier la base de registre.
Ce code n'est pas documenté / commenté.

Pouvez-vous m'aider, un grand merci

Literal translation (google)
--------------------
Hello or good, depending.

I'm looking for a VBS script to wait a user during an operation which
takes some time (in this case an update).
I think the pointer "hourglass" or to a message without having to
click on
OK.

I found a wonderful code (which I place later in the thread) which works
perfectly, except for jobs where utisateur has no right to modify the
registry.
This code is not documented / commented.

Can you help me, thank you

Cdt, Blaise
---- ---- ----








j'ai le même problème la solution c'est

iMainDelay = "120"
Set WshShell = WScript.CreateObject("WScript.Shell" )
wScript.Sleep(iMainDelay * 100)

à placer juste après ta déclaration de variable et tu mets le temps qu'il faut.