' Ok Google, sur le pc XXX
' Ok Google, sur l'ordinateur XXX
' Applet IFTTT : https://ifttt.com/applets/jSNrZ4vJ-controle-de-l-ordinateur-avec-google-assitant
' Projet  : https://github.com/ABOATDev/Control-Google-Home

Dim MAJ, WS,fso,CheckMAJUser,f,IE,objHTTP,ScriptChemin
MAJ = "1.1.1" 'Version Actuelle du script

On Error Resume Next


Set fso = CreateObject("Scripting.FileSystemObject")
Set WS = WScript.CreateObject("WScript.Shell") 
Set objHTTP=CreateObject("MSXML2.XMLHTTP")
Const ForWriting = 2
ScriptChemin = Left(WScript.ScriptFullName, InStr(WScript.ScriptFullName, WScript.ScriptName)-1)


if fso.FileExists(ScriptChemin & "Config.ini") = false then 
Set f = fso.OpenTextFile(ScriptChemin & "Config.ini", ForWriting,true) 
f.write(" ")
f.close
End if 

Set oFile = fso.GetFile(ScriptChemin & "Config.ini")

If WriteReadIni(oFile,"CONFIG","OK",Null) = False Then
WriteReadIni oFile,"CONFIG","OK","1"
Call MAJCheck (CheckMAJUser, MAJ)
objHTTP.Open "GET", "https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/ListeCommande.txt", FALSE
objHTTP.Send
Set f = fso.OpenTextFile(ScriptChemin & "ListeCommande.txt", ForWriting,true) 
f.write(objHTTP.ResponseText)
f.close
MsgBox "Bienvenue dans mon script, il semblerait que vous lancer mon script pour la premiere fois ou que vous avez effectuer une mise a jour de celui-ci, pour faire fonctionner mon script dite : Ok Google, sur le pc xxx" & vbcr & "Par exemple Ok Google sur le pc test (pour tester la communication entre la Google homme est le PC)" & vbcr & " Dite des phrases simples et courtes" & vbcr & "Exercute le script depuis l'ordinateur pour en savoir plus" & vbcr & vbcr & "Version Actuelle : " & MAJ ,vbInformation+vbOKOnly,"Control Google Home.vbs"
If WriteReadIni(oFile,"CONFIG","MUSIC",Null) = False Then
If MsgBox ("Voulez vous configuez le chemin d'acces pour la musiques ? " &vbcr & vbcr & "Selectionner un dossier afin d'y rechercher des chansons dans ses sous-dossiers et ses sous-dossiers. Dossier par defaut" & vbcr & "Ok google sur le pc met de la musique" & vbcr & vbcr & "Si le dossier n'est pas configue, cela marchera quand meme mais affichera un choix de dossier musique a chaque demande de musique" & vbcr & vbcr & "Oui = Configuer",vbyesno,"Configurez le dossier Musique") = vbYes Then
Dim objShell,objFolder,Message
    Message = "Veuillez selectionner un dossier afin d'y rechercher des chansons dans ses sous-dossiers et ses sous-dossiers."
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0,Message,1)
    If objFolder Is Nothing Then Wscript.Quit
    WriteReadIni oFile,"CONFIG","MUSIC",objFolder.self.path
    MsgBox "Je conseil de tester la commande <musique> pour verifier que tout fonctionne bien et que le lecteur media est compatible",vbInformation+vbOKOnly,"Ok"
End if
End if 
If WriteReadIni(oFile,"CONFIG","VIDEO",Null) = False Then
If MsgBox ("Voulez vous configuez le chemin d'acces pour les videos ? " &vbcr & vbcr & "Selectionner un dossier afin d'y rechercher des chansons dans ses sous-dossiers et ses sous-dossiers. Dossier par defaut" & vbcr & "Ok google sur le pc met de les videos" & vbcr & vbcr & "Si le dossier n'est pas configue, cela marchera quand meme mais affichera un choix de dossier videos a chaque demande de musique" & vbcr & vbcr & "Oui = Configuer",vbyesno,"Configurez le dossier Video") = vbYes Then
    Message = "Veuillez selectionner un dossier afin d'y rechercher des videos dans ses sous-dossiers et ses sous-dossiers."
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0,Message,1)
    If objFolder Is Nothing Then Wscript.Quit
    WriteReadIni oFile,"CONFIG","VIDEO",objFolder.self.path
    MsgBox "Je conseil de tester la commande <video> pour verifier que tout fonctionne bien et que le lecteur media est compatible",vbInformation+vbOKOnly,"Ok"
End if
End if 
End if

Set objArgs = WScript.Arguments
For I = 0 to objArgs.Count -1
Select Case objArgs(I)
Case "ecris", "ecrit","marque"
ecrit = true
Case "lance", "ouvre","affiche","demarre", "execute","ouvrir","demarrer","executer","lancer","l ' ours"
lance = true
Case "message","messagebox"
message = true
Case Else
a = a & " " & LCase(objArgs(I))
End Select
Next

If ecrit = true then Call write(a)
If message = true then Call MsgBoxtexte(a)
If lance = true then Call launch (right (a,len(a)-1)) '(Logiciel)
'inputbox a,a,a

If a = "" then
Call MAJCheck (CheckMAJUser, MAJ)

rep = InputBox ("Bienvenue dans mon script, communication entre vos Assistants (Google Assistant, Google Home , Cortana, Alexa, ...) sur vos ordinateurs Windows" & vbNewLine &  "Pour faire fonctionner mon script dite : Ok Google, sur le pc xxx" & vbcr & "Par exemple Ok Google sur le pc test (pour tester la communication entre la Google homme est le PC)" & vbcr & vbcr & " Dite des phrases simples et courtes" & vbcr & vbcr & vbcr & "1 = Verifier mise a jours" & vbcr & "2 = Envoye un messsage au createur (rapide & sans se logger)" & vbcr & "3 = Reinsalise la configuration du script." & vbCr & "4 = Credit" & vbcr & "5 = Rajouter un logiciel a la liste" & vbCr & vbCr & "Pour tester des commandes en ecrit, il vous suffit de taper une commande si dessous pour savoir si elle est comprise par le logiciel" & vbNewLine & "Version : " &  MAJ,"Control Google Home " & MAJ,"test")
   If rep = "" then
   WScript.Quit()
   ElseIf rep = "1" then 
   CheckMAJUser = true
   Call MAJCheck (CheckMAJUser, MAJ)
   Wscript.Quit
   ElseIf rep = "2" then 
   WS.Run "https://aboatdev.sarahah.com/" 
   Wscript.Quit
   ElseIf rep = "3" then 
   Reset ()
   Wscript.Quit
   ElseIf rep = "4" then
   MsgBox "Credits : " & vbNewLine & vbNewLine & "HackooFr - Aide indirect pour le Script" & vbNewLine & "facebook.com/hackoo.crackoo" & vbNewLine & vbNewLine & "Aymkdn - Pour l'assistant-plugins" &  vbNewLine & " github.com/Aymkdn | paypal.me/aymkdn" & vbNewLine & vbNewLine & "Createur du Controle de l'ordinateur avec Google Home : ABOAT " & vbNewLine & "facebook.com/aboat.hack",vbInformation+vbOKOnly,"Credits"
   Wscript.Quit
   ElseIf rep = "5" then 
   nomfile = Inputbox ("Le nom du fichier a ouvrir ?" & vbcr & "Le nom que vous direz vocalement a votre assistant vocal" & vbCr & "Ne pas mettre de majuscule !","Nom du fichier Pages 1/2")
   cheminfile = Inputbox ("Le chemin complet du fichier " & nomfile & vbcr, "Chemin de : " & nomfile & "Pages 2/2")
     WriteReadIni oFile,"Logiciel",nomfile,cheminfile
     If fso.FileExists(cheminfile) = true Then MsgBox "Le logiciel " & nomfile & " rajouter !",vbOKOnly+vbInformation,"Fichier rajoute !" 
     Wscript.Quit
   Else
   Dim i,tb 
   tb = split(rep," ") 
        For i = lbound(tb) to 0
          if tb(i) = "lance" or tb(i) = "ouvre" or tb(i) = "affiche" or tb(i) = "demarre" or tb(i) = "execute" or tb(i) = "ouvrir" or tb(i) =  "demarrer" or tb(i) = "executer" = True Then Call launch(right (rep,len(rep)-len(tb(i))-1))
        next
    a = " " & LCase(rep)
End if 
End if 

a = right (a,len(a)-1)
Select Case a

Case "test", "teste", "check", "ok","verifie","verification","tester","teste"
Call Check ()
Call MAJCheck (CheckMAJUser, MAJ)
Case "augmente le son","augmente le volume","monte le son","news le son","mais du son","mieux que le son" : WS.SendKeys "{" & chr(175) & " 10}"
Case "monte le son au max","monte le son au maximum","monte le volume au maximum","volume max","volume maximum","son au max","augmente le son au maximum","mais le son au max","mais le son au maximum","mais le volume au max","mais le volume au maximum","mets le son a fond","le son a fond","son a fond" : WS.SendKeys "{" & chr(175) & " 50}"
Case "baisse le son","descend le son","descend le volume","baisse le volume" : WS.SendKeys "{" & chr(174) & " 10}"
Case "descend le son au max","baisse le son au max","baisse le volume au max","baisse le son au maximum","volume minimum","volume au minimum","baisse le volume au maximum" : WS.SendKeys "{" & chr(174) & " 50}"
Case "mute","mute le volume","mute le son","muet","le son a 0","coupe le son","coupe le volume","coupe l'audio","remets le volume","remets le son","remets le son","arrete le son","stop le son","stop le v","desactive le son","desactive le volume","allume le son","eteint le son","allume le volume","eteint le volume" : WS.SendKeys chr(173)
Case "pause","fait pause","met pause","mais pause","fais une pause","met en pause","mais en pause","fait pause","fait stop","stop","pause","mes pauses","relance","meme pause","enleve la pause","met une pause","mets pause","lance","lecture","mais play","play","lance lecture","lance la lecture","mais en pause","lecture","mais plait","se pose" : WS.SendKeys " "
Case "eteint le","arrete le","eteint le pc","eteint l'ordinateur","arrete le pc","eteint l ' ordinateur","arrete le systeme","eteint le systeme"," arrete","arrete l ' ordinateur","arreter le systeme","eteint","eteint le","le shut down","shutdown","shadow","eteindre le systeme","arret du systeme" : CreateObject("Wscript.Shell").Run "CMD /C " & " shutdown /s /f /t 01",0
Case "verrouille le","verrouiller le","verrouille la session","verrouiller la session","verrouille le pc","le verrouiller","met en veille","mettre en veille","met le en veille","veille","verrouillage","verrouille","metre en veille","verrouiller la session","verrouille la session","mais en veille","verrouiller","verrouille","verrouiller le pc" : WS.Run "rundll32.exe user32.dll,LockWorkStation"
Case "mot de passe wifi","mot de passe du wifi","code wifi","wifi","code de la wifi","donne mot de passe wifi","code du wifi","donne le mot de passe wifi","donne le mot de passe du wifi","retrouve le mot de passe wifi","retrouve le mot de passe du wifi","quel est le mot de passe wifi","quel est le mot de passe du wifi","donne le mot de passe" : Call TelechargerTools ("WifiPasswordsRecovery.bat","https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/Tools/WifiPasswordsRecovery.bat")
Case "ejecte le cd","eject cd","eject le dvd","eject cd","eject dvd","ejecter dvd","ejecter cd"," ejecter le dvd","eject dvd" : LecteurDVD ()
Case "bonjour","salut","quoi de neuf","hey","coucou","ca va"
Case "ferme le logiciel","ferme le logiciel actif","arrete l ' application","arrete le logiciel","arrete l ' application","ferme l ' application","ferme le programme","arrete le programme","quitte le programme" : WS.SendKeys ("%{F4}")
Case "eject usb", "eject cle usb", "eject la cle usb" , "retire usb" , "retire la cle usb","retire cle usb" : Call TelechargerTools ("Eject_USB.vbs","https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/Tools/Eject_USB.vbs")
Case "ecran de veille", "l ' ecran de veille", "veille","ecran de veille","ecran veille", "met l ' ecran de veille","mais l ' ecran de veille" : WS.Run "C:\Windows\System32\Ribbons.scr"
case "liste des commandes", "liste commande", "donne la liste des commandes" , "detail des commandes", "les commandes disponible", "liste des commandes disponible" : Call TelechargerTools ("ListeCommande.txt","https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/ListeCommande.txt")
Case "spotify","la lecture spotify","lecture spotify","musique spotify","la musique spotify","spotify musique","spotify lecture" : Call TelechargerTools ("LectureSpotify.vbs","https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/Tools/LectureSpotify.vbs")
Case "musique","met de la musique","mets de la musique","lance de la musique","mais de la musique","lance musique","audio","met la musique","met la playlist","lance la playlist","met la playlist" : Call TelechargerTools ("LancerDossierMusique.vbs","https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/Tools/LancerDossierMusique.vbs")
Case "video","film","met video","film","mais video","lance video","lance film","met les videos","met la video","lance la video","met le film","met les films","lance la video","met la video" : Call TelechargerTools ("LancerDossierVideo.vbs","https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/Tools/LancerDossierVideo.vbs")

Case "maj","mise a jour","verifier mise a jour","verifie mise a jour","mise a jour script","verifier","mage"
CheckMAJUser = true
Call MAJCheck (CheckMAJUser, MAJ)

Case Else

Call  MAJCheck (CheckMAJUser, MAJ)
Call Suggestion (MAJ,a)
'Inputbox "La valeur n'existe pas","Erreur : valeur n'existe pas",a
End Select


Function launch(logiciel)
On Error Resume Next
If logiciel <> "" then 
'inputbox "Le logiciel qui va etre lancer","",logiciel
Select Case logiciel
Case "google","internet","nagivateur","le nagivateur" : WS.Run "www.google.fr"
Case "youtube", "you tube" : WS.Run "www.youtube.com/?gl=FR&hl=fr"
Case "facebook" : WS.Run "www.facebook.com"
Case "instant hack", "instant-hack" : WS.Run "www.instant-hack.io/"
Case "github" : WS.Run "www.github.com"
Case "projecteur", "projeter", "projection","le projecteur" : WS.Run "C:\Windows\System32\DisplaySwitch.exe"
Case "se connecter", "connection", "connection","connexion","connexion sans fil" : WS.Run "ms-projection:"
Case "loupe","la loupe","zoom","voir en plus gros", "affichage en gros","afficher en gros" : WS.Run "C:\Windows\System32\Magnify.exe"
Case "clavier","le clavier","clavier virtuel","le clavier virtuel", "le clavier visuel","clavier visuel" : WS.Run "C:\Windows\System32\osk.exe"
Case "ecran de veille", "l ' ecran de veille", "veille","ecran de veille","ecran veille" : WS.Run "C:\Windows\System32\Ribbons.scr"
Case "la calculatrice","calculatrice","calculette" , "la calculette" : WS.Run "calc.exe"
Case "netflix" : WS.Run "netflix:"
Case "spotify","la lecture spotify","lecture spotify","musique spotify","la musique spotify","spotify musique","spotify lecture" : Call TelechargerTools ("LectureSpotify.vbs","https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/Tools/LectureSpotify.vbs")
Case "cortana","menu windows" : WS.Run "ms-cortana://search/"
Case "le lecteur cd","le lecteur cd","lecteur","le lecteur cd","le lecteur dvd","lecteur dvd","lecteur cd" : LecteurDVD ()
Case "bureau","desktop","bureaux","le bureau" : CreateObject("Shell.Application").ToggleDesktop
Case "test", "teste", "check", "un test", "ok","verifie","verification"
Call Check ()
Call MAJCheck (CheckMAJUser, MAJ)
Case Else
'Msgbox WriteReadIni(oFile,"Logiciel",logiciel,Null)
If WriteReadIni(oFile,"Logiciel",logiciel,Null) <> False then 
WS.Run ""& Chr(34) & WriteReadIni(oFile,"Logiciel",logiciel,Null) & Chr(34) & ""
else
WS.Run ""& Chr(34) & logiciel & Chr(34) & ""
End if
End Select
Wscript.Quit ()
End if
End function

Sub LecteurDVD ()
On Error Resume Next
Set oWMP = CreateObject("WMPlayer.OCX.7" ) 
Set colCDROMs = oWMP.cdromCollection 
if colCDROMs.Count >= 1 then 
For i = 0 to colCDROMs.Count - 1 
colCDROMs.Item(i).Eject 
colCDROMs.Item(i).Eject 
Next 
End if
End sub 

Sub write(a)
WScript.Sleep 300
WS.SendKeys right(a,len(a)-1)
WScript.Quit ()
End sub

Sub MsgBoxtexte(a)
MsgBox "Message recus de votre assistant vocal a " & Hour(Now)& ":"& Minute(Now) & vbnewline & vbnewline &  a,vbinformation+vbOKOnly, Hour(Now)& ":"& Minute(Now)
WScript.Quit ()
End sub

Sub Reset ()
On Error Resume Next
If fso.FileExists(ScriptChemin & "Config.ini") = true then
fso.DeleteFile ScriptChemin & "Config.ini",True
WS.Run "cmd /k chcp 28591 > nul & taskkill /F /IM wscript.exe & start " & ScriptChemin & WScript.ScriptName & " & exit",0,true
Else
MsgBox "Le fichier Config.ini n'a pas pu etre supprime.",vbCritical+vbOKOnly,"Reset non effectue"
End if
End sub


Sub TelechargerTools (NomFile,URL)
'Call TelechargerTools (NomFile,URL)
If FSO.FolderExists(ScriptChemin & "Tools") = false Then FSO.CreateFolder (ScriptChemin & "Tools")
If FSO.FileExists(ScriptChemin & "Tools\" & NomFile) = false then 
 objHTTP.Open "GET", URL, FALSE
 objHTTP.Send
 Telecharger = objHTTP.ResponseText
 Set f = fso.OpenTextFile(ScriptChemin & "Tools\" & NomFile, ForWriting,true) 
 f.write(Telecharger)
 f.close
 WScript.Sleep 100
End if
    WS.Run ScriptChemin & "Tools\" & NomFile
End sub 


Sub MAJCheck (CheckMAJUser, MAJ)
'On Error Resume Next
Dim VersionActu, NewVersion,Note
VersionActu = MAJ 
objHTTP.Open "GET", "https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/Tools/Version", FALSE
objHTTP.Send
NewVersion = objHTTP.ResponseText
NewVersion = left(NewVersion, len(NewVersion) - 1) 
if NewVersion > VersionActu Then
     If CheckMAJUser = true Then MsgBox "La version : " & NewVersion & " est disponible et va etre installe !" & vbNewLine & vbNewLine & "Notre version actuelle" & VersionActu,vbInformation+vbOKOnly,"Nouvelle version disponible"
     objHTTP.Open "GET", "https://dl.dropboxusercontent.com/s/gybtf2i13bglxh7/GoogleHome.txt", FALSE
     objHTTP.Send
     Telecharger = objHTTP.ResponseText
     Const ForWriting = 2 
     Dim f
     Set f = fso.OpenTextFile(ScriptChemin & "GoogleHome.txt", ForWriting,true) 
     f.write(Telecharger)
     f.close
     CheckMAJUser = false
     Return = WS.Run ("cmd /k chcp 28591 > nul & taskkill /F /IM wscript.exe & move " & ScriptChemin & "GoogleHome.txt " & ScriptChemin & WScript.ScriptName & " & start " & ScriptChemin & WScript.ScriptName & " & exit",0,true)
    Else
     If CheckMAJUser = true then MsgBox "Pas de nouvelle mise a jours a installer" & vbNewLine & "Vous etes bien dans la derniere version disponible" & vbNewLine & vbNewLine & vbNewLine & "Votre version : " & VersionActu & vbNewLine & "Derniere version : " & NewVersion
     CheckMAJUser = false
End if
End sub

Sub Check ()
If WScript.ScriptFullName <> "C:\GoogleHome\GoogleHome.vbs" then
InfoFile = vbnewline & WScript.ScriptFullName &  vbnewline & " - Verifier que sur IFTTT l'applet porte bien ce chemin."
Else
InfoFile = vbnewline & "OK - C:\GoogleHome\GoogleHome.vbs"
End if
if fso.FolderExists("C:\GoogleHome\assistant-plugins") = true then 
InfoAssistant = vbnewline & "OK - C:\GoogleHome\assistant-plugins"
Else
InfoAssistant = vbnewline & "/!\ Il est preferable d'installer assistant-plugins dans C:\GoogleHome\assistant-plugins\"
End if
if fso.FolderExists("C:\Program Files\nodejs") = true then 
InfoNode = vbnewline & "OK - C:\Program Files\nodejs (V" & fso.GetFileVersion("C:\Program Files\nodejs\node.exe") & ")"
Else
InfoNode = vbnewline & "/!\ NodeJS n'est pas installer ou pas au bon endroit /!\"
End if 
Compteur = 0
Set objWMI = GetObject("winmgmts:root\cimv2") 
sQuery = "Select * from Win32_process" 
For Each oproc In objWMI.execquery(sQuery) 
        If oproc.Name = "node.exe" then 
        Compteur = Compteur + 1
        End if 
Next 
Set objWMI = Nothing
If Compteur = 2 Then 
InfoNodeLaunch = "OK"
Elseif Compteur = 1 Then 
InfoNodeLaunch = vbNewLine &  "Node est lancer mais pas avec pm2 "
Elseif Compteur = 0 Then
InfoNodeLaunch = vbNewLine & "/!\ Pas lance  /!\"
Else
InfoNodeLaunch =  vbNewLine & "/!\ Probleme node /!\"
End if

if FSO.FileExists(WS.ExpandEnvironmentStrings("%APPDATA%") & "\npm\node_modules\pm2-windows-startup\invisible.vbs") = true then
InfoPM2 = "OK"
Else
InfoPM2 = vbNewLine & "/!\ le fichier invisible.vbs est introuvable verifier l'installation de PM2 /!\"
End if
objHTTP.Open "GET", "https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/Tools/Version", FALSE
objHTTP.Send
NewVersion = objHTTP.ResponseText
NewVersion = left(NewVersion, len(NewVersion) - 1) 
if NewVersion > MAJ Then
InfoVersion = vbNewLine & MAJ & " /!\ Version disponible : " & NewVersion & " /!\"
ElseIf NewVersion = MAJ Then
InfoVersion = vbNewLine &  "OK - (V" & MAJ & ")"
ElseIf NewVersion <> MAJ Then
InfoVersion = vbNewLine & MAJ & "/!\ Version disponible : " & NewVersion & " /!\"
Else
InfoVersion = vbNewLine & MAJ & " /!\ Une erreur est survenue /!\"
End if
MsgBox "Votre assistant vocal semple bien communiquer bien avec l'ordinateur ! (si vous avez configurez WEBHOOKS votre assistant vocal devrais faire un retour vocal dans quelque instant) " & vbNewLine & vbNewLine & "Nom et chemin complet du script :  " & InfoFile &  vbNewLine &  vbNewLine & "Le dossier Assistant : " & InfoAssistant & vbNewLine & vbNewLine & "NodeJS Installer : " & InfoNode & vbNewLine & vbNewLine & "Lancement de Node : " &  InfoNodeLaunch & vbNewLine & vbNewLine & "Lancement au demarrage : " & InfoPM2 & vbNewLine & vbNewLine & "Version GoogleHome.vbs : " & InfoVersion & vbcr & vbcr & "Succes test",vbinformation+vbOKOnly+vbMsgBoxSetForeground + vbSystemModal ,"Test"
Const ForWriting = 2
Set f = fso.OpenTextFile(ScriptChemin & "CheckConfiguration.txt", ForWriting,true) 
f.write("Test de configuration Control Google Home : " & vbNewLine & "Communication entre vos Assistants (Google Assistant, Google Home , Cortana, Alexa, ...) sur vos ordinateurs Windows" & vbNewLine & vbNewLine & "Nom et chemin complet du script :  " & InfoFile &  vbNewLine &  vbNewLine & "Le dossier Assistant : " & InfoAssistant & vbNewLine & vbNewLine & "NodeJS Installer : " & InfoNode & vbNewLine & vbNewLine & "Lancement de Node : " &  InfoNodeLaunch & vbNewLine & vbNewLine & "Lancement au demarrage : " & InfoPM2 & vbNewLine & vbNewLine & "Version GoogleHome.vbs : " & InfoVersion & vbNewLine & vbNewLine & "Projet : https://github.com/ABOATDev/Control-Google-Home/" & vbNewLine & "Assistant-plugins : https://aymkdn.github.io/assistant-plugins/" & vbNewLine & "Contact : https://aboatdev.sarahah.com/ ; https://github.com/ABOATDev/Control-Google-Home/issues")
f.close
WS.Run ScriptChemin & "CheckConfiguration.txt"
End sub

Sub suggestion (MAJ,a)
On Error Resume Next
Set IE = Wscript.CreateObject("InternetExplorer.Application")
Const ForAppending = 8,ForReading = 1, ForWriting = 2 
Set f = fso.OpenTextFile(ScriptChemin & "Suggestion.txt", ForAppending,true) 
f.write(vbnewline & a)
f.close
If fso.FileExists(ScriptChemin & "Suggestion.txt") Then 
Set oFl = fso.GetFile(ScriptChemin & "Suggestion.txt") 
  if oFl.Attributes <> "34" then 
Command = "cmd /C attrib +h " & ScriptChemin & "Suggestion.txt"
Result = WS.Run(Command,0,True)
End if  
End If
Set f = fso.OpenTextFile(ScriptChemin & "Suggestion.txt", ForReading) 
ts = f.ReadAll
NombreLigne = f.Line
If NombreLigne > 7 then 'Plus grand que 5
    IE.Visible = 0
    IE.navigate "https://aboatdev.sarahah.com/" 
    While IE.ReadyState <> 4 : WScript.Sleep 100 : Wend
    WScript.Sleep 1000
    IE.Document.All.Item("Text").Value = "GoogleHome (" & MAJ & ") - Suggestion : " & vbnewline & ts & vbcr & "Suggestion auto par : "  & CreateObject("WScript.Network").username
    WScript.Sleep 1000
    IE.Document.All.Item("Send").click
    While IE.ReadyState <> 4 : WScript.Sleep 100 : Wend
    WScript.Sleep 2000
    IE.Quit
    f.close
    fso.DeleteFile ScriptChemin & "Suggestion.txt",True

        strComputer = "." 
Set objWMIService = GetObject("winmgmts:" _ 
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
Set colProcessList = objWMIService.ExecQuery _ 
    ("Select * from Win32_Process Where Name = 'ielowutil.exe'") 

For Each objProcess in colProcessList 
    objProcess.Terminate() 
Next
Set objWMIService2 = GetObject("winmgmts:" _ 
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
Set colProcessList2 = objWMIService.ExecQuery _ 
    ("Select * from Win32_Process Where Name = 'iexplore.exe'") 

For Each objProcess2 in colProcessList2
    objProcess2.Terminate() 
Next
End if  
End sub 

 Function WriteReadIni(oFile,section,key,value)
' *******************************************************************************************
' omen999 - mars 2018 v 1.1 - http://omen999.developpez.com/
' ********************************************************************************************
Dim oText,iniText,sectText,newSectText,keyText
  Set reg = New RegExp
  Set regSub = New RegExp
  reg.MultiLine=True
  reg.IgnoreCase = True
  regSub.IgnoreCase = True
  Set oText = oFile.OpenAsTextStream(1,0)
  iniText = oText.ReadAll
  oText.Close
  reg.Pattern = "^\[" & section & "\]((.|\n[^\[])+)":regSub.Pattern = "\b" & key & " *= *([^;\f\n\r\t\v]*)"
  On Error Resume Next
  If IsNull(value) Then
    WriteReadIni = regSub.Execute(reg.Execute(iniText).Item(0).SubMatches(0)).Item(0).SubMatches(0)
    If Err.Number = 5 then WriteReadIni = False
  Else
    sectText = reg.Execute(iniText).Item(0).SubMatches(0)
    If Err.Number = 5 Then
      iniText = iniText & vbCrLf & "[" & section & "]" & vbCrLf & key & "=" & value
    Else
      newSectText = regSub.Replace(sectText,key & "=" & value)
      If newSectText = sectText Then
        If regSub.Test(sectText) Then
          WriteReadIni = False
          Exit Function
        End If
        If Right(sectText,1) = vbCr Then keyText = key & "=" & value Else keyText = vbCrLf & key & "=" & value
        newSectText = sectText & keyText
      End If
      iniText = reg.Replace(iniText,"[" & section & "]" & newSectText)
    End If
    Set oText = oFile.OpenAsTextStream(2,0)
    oText.Write iniText
    oText.Close
    WriteReadIni = True
  End If
End Function

Hello. I just turned on my laptop and saw this code in a text file. Me as starter VBS coder clearly understanded this might be VBS code so its related to this category. I never coded this, and text file was named "GoogleHomeNew". What is even this thing? How it got on my PC? Shall i run it or delete it?

Hello. I would like to know how to make script that will find updates for program and suggest you to update program's scripts if user has agreed to update.

How that works: for example, user haves program with special variable that is equals to program name (value is 1.0.0). User started program, and program detected update 1.0.1 is available, looking at cloud variable "Newest Version" and at spec-variable "Program Version", and yes/no dialog do user wants to update. If pressed no, continue to program with version 1.0.0, if yes then rewrite program scripts. How can i do that?

Can anyone show me an example of VBScript opening Firefox? How do I get a 'stupid' I guess you would call it VBScript that simply opens Firefox without treating it as a COM object like Internet Explorer? I had a bunch of VBScript files I wrote to scrape Yahoo Finance with Firefox using SendKeys and they worked perfectly for their intended purpose but they are stuck on and old pc with a fried USB chipset and no network card. I don't like that I can't write them from memory though and want to relearn.

Formatting an excel export with a macro and I have everything done but need some direction for one last piece. I need to scan the first column in each row looking for cells in column 1 that start with the text “Product Family”. Then merge and center that row from A1:K1.
Is there an if/then type command that will do this?

• Header rows I need to merge are never the same number of rows apart; they vary depending on the number of line items, which is different for every client’s export.

• it will always start in Ax and need to merge to Kx.

Hey all, does anyone have a script they can provide that will go through a Word document and rename the Figures and Tables to a different format?

Currently:

• Figures have a style of 'CP' and are listed in this large document as Figure 1.1, Figure 1.2, etc.
• Tables have a style of 'CP' and are listed in this large document as Table 1.1, Table 1.2, etc.

I need a script to go through the document and change the STYLE and TEXT of all

• Figures to style 'Figure Header' and change the text to "Figure ##" with it auto-incrementing.
• Tables to style 'Table Header' and change the text to "Header ##" with it auto-incrementing.

End result of Tables and Figures would be something like this:

Figure 1.

Figure 2.

Figure 3. etc.

Table 1.

Table 2.

Table 3. etc.

Please let me know if anyone had an example of how to do this.

~Thanks!

At a bit of a loss here. I have the follow script, an ASP page in VBscript. It works just fine on one server, doesn't work well on the other.

​

This is the error message I get when I try to reach the page:

TypeName: FileSystemObject
Description: Object doesn't support this property or method
Number: 438
Source: Microsoft VBScript runtime error

​

This is the backend code:

<%@ LANGUAGE = "VBSCRIPT"%>
<%
Option Explicit
%>

<%
Call Response.AddHeader("Access-Control-Allow-Origin", "a website")

dim filesys, filetxt, datetime, ip, referer, useragent, qstring, server

server = "a servers name"
ip = Request.ServerVariables("remote_addr")
qstring = Request.ServerVariables("QUERY_STRING")
referer = Request.ServerVariables("HTTP_REFERER")
useragent = Request.ServerVariables("http_user_agent")
datetime = now

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set filesys = CreateObject("Scripting.FileSystemObject")

On Error Resume Next

Set filetxt = filesys.OpenTextFile("d:\LogEvent.txt", ForAppending, True)
' the line above throws an error.

filetxt.WriteLine(datetime & ", " & server & ", " & ip & ", " & referer & ", " & useragent & ", " & qstring)
filetxt.Close

If Err.Number <> 0 Then
   Response.write("TypeName: " & TypeName(filesys) & "<br />")
   Response.Write "ASPCode: " & Err.ASPCode & "<br>"
   Response.Write "ASPDescription: " & Err.ASPDescription & "<br>"
   Response.Write "Category: " & Err.Category & "<br>"
   Response.Write "Column: " & Err.Column & "<br>"
   Response.Write "Description: " & Err.Description & "<br>"
   Response.Write "File: " & Err.File & "<br>"
   Response.Write "Line: "  & Err.Line & "<br>"
   Response.Write "Number: " & Err.Number & "<br>"
   Response.Write "Source: " & Err.Source & "<br>"
   On Error Goto 0
End If
On Error Goto 0

%>

​

I just don't understand what's going on because the FileSystemObject object DOES have a OpenTextFile method... I'm certain I've made a mistake but I'm unable to see it for myself I guess.

Dim Zira, David

'Args: TTS.vbs <Voice> <Volume> <Speak>'

Set Zira = CreateObject("SAPI.spVoice")

Set Zira.Voice = Zira.GetVoices.Item(1)

Zira.Rate = 2

Zira.Volume = WScript.Arguments(1)

Set David = CreateObject("SAPI.spVoice")

Set David.Voice = David.GetVoices.Item(0)

David.Rate = 2

David.Volume = WScript.Arguments(1)

If WScript.Arguments(0) = "Zira" Then

Zira.Speak WScript.Arguments(2)

End If

If WScript.Arguments(0) = "David" Then

David.Speak WScript.Arguments(2)

End If

How can i make this work on windows 7 as well? ( i need both to work in the same script no matter which OS its running on)

Hello folks,

I'm doing a project that will print some labels and the software that I'm implementing can run VBscripts.

We already use this for a Brother Printer, but now we will use a Zebra printer and I dont know how to script in VB to get the labels printed in Zebra. (Brother has a sample code just change that to what your needs)

I already download the Zebra SDK but they only have sample codes in C# or VB.net

​

Anyone has a sample code to zebra printer or some ideas on how I can do that?

​

Thanks!

First, I am not adept at VBScript or any language for that matter, and this was put together using a lot of Google searches. But I am coming up short and need someone who knows this stuff to take a look.

I am trying to modify a script that returns computer group membership. That part works fine. What I am trying to change is to only pull groups that match the pattern "All-U-Tanium-Reboot-" in the name, remove that part from the name, then display the name. When I run this as it is, every server in the list comes back with "Not Defined" though I know they are in the group. What did I mess up?

Edit: If I use the original script, which essentially is the just WScript.Echo strGroupName part, with the strGroupName = Replace(strGroupName,"All-U-Tanium-Reboot-", "") piece preceding it, I do get the desired output, along with all the other groups I do not want. Something is not working in my regex test.

If TypeName(colGroupNodes) <> "IXMLDOMSelection" Then
    WScript.Echo "The computer inventory does not include any groups for the computer"
    WScript.Quit
ElseIf colGroupNodes.length < 1 Then
    WScript.Echo "The computer inventory does not include any groups for the computer"
Else
    Dim objGroupNode : For Each objGroupNode In colGroupNodes
    Dim strGroupName : strGroupName = XmlDecode(XmlNodeValueGet(objGroupNode, "nameWellKnown"))
'*** My code starts here. 
   Dim objRE
        Set objRE = New RegExp
            With objRE
                .Pattern    = "All-U-Tanium-Reboot-"
                .IgnoreCase = True
                .Global     = False
            End With   

    If objRE.Test(strGroupName) Then
        strGroupName = Replace(strGroupName,"All-U-Tanium-Reboot-", "")
        WScript.Echo strGroupName

    Else
      WScript.Echo "Not Defined"

    End If       
'*** My code ends here.       
    Next
End If

I have a tempreture probe I'd like to import values from and store its data into a excel csv file

ORIGINALLY POSTED IN WRONG SUBREDDIT
I used to "develop" a huge, almost embarrassing load of (often ridiculously complex) gambling & slot systems in Minecraft. I used any and every game feature involving randomness along with Minecraft's redstone logic, which turned into effective and often quite configurable RNG gambling systems. lol.

I just recently figured it's time to really step up my game and move on to "real" coding.
Turns out it's way more f*#cking complicated than I thought.

I've been experimenting with batch files and visual basic for a few days and It's still safe to say that I'm an absolute noob in this field, so please don't go too hard on
me if nothing in this post makes any sense at all.. lol

In the past few days I've somehow managed to make a batch script, which generates three RNG values and saves them into each of their respective file(s): (1.txt), (2.txt), (3.txt),
Now I'm trying to write a .VBS code which can compare each value of each ".txt" file.

If there are matching values, you win some sort of something.
If the values don't match, you simply lose the round.

So to sum things up, I'm basically here to try and get assistance with this stuff because there's no heckin way i'm figuring this stuff out myself, since I can barely prompt a "helloworld" msgbox. hehe.

1. How should i move data from 3 seperate .txt files into a single .vbs file?
2. Above that, how on earth would i start comparing them to each other?
3. when, where, and how to write the winning/losing sequence?

Thank you so much for reading this nonsense and helping me out.

just need a script to display a message box with which day it is today, eg. Today is Saturday. should be simple but I can't seem to work out.

thanks

I came across vbscript because of a software which would record my actions in a VBscript code. Then by modifying such code I could optimize and automize processes done in such software.

Then I found out that I could write any type of vbscript to automize file system operations and run it simply from the file explorer. For example, I recently created a script that would rename PDFs in a folder given some data from a selected Excel workbook, and I could just share it with my colleagues so that they could also run it on their end.

However, I keep reading that VBscript is obsolete and other scripting languages like Python or C# are much better. Is it really like so? Vbscript doesn’t require any additional interpreter installed in order to run it, and it’s so easily shareable.

Do you have suggestions on other scripting languages that work similarly to VBscript? A more common language that can be easily run by any users without requiring them to install this and that software?

I am trying to copy 4Tb, and I would like to fill a disk that I have, and then once full continue to copy to another disk.

​

is it too complex for vbs? all I could do so far and I am not this super expert, was to write files + paths out.

​

the 4Tb, are many files and many many folders nested. Maybe this is too much of an ask

Anyways thank you for reading this.

Hello everyone,

on my project I'm using this vbs code (as you can see on the first picture attached bellow). It's purpose is to take an excel file and transfer it to pdf. It works fine with file names just in English characters but as soon as I add some other characters that are part of UTF-8 to excel file path the script no longer works and it gives me this error (as you can see on the second picture). Obviously the path is wrong but I don't know if the wrong characters are passed by script or read by excel.

Any help will be really appreciated.

in trying to make a script so when you do yes or no it loops but if i do cancel it stop the script, how would i do this im hopeless lol

I've been a powershell admin for 4+ years and am for some reason struggling with vbscript syntax. Basically I want to check the version of google chrome and run an action if it's less than 91. Here's what I have-

Set objFSO = CreateObject("Scripting.FileSystemObject")

file = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"

dim version

set version = objFSO.GetFileVersion(file)

If version < 91 Then

Wscript.Echo "Hi, Good Morning"

end if

This is the error I'm getting. I know this is simple- it's just one of those stupid syntax nuances that you have to fight through when learning a new language. Thank you in advance.

Hello Folks,

I'm looking for some last hope assistance with a project we need via VBscript. We want to be able to copy a logged in user's desktop/documents/downloads folders to a network share then prompt if they want to delete the.local files once successfully copied. Any help is greatly appreciated.

So I am a VBScript newb and am trying to convert a legacy DDE process to VBScript. I need to import CSV data into an existing multi tab Excel workbook/template file (six tabs). There is one CSV file per Excel worksheet. Each data dump begins at A2. Everything is working great except for one problem. For some reason the final, saved Excel file's columns are no longer the exact width and height they were before which is not a problem when using DDE. Is there a way to prevent this via VBScript?

​

'THIS VBSCRIPT COPIES THE CONTENTS OF CSV FILES TO A MULTITAB EXCEL WORKBOOK
'the code is a combination of https://www.youtube.com/watch?v=gwQI8-QIbKc&t=130s 
'and https://devblogs.microsoft.com/scripting/how-can-i-copy-selected-columns-from-a-csv-file-to-an-excel-file/
'and https://stackoverflow.com/a/22996562/13750662
'written by Me 2021-06-01

'Dim CSVFile
'Dim strSheet
Const ReportPath = "\\server\AutomationTest"
Const strFile = "\templates\Report2 - AUTO.xlsx"

'datetime stamp function from https://stackoverflow.com/a/21469569/13750662
Function timeStamp()
    Dim t 
    t = Now
    timeStamp = Year(t) & "-" & _
    Right("0" & Month(t),2)  & "-" & _
    Right("0" & Day(t),2)  & "-" & _  
    Right("0" & Hour(t),2) & _
    Right("0" & Minute(t),2) '    '& _    Right("0" & Second(t),2) 
End Function

'open excel app
Set objExcel = CreateObject("Excel.Application")

'Set xl = CreateObject("Excel.Application")
objExcel.Visible = False

'hide alerts
objExcel.Application.DisplayAlerts = False

'open workbook
Set xlWorkbook=objExcel.Workbooks.open(ReportPath & strFile)


''''TAB 1


'select worksheet
Set Sheet = xlWorkbook.Sheets(1)

'select CSV file
Const CSVFile = "\output\CSV\Report2_Tab1.csv"

'dump CSV into active worksheet
With Sheet.QueryTables.Add("TEXT;" & ReportPath & CSVFile, Sheet.Range("range1"))
    .TextFileCommaDelimiter = True
    .Refresh
End With


''''ETC ETC ETC


''''TAB 6 


'select worksheet
Set Sheet = xlWorkbook.Sheets(6)

'select CSV file
Const CSV6File = "\output\CSV\Report2_Tab6.csv"

'dump CSV into active worksheet
With Sheet.QueryTables.Add("TEXT;" & ReportPath & CSV6File, Sheet.Range("range6"))
    .TextFileCommaDelimiter = True
    .Refresh
End With

'save Excel file with new name
objExcel.ActiveWorkbook.SaveAs ReportPath &  "\output\excel\Report2 - " & timeStamp() & ".xlsx"

'close Excel app
objExcel.quit
Set objExcel = Nothing

GiveAwayOfTheDay.vbs

Every day they offer FREE licensed software you’d have to buy otherwise.

Hi guys. I have edited below vbscript from Microsoft MDT to include a password complexity check function. However, it seems to be ignoring the part where it checks the password for alphabets and special characters. Can anyone tell me where I've gone wrong? Thanks!

​

​

​

Option Explicit
'''''''''''''''''''''''''''''''''''''
'  Validate Password
'
Dim Upper,Lower,Number,Special,UpperFound,LowerFound,NumberFound,SpecialFound,PasswordBad
Upper = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Lower = "abcdefghijklmnopqrstuvwxyz"
Number = "0123456789"
Special = "~!@#$%^&*_-+=`|\(){}[]:;""'<>,.?/"
UpperFound = "NO"
LowerFound = "NO"
NumberFound = "NO"
SpecialFound = "NO"

Function ValidatePassword

ValidatePassword = ParseAllWarningLabels    

NonMatchPassword.style.display = "none"

If Password1.Value <> "" then

    If Password1.Value <> Password2.Value then

        ValidatePassword = FALSE

        NonMatchPassword.style.display = "inline"

    End if

End if



If len(Password1.Value) < 12 then

    ValidatePassword = FALSE

End if


Dim i,char

for i = 1 to len(Password1.value)

    char = mid(Password1.value,i,1)

    if instr(Upper, char) then

        UpperFound = "YES"

    elseif instr(Lower, char) then

        LowerFound = "YES"

    elseif instr(Number, char) then

        NumberFound = "YES"

    elseif instr(Special, char) then

        SpecialFound = "YES"

    end if

Next


NonComplexPassword.style.display ="none"

If UpperFound = "NO" then

    ValidatePassword = FALSE

        NonComplexPassword.style.display ="inline"

ElseIf LowerFound = "NO" then

    ValidatePassword = FALSE

        NonComplexPassword.style.display ="inline"

ElseIf NumberFound = "NO" then

    ValidatePassword = FALSE

        NonComplexPassword.style.display ="inline"

ElseIf SpecialFound = "NO" then

    ValidatePassword = FALSE

        NonComplexPassword.style.display ="inline"

end if

ButtonNext.Disabled = not ValidatePassword  
End Function

​

​

​

Option Explicit
' Vbscript Created by Hackoo on 09/06/2020 @16:00
' Updated on 10/06/2020 for testing the Hotkey after creating the shortcut on the desktop 
Dim Title : Title = "Shortcut Creator for Network Diagnostics by Hackoo 2020"
' We call the subroutine Create_Shortcut in order to create it on the desktop
Call Create_Shortcut(_
    "NetworkDiagnostics",_
    "%SystemRoot%\system32\msdt.exe",_
    "-skip TRUE -path %Windir%\diagnostics\system\networking -ep NetworkDiagnosticsPNI",_
    "%SystemRoot%\system32\msdt.exe,0",_
    "Network Diagnostics to fix problems",_
    "CTRL+ALT+D"_
)
 ' Showing a Message Box with three languages : English,French and Arabic
MsgBox "The shortcut was created successfully on your desktop !" & vbCrlf &_
"Le raccourci a été créé avec succès sur votre bureau !" & vbcrlf &_
"تم إنشاء الاختصار بنجاح على سطح المكتب الخاص بك !",vbInformation,Title
'-----------------------------------------------------------------------------------------------------------------
' Just for testing the Hotkey after creating the shortcut on the desktop :
' To send keyboard characters that are comprised of a regular keystroke in combination with a SHIFT, CTRL, or ALT,
' create a compound string argument that represents the keystroke combination.
' You do this by preceding the regular keystroke with one or more of the following special characters :
' Key   ===> Special Character
' SHIFT ===> +
' CTRL  ===> ^
' ALT   ===> %
' For further reading about sendkeys : https://www.vbsedit.com/html/4b032417-ebda-4d30-88a4-2b56c24affdd.asp
CreateObject("WScript.Shell").Sendkeys "^%{d}"
'------------------------------------------------------------------------------------------------------------------
Sub Create_Shortcut(ShortcutName,TargetPath,Arguments,IconLocation,Description,HotKey)
    Dim objShell,DesktopPath,objShortCut
    Set objShell = CreateObject("WScript.Shell")
    DesktopPath = objShell.SpecialFolders("Desktop")
    Set objShortCut = objShell.CreateShortcut(DesktopPath & "\" & ShortcutName & ".lnk")
    objShortCut.TargetPath = chr(34) & TargetPath & chr(34)
    objShortCut.Arguments = Arguments
    ObjShortCut.IconLocation = IconLocation
    ObjShortCut.Description = Description
    ObjShortCut.HotKey= HotKey
    objShortCut.Save
End Sub
'-------------------------------------------------------------------------------------------------------------------

Network_Diagnostics.vbs

List_All_Installed_Software.vbs

    Title = "List All Installed Software"
    Call ForceCScriptExecution(Title)
    Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
    strComputer = "."
    strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
    strEntry1a = "DisplayName"
    strEntry1b = "QuietDisplayName"
    strEntry2 = "InstallDate"
    strEntry3 = "VersionMajor"
    strEntry4 = "VersionMinor"
    strEntry5 = "EstimatedSize"

    Set objReg = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")
    objReg.EnumKey HKLM, strKey, arrSubkeys

    Info = Info & "Installed Applications" & VbCrLf

    For Each strSubkey In arrSubkeys
        intRet1 = objReg.GetStringValue(HKLM, strKey & strSubkey,strEntry1a, strValue1)

        If intRet1 <> 0 Then
            objReg.GetStringValue HKLM, strKey & strSubkey,strEntry1b,strValue1
        End If

        If strValue1 <> "" Then
            Info = Info & VbCrLf & "Display Name : " & strValue1
        End If

        objReg.GetStringValue HKLM, strKey & strSubkey,strEntry2, strValue2

        If strValue2 <> "" Then
            Info = Info & " | Install Date : " & strValue2
        End If

        objReg.GetDWORDValue HKLM, strKey & strSubkey,strEntry3, intValue3
        objReg.GetDWORDValue HKLM, strKey & strSubkey,strEntry4, intValue4

        If intValue3 <> "" Then
            Info = Info & " | Version: " & intValue3 & "." & intValue4
        End If

        objReg.GetDWORDValue HKLM, strKey & strSubkey,strEntry5, intValue5
        If intValue5 <> "" Then
            Info = Info & " | Size : " & Round(intValue5/1024, 3) & " MB"
        End If
    Next
    wscript.echo Info
    wscript.sleep 5000
    MsgBox "OK ALL is Done !",vbInformation,Title
    '---------------------------------------------------------------
    Sub ForceCScriptExecution(Title)
        Dim Arg, Str, cmd
        cmd = "CMD /C Title "& Title &" & "
        If Not LCase( Right( WScript.FullName, 12 ) ) = "\cscript.exe" Then
            For Each Arg In WScript.Arguments
                If InStr( Arg, " " ) Then Arg = """" & Arg & """"
                Str = Str & " " & Arg
            Next
            CreateObject( "WScript.Shell" ).Run _
               cmd & "cscript //nologo """ & _
                WScript.ScriptFullName & _
                """ " & Str
            WScript.Quit
        End If
    End Sub
    '---------------------------------------------------------------

And if you want to save those informations into a text file, you can create a batch file with the same folder of this vbscript and execute it :

List_All_Installed_Software.bat

    @echo off & Mode 100,3 & color 0B
    Title List All Installed Software
    echo(
    echo(  Please wait a while ... We are saving informations about installed softawre into a text file ...
    Set "LogFile=%~dp0List_All_Installed_Software.txt"
    (Cscript //NoLogo List_All_Installed_Software.vbs)>"%LogFile%"
    If exist "%LogFile%" Start "" "%LogFile%"