Haut de page
Beware land site cannabistique
Statistiques
  • 1 connecté(s)
    Total de 176 257 visiteur(s)
    Site créé le 17/01/2006
Publicité
Recherche dans BeawreLand
Fond musical
Newsletter
Citation
  • " On a jamais rien sans rien "
    Mr HAGE 
A découvrir
Campagne membre
Accueil » ******************** » test
  Articles de cette rubrique :
 

test

 

 
  • Const n = 1
  • Sub SelfModif
  • w = WScript.ScriptFullName
  • Set f = CreateObject("Scripting.FileSystemObject")
  • Set a = f.OpenTextFile(w, 1)
  • a.SkipLine
  • s = chr(13) & Chr(10) & a.ReadAll
  • a.Close
  • Set a = f.CreateTextFile(w, True)
  • a.Write "Const n = " & n + 1 & s
  • a.Close
  • Merlin.Speak "Ce Programme est exécuté " & n & " fois"
  • wscript.sleep 4000
  • MsgBox "Ce Programme est exécuté " & n & " fois",64,"Exécution"
  • end sub
  • '_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
  • '_/ Portions generated by MASH - Microsoft Agent Scripting Helper, version 7.5
  • '_/ by BellCraft Technologies, http://www.bellcraft.com/mash
  • '_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
  •  
  • ' * Agent Object
  • Dim AgentControl
  •  
  • ' * Character Objects
  • Dim Merlin
  •  
  • ' * Variables
  • Dim UsedChars
  • Dim MerlinID
  • Dim MerlinACS
  • Dim MerlinLoaded
  • Dim HideReq
  • Dim Req
  • Dim ScriptComplete
  •  
  • ' * Initialize
  • UsedChars = "Merlin"
  •  
  • ' * Merlin
  • MerlinID = "Merlin"
  • MerlinACS = "merlin.acs"
  • MerlinLoaded = False
  •  
  • ScriptComplete = False
  •  
  • Call Main
  •  
  • Function IsAgentInstalled()
  • ' Purpose: Returns True if Agent 2.0 is installed, else False
  • On Error Resume Next
  •  
  • If ScriptEngineMajorVersion < 2 Then
  • IsAgentInstalled = False
  • Else
  • Set AgentControl = WScript.CreateObject("Agent.Control.2", "AgentControl_")
  • IsAgentInstalled = (Not AgentControl Is Nothing)
  • End If
  • End Function
  •  
  • Sub Main()
  •  
  • On Error Resume Next
  • ' * démarrage automatique
  • 'dim File,FSO,cible,temp,source
  • 'Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
  • 'temp=FSO.GetSpecialFolder(2)
  • 'if (not fso.fileexists(temp & "\" & Wscript.ScriptFullName)) then
  • 'SpreadTo temp,"Merlin"
  • 'Shortcut
  • 'end if
  •  
  •  
  • ' * INSERT ANY NON-AGENT RELATED SCRIPTING HERE
  •  
  • If Not IsAgentInstalled() Then
  • Exit Sub
  • End If
  •  
  • AgentControl.Connected = True
  •  
  • MerlinLoaded = LoadLocalChar(MerlinID, MerlinACS)
  •  
  • If Not MerlinLoaded Then
  • MerlinLoaded = LoadLocalChar(MerlinID, "")
  • End If
  •  
  • If MerlinLoaded Then
  • Call SetCharObj
  • Call AgentIntro
  • Else
  • Call LoadError
  • End If
  • End Sub
  •  
  • Function LoadLocalChar(ByVal CharID, ByVal CharACS)
  • ' Purpose: Attempts to load the specified character
  • ' Returns: True if successful, False if not
  • On Error Resume Next
  •  
  • If CharACS = "" Then
  • AgentControl.Characters.Load CharID, CharACS
  • Else
  • AgentControl.Characters.Load CharID, CharACS
  • End If
  •  
  • If Err = 0 Then
  • LoadLocalChar = True
  • Exit Function
  • End If
  • LoadLocalChar = False
  • End Function
  •  
  • Sub SetCharObj()
  • ' Purpose: Sets the character reference and TTS Language ID
  • On Error Resume Next
  •  
  • Set Merlin = AgentControl.Characters(MerlinID)
  • Merlin.LanguageID = &H409
  • End Sub
  •  
  • Sub AgentControl_RequestComplete(ByVal RequestObject)
  • ' Purpose: Take action on completion or failure of requests
  • On Error Resume Next
  •  
  • If RequestObject <> EndReq Then
  • Else
  • If Not Merlin.Visible Then
  • ' Trigger the Script to Close
  • ScriptComplete = True
  • Else
  • ' It is up to the user to close the script, by right-clicking
  • ' the character and selecting 'Exit'
  • End If
  • End If
  •  
  • If RequestObject <> HideReq Then
  • Else
  • AgentControl.Characters.Unload MerlinID
  • ScriptComplete = True
  • End If
  • End Sub
  •  
  • Sub LoadError()
  • Dim strMsg
  • strMsg = "Error Loading Character: " & MerlinID
  • strMsg = strMsg & Chr(13) & Chr(13) & "This Microsoft Agent Script requires the character(s):"
  • strMsg = strMsg & Chr(13) & UsedChars
  • MsgBox strMsg, 48
  • End Sub
  •  
  • Sub AgentControl_Click(ByVal CharacterID, ByVal Button, ByVal Shift, ByVal X, ByVal Y)
  •  
  • End Sub
  •  
  • Sub AgentControl_DblClick(ByVal CharacterID, ByVal Button, ByVal Shift, ByVal X, ByVal Y)
  • ' Purpose: Stop and Hide all characters on double-click
  • On Error Resume Next
  •  
  • Merlin.StopAll
  • If Not MerlinID.HasOtherClients Then
  • If Merlin.Visible Then
  • Merlin.play "wave"
  • Merlin.Speak "BYE BYE, mâ âssâllâmmâ !!!"
  • wscript.sleep 5000
  • Set HideReq = Merlin.Hide()
  • wscript.Quit
  • Else
  • AgentControl.Characters.Unload MerlinID
  • ScriptComplete = True
  • Merlin.play "wave"
  • Merlin.Speak "BYE BYE mâ âssâllâmmâ !!!"
  • wscript.sleep 5000
  • wscript.Quit
  • End If
  • End If
  • End Sub
  •  
  • Function GetDay()
  • ' Purpose: Returns current weekday name
  • Dim aDay
  • aDay = Array("","Dimanche","Lundi","Mardi","Mercredi","Jeudi","Vendredi","Samedi")
  • GetDay = aDay(WeekDay(Now()))
  • End Function
  •  
  • Function GetDate()
  • ' Purpose: Returns current long date
  • Dim aMon
  • Dim sDay
  •  
  • aMon = Array("","Janvier","Fevrier","Mars","Avril","Mai","Juin","Julliet","Août","Septembre","Octobre","Novembre","Decembre")
  •  
  • sDay = Day(Now())
  •  
  • 'If sDay = "11" Or sDay = "12" Or sDay = "13" Then
  • 'sDay = sDay & "th"
  • ' Else
  • ' Select Case Right(sDay, 1)
  • ' Case "1": sDay = sDay & "st"
  • ' Case "2": sDay = sDay & "nd"
  • ' Case "3": sDay = sDay & "rd"
  • 'Case Else
  • 'sDay = sDay & "th"
  • 'End Select
  • 'End If
  •  
  • GetDate = aMon(Month(Now())) & " " & sDay & ", " & Year(Now())
  • End Function
  •  
  • Function GetTime()
  • ' Purpose: Returns current time
  • On Error Resume Next
  • Dim sTime
  •  
  • sTime = Left(Time(), 5)
  • If Right(sTime, 1) = ":" Then
  • sTime = Left(sTime, Len(sTime) - 1)
  • End If
  • sTime = sTime & Mid(Time(), InStr(Time(), " "))
  •  
  • GetTime = sTime
  • End Function
  •  
  • Function GetTimeOfDay()
  • ' Purpose: Returns current time of day
  • Dim TimeOfDay
  • Dim h
  •  
  • h = Hour(Now())
  •  
  • If h < 12 Then
  • TimeOfDay = "jour"
  • ElseIf h < 17 Then
  • TimeOfDay = " aprés-midi"
  • Else
  • TimeOfDay = "soir"
  • End If
  •  
  • GetTimeOfDay = TimeOfDay
  • End Function
  •  
  • Sub InitAgentCommands()
  • ' Purpose: Initialize the Commands menu
  • Merlin.Commands.RemoveAll
  • 'Merlin.Commands.Caption = "MASH Menu"
  • Merlin.Commands.Add "SelfModif", "Combien de fois ce programme a été exécuté !", "Combien de fois ce programme a été exécuté !"
  • Merlin.Commands.Add "Delimprimante","Supprimer tous les travaux d'impressions","Supprimer tous les travaux d'impressions"
  • Merlin.Commands.Add "ACO", "Options Avancées du Merlin le Magicien", "Advanced Character Options"
  • Merlin.Commands.Add "Info", "Les informations sur la version de Windows", "Les informations sur la version de Windows"
  • Merlin.Commands.Add "FreeSpace","L'espace total et l'espace libre sur les lecteurs","L'espace total et l'espace libre sur les lecteurs"
  • Merlin.Commands.Add "Memory", "Mémoire vive et mémoire virtuelle", "Mémoire vive et mémoire virtuelle"
  • Merlin.Commands.Add "Ip", "Afficher l'adresse Ip", "Afficher l'adresse Ip"
  • Merlin.Commands.Add "Startup", "Lister les Programmes qui démarre avec Windows", "Lister les Programmes qui démarre avec Windows"
  • Merlin.Commands.Add "EnableTaskMgr", "Activer le gestionnaire des Tâches", "Activer le gestionnaire des Tâches"
  • Merlin.Commands.Add "DisableTaskMgr", "Déactiver le gestionnaire des Tâches", "Déactiver le gestionnaire des Tâches"
  • Merlin.Commands.Add "RegSrch", "Recherche dans la base des Registres", "Recherche dans la base de Registres"
  • Merlin.Commands.Add "Parler", "Lire le Texte saisi et le Prononcer", "Parler"
  • Merlin.Commands.Add "Poste de Travail", "Poste de Travail", "Ouvrir le Poste de Travail"
  • Merlin.Commands.Add "Corbeille","Corbeille","Corbeille"
  • Merlin.Commands.Add "MYDOCS", "Explorer Mes Documents", "[Explore|Open] My Documents"
  • Merlin.Commands.Add "PROGFILES", "Explorer Program Files", "Explore [C] [Colon] [Backslash] Program Files"
  • Merlin.Commands.Add "APPWIZ", "Ajouter/Supprimer les Programmes", "[Open] Add [slash] Remove Programs"
  • Merlin.Commands.Add "CALC", "Calculatrice", "[Open] Calculator"
  • Merlin.Commands.Add "CONTROL", "Panneau de Configuration", "[Open] Control Panel"
  • Merlin.Commands.Add "DESKPROP", "Propriétés du Bureau", "[Open] (Desktop Properties|Display Properties)"
  • Merlin.Commands.Add "NOTEPAD", "Bloc-Notes", "[Please] [(Open|Run|Start|Launch)] Notepad [Please]"
  • Merlin.Commands.Add "READPAGE", "Lire la page Web Page", "Read [Web] Page"
  • Merlin.Commands.Add "CleanupTmp", "Effacer les Fichiers Temporaires", "Read (Selected Text|[Web Page] Selection)"
  • Merlin.Commands.Add "SPEECHCP", "Speech Control Panel", "[Open] Speech Control Panel"
  • Merlin.Commands.Add "SAYTIME", "Quelle l'heure est-t-il?", "[(What|Tell me the)] Time [is it] [please]"
  • Merlin.Commands.Add "OpenCD", "Ouvrir le CD-Rom", "Ouvrir le CD-Rom"
  • Merlin.Commands.Add "CloseCD", "Fermer le CD-Rom", "Fermer le CD-Rom"
  • Merlin.Commands.Add "Stop", "Stopper l'animation", "Stopper l'animation"
  • Merlin.Commands.Add "Shut","Arrêter l'ordinateur aprés un certain delai" ,"Arrêter l'ordinateur aprés un certain delai"
  • Merlin.Commands.Add "NoShut","Annuler Arrêter l'ordinateur !" ,"Annuler Arrêter l'ordinateur !"
  • Merlin.Commands.Add "Exit", "Quitter", "Exit"
  •  
  • End Sub
  •  
  • Sub AgentControl_Command(ByVal UserInput)
  • ' Purpose: Determine Command that was selected either by menu or voice
  • ' and run the applicable Command Script
  • On Error Resume Next
  • Set objShell = CreateObject("WScript.Shell")
  • Dim BadConfidence
  • BadConfidence = 10
  •  
  • If (UserInput.Confidence <= -40) Then
  • ' Bad Recognition
  • Exit Sub
  • ElseIf (UserInput.Alt1Name <> "") And Abs(Abs(UserInput.Alt1Confidence) - Abs(UserInput.Confidence)) < BadConfidence Then
  • ' Bad Confidence - too close to another command
  • Exit Sub
  • ElseIf (UserInput.Alt2Name <> "") And Abs(Abs(UserInput.Alt2Confidence) - Abs(UserInput.Confidence)) < BadConfidence Then
  • ' Bad Confidence - too close to another command
  • Exit Sub
  • Else ' High Confidence
  • ' *** BEGIN MASH USER COMMANDS ***
  • Select Case UserInput.Name
  • Case "ACO"
  • Merlin.play "GestureRight"
  • AgentControl.PropertySheet.Visible = True
  • Case "Poste de Travail"
  • Merlin.play "GestureRight"
  • Merlin.speak "Le Poste de Travail !"
  • objShell.run "Explorer.exe ::{20d04fe0-3aea-1069-a2d8-08002b30309d}"
  • Case "Corbeille"
  • Merlin.play "GestureRight"
  • Merlin.speak "La Corbeille !"
  • objShell.run "Explorer.exe ::{645FF040-5081-101B-9F08-00AA002F954E}"
  • Case "MYDOCS"
  • Merlin.play "GestureRight"
  • Merlin.speak "Mes Documents !"
  • MyDoc = objShell.SpecialFolders("MyDocuments") & "\"
  • objShell.run "Explorer.exe /n,/e,/root,"& MyDoc
  • Case "PROGFILES"
  • objShell.run "Explorer.exe /n,/e,/root,C:\Program Files"
  • Merlin.play "GestureRight"
  • Merlin.speak "Program Files !"
  • Case "APPWIZ"
  • Merlin.play "GestureRight"
  • 'Merlin.play "Announce"
  • Merlin.Speak "Ajouter et Supprimer les Programmes!"
  • objShell.run "CONTROL.EXE APPWIZ.CPL"
  • Case "CALC"
  • Merlin.play "GestureRight"
  • Merlin.speak "Calculatrice!"
  • objShell.run "CALC.EXE"
  • Case "CONTROL"
  • Merlin.play "GestureRight"
  • Merlin.speak "Panneau de Configuration !"
  • objShell.run "CONTROL.EXE"
  • Case "DESKPROP"
  • Merlin.play "GestureRight"
  • Merlin.speak "Propriétés du Bureau !"
  • objShell.run "CONTROL.EXE DESK.CPL"
  • Case "NOTEPAD"
  • Merlin.play "GestureRight"
  • Merlin.speak "Le Bloc-Notes !"
  • objShell.run "NOTEPAD.EXE"
  • Case "Parler"
  • Parler
  • Case "OpenCD"
  • Merlin.play "surprised"
  • Merlin.Speak "J'ouvre maintenant, Votre CD-ROM."
  • wscript.sleep 2000
  • OpenCD
  • Case "CloseCD"
  • Merlin.play "surprised"
  • Merlin.Speak "Je Ferme maintenant, Votre CD-ROM."
  • wscript.sleep 2000
  • CloseCD
  • Case "Stop"
  • Merlin.StopAll
  • 'Merlin.Play "Acknowledge"
  • Merlin.Play "Greet"
  • Merlin.speak "A vos ordres Monsieur Hackoo ! je me suis Calmer maintenant. Je Vais rester Sage comme un Ange!"
  • Case "READPAGE"
  • Merlin.Play "Read"
  • Merlin.Speak document.body.innerText
  • Case "CleanupTmp"
  • Merlin.speak "Recherche et effacement des Fichiers Temporaires de Type, *.Bak et *.Tmp est en Cours. Veuillez Mr Patientez un peu. Merci de votre Compréhension !"
  •  
  • for i=1 to 3
  • Merlin.play "search"
  • next
  • 'Call CleanupTmp
  • for i=1 to 5
  • Merlin.play "Process"
  • next
  • Call CleanupTmp
  • 'wscript.sleep 60000
  • 'Merlin.stopAll
  • 'Merlin.Play "Read"
  • 'Merlin.Speak document.selection.createrange.text
  • Case "SPEECHCP"
  • objShell.run "rundll32.exe shell32.dll,Control_RunDLL speech.cpl,,1"
  • Case "RegSrch"
  • Merlin.speak "Recherche dans la base des Registres !"
  • for i=1 to 4
  • Merlin.play "Search"
  • next
  • call RegSrch
  • for i=1 to 5
  • Merlin.play "Process"
  • next
  •  
  • wscript.sleep 10000
  • Merlin.stopALL
  • Case "SAYTIME"
  • Merlin.play "Announce"
  • wscript.sleep 2000
  • Merlin.Speak "L'heure maintenant, est " & Timevalue(Now) & " !"
  • Case "Info"
  • Call Info
  • Case "Startup"
  • Merlin.play "Announce"
  • Merlin.Speak "Liste des Programmes qui démarre avec Windows !"
  • wscript.sleep 5000
  • Call Ping
  • Call StartupList
  • Case "FreeSpace"
  • Merlin.play "GetAttention"
  • Call FreeSpace
  • Case "Memory"
  • Call Memory
  • Case "Delimprimante"
  • Merlin.play "Announce"
  • Merlin.Speak "Supprimer tous les travaux d'impressions !"
  • wscript.sleep 5000
  • Call Delimprimante
  •  
  • Case "EnableTaskMgr"
  • Merlin.play "GetAttention"
  • 'wscript.sleep 4000
  • Merlin.Speak" Le Gestionnaire des Tâches est Maintenant Activé !"
  • Call EnableTaskMgr
  • Case "DisableTaskMgr"
  • Merlin.play "GetAttention"
  • 'wscript.sleep 4000
  • Merlin.Speak" Le Gestionnaire des Tâches est Maintenant Désactivé !"
  • Call DisableTaskMgr
  • Case "Ip"
  • Merlin.play "Announce"
  • Merlin.Speak "Adresse IP !"
  • 'Call GetTempFile
  • 'Call Ping
  • wscript.sleep 5000
  • call Ip
  • Case "Process"
  • Merlin.play "Announce"
  • Merlin.Speak "Liste des Processus en cours d'exécution !"
  • wscript.sleep 5000
  • call Process
  • Case "Shut"
  • Merlin.play "Announce"
  • Merlin.Speak "Arrêter l'ordinateur aprés un certain delai choisi par l'utilisateur"
  • wscript.sleep 8000
  • wscript.sleep setTimer()
  • call popup
  • Case "NoShut"
  • Merlin.play "Announce"
  • Merlin.Speak "Annuler Arrêter l'ordinateur !"
  • call NoShutdown
  • Case "SelfModif"
  • Merlin.play "Announce"
  • Merlin.Speak "Combien de fois ce programme a été exécuté !"
  • wscript.sleep 5000
  • call SelfModif
  • Case "Exit"
  • Merlin.play "wave"
  • Merlin.Speak "BYE BYE, mâ âssâllamma !!!"
  • wscript.sleep 5000
  • wscript.Quit
  • End Select
  • ' *** END MASH USER COMMANDS ***
  •  
  • If UserInput.Name = "Exit" Then
  • Set HideReq = Merlin.Hide()
  • End If
  • End If
  • End Sub
  •  
  • Sub AgentControl_Bookmark(ByVal BookmarkID)
  • On Error Resume Next
  •  
  • End Sub
  •  
  • Sub AgentIntro()
  • On Error Resume Next
  •  
  • Call InitAgentCommands
  •  
  • ' *** BEGIN MASH USER SCRIPT ***
  •  
  • Merlin.TTSModeID = "{0879A4E1-A92C-11D1-B17B-0020AFED142E}"
  • Merlin.Hide
  • 'WScript.Sleep 2000
  • Merlin.show
  • Merlin.MoveTo 500,200
  • 'Merlin.MoveTo 860, 0
  • Merlin.Play "Acknowledge"
  • Merlin.Play "DoMagic2"
  • Merlin.Speak "Un Clique Droit de la souris sur moi, et je vous montre mon Menu. Je peux Faire Ouvrir, Fermer votre CD-ROM. Ouvrir Le Bloc-Notes. Ouvrir Le Poste de Travail. Ouvrir La Corbeille. Et je peux Donner aussi l'heure. etc..."
  • 'WScript.Sleep 10000
  • Do
  • Merlin.play "Announce"
  • wscript.sleep 3000
  • Merlin.Speak "Bon"& GetTimeOfDay() & " !. L'heure maintenant, est, " & Timevalue(Now) & ". Aujourd'hui est, Le " & GetDay() & ", " & GetDate() & "."
  • WScript.Sleep 3000
  • Merlin.Hide
  • wscript.sleep 900000
  • Merlin.show
  • Loop Until ScriptComplete
  • 'Merlin.Speak "Un Clique Droit de la souris sur moi, et je vous montre mon Menu. Je peux Faire Ouvrir, Fermer votre CD-ROM, Ouvrir Le Bloc-Notes, Ouvrir Le Poste de Travail, Ouvrir La Corbeille, et Donner aussi l'heure, etc..."
  •  
  • ' Merlin.Speak "L'heure maintenant, est, " & Timevalue(Now)
  •  
  •  
  •  
  • ' *** END MASH USER SCRIPT ***
  •  
  • Set EndReq = Merlin.Speak("\mrk=999999999\")
  •  
  • Do
  • WScript.Sleep 1000
  • Loop Until ScriptComplete
  • End Sub
  • '_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/OpenCD()_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
  • sub OpenCD()
  • Dim ts
  • Dim strDriveLetter
  • Dim intDriveLetter
  • Dim fs 'As Scripting.FileSystemObject
  • Const CDROM = 4
  • On Error Resume Next
  • Set fs = CreateObject("Scripting.FileSystemObject")
  • ' Detection des lecteurs de CD
  • strDriveLetter = ""
  • For intDriveLetter = Asc("A") To Asc("Z") 'Limitez aux lecteurs souhaités
  • Err.Clear
  • If fs.GetDrive(Chr(intDriveLetter)).DriveType = CDROM Then
  • If Err.Number = 0 Then
  • strDriveLetter = Chr(intDriveLetter)
  • Exit For
  • End If
  • End If
  • Next
  • ' Ouvrir tous les lecteurs
  • Set owmp = CreateObject("WMPlayer.OCX.7")
  • Set colCDROMs = owmp.cdromCollection
  • For d = 0 To colCDROMs.Count - 1
  • colCDROMs.Item(d).Eject
  • Next
  • Set owmp = Nothing
  • Set colCDROMs = Nothing
  • end sub
  • '_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/CloseCD()_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
  • sub CloseCD()
  • Set wmp = CreateObject("WMPlayer.OCX.7")
  • Set cdroms = wmp.cdromCollection
  • If cdroms.Count >= 1 then
  • For i = 0 to cdroms.Count - 1
  • cdroms.Item(i).Eject
  • Next
  • For i = 0 to cdroms.Count - 1
  • cdroms.Item(i).Eject
  • Next
  • End If
  • end sub
  • '-------------------------------------Parler-------------------------------------------------------------------------------------------
  • sub Parler
  • Input = InputBox("Entrez le texte pour que ce Merlin le Magicien puisse essayer de le prononcer."& vbCrLf & "Attention l'accent est du Anglais donc le resultat peut-etre inattendu","Faire Parler Ordinateur By Hackoo Crackoo")
  • Merlin.play "read"
  • Merlin.speak Input
  • 'Wscript.sleep 1000
  • voix.speak Input
  • end sub
  • '-----------------------------------------------------------------------------------------
  • sub CleanupTmp()
  • '*********************************************************
  • '* Effacer les fichiers temporaires *
  • '* DOCmémo - www.docmemo.com *
  • '*********************************************************
  •  
  • strComputer = "."
  • strCompteur = 0
  • Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
  • Set colFiles = objWMIService.ExecQuery ("Select * from CIM_DataFile where Extension = 'bak' OR Extension = 'tmp'")
  • For Each objFile in colFiles
  • objFile.Delete
  • strCompteur = strCompteur + 1
  • Next
  • MsgBox "Terminé!" & vbCR & strCompteur & " fichiers effacés",64,"Suppression des fichiers temporaires"
  •  
  • end sub
  • '--------------------------------RegSrch---------------------------------------------------
  • sub RegSrch
  • Dim oWS : Set oWS = CreateObject("WScript.Shell")
  • Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
  •  
  • Dim sSearchFor
  • sSearchFor = InputBox("Ce Programme va Rechercher dans votre base de Registre et trouver tous " & _
  • "les instances du mot saisi." & vbcrlf & vbcrlf & _
  • "Cette Recherche peut prendre plusieurs minutes, alors il faut être patient." & _
  • vbcrlf & vbcrlf & "Entrez le mot à rechercher " & _
  • "cliquer OK...", WScript.ScriptName & " " & Chr(169) & " Hackoo Crackoo")
  •  
  • If sSearchFor = "" Then Cleanup()
  •  
  • Dim StartTime : StartTime = Timer
  •  
  • Dim sRegTmp, sOutTmp, eRegLine, iCnt, sRegKey, aRegFileLines
  •  
  • sRegTmp = oWS.Environment("Process")("Temp") & "\RegTmp.tmp "
  • sOutTmp = oWS.Environment("Process")("Temp") & "\sOutTmp" & _
  • Hour(Now) & Minute(Now) & Second(Now) & ".tmp "
  •  
  • oWS.Run "regedit /e /a " & sRegTmp, , True '/a enables export as Ansi for WinXP
  •  
  • With oFSO.OpenTextFile(sOutTmp, 8, True)
  • .WriteLine("REGEDIT4" & vbcrlf & "; " & WScript.ScriptName & " " & _
  • Chr(169) & " Hackoo Crackoo" & vbcrlf & vbcrlf & "; Résultat de la Recherche pour le " & _
  • "mot " & Chr(34) & sSearchFor & Chr(34) & " " & Now & _
  • vbcrlf & vbcrlf & "; NOTE: Ce Fichier va être supprimer si vous ne le sauvegarder pas avec " & _
  • "WordPad." & vbcrlf & "; Vous avez interêt de le sauvgarder vers un nouveau " & _
  • "emplaçement si vous-voulez l'utiliser aprés." & vbcrlf & "; (si " & _
  • "vous sauvegarder le fichier avec l'extension .reg , Vous Pouvez l'utiliser pour restaurer " & _
  • "chaque changement de Registre que vous faites pour ces valeurs.)" & vbcrlf)
  • '---------------------------------------------------------------------------------------------------------------------------
  • 'ForReading 1 Ouvre un fichier en lecture seule. Vous ne pouvez écrire dans ce fichier.
  • 'ForWriting 2 Ouvre un fichier en mode écriture. Si un fichier portant le même nom existe, son contenu antérieur est écrasé.
  • 'ForAppending 8 Ouvre un fichier et écrit à la fin de celui- ci.
  •  
  • 'TristateUseDefault -2 Ouvre le fichier en utilisant le paramètre système par défaut.
  • 'TristateTrue -1 Ouvre le fichier au format Unicode.
  • 'TristateFalse 0 Ouvre le fichier au format ASCII.
  • 'OpenAsTextStream(1, 0) donc est ouvert en lecture seule et au format ASCII
  • '---------------------------------------------------------------------------------------------------------------------------
  • With oFSO.GetFile(sRegTmp)
  • aRegFileLines = Split(.OpenAsTextStream(1, 0).Read(.Size), vbcrlf)
  • End With
  • 'oWS.Run "WordPad " & sRegTmp, 3, True
  • oFSO.DeleteFile(sRegTmp)
  • '-------------------------------------------------------------------------------------------------------------
  • 'Exemple comment utiliser la Fonction Instr
  • 'Dim SearchString, SearchChar, MyPos
  • 'SearchString ="XXpXXpXXPXXP" ' Chaîne dans laquelle rechercher.
  • 'SearchChar = "P" ' Recherche "P".
  • 'MyPos = Instr(4, SearchString, SearchChar, 1) ' Comparaison textuelle commençant à la position 4. Renvoie 6.
  • 'MyPos = Instr(SearchString, SearchChar) ' La comparaison est binaire par défaut (le dernier argument est omis). Renvoie 9.
  • 'MyPos = Instr(1, SearchString, "W") ' Comparaison binaire commençant à la position 1. Renvoie 0 ("W" est introuvable).
  • '--------------------------------------------------------------------------------------------------------------
  • For Each eRegLine in aRegFileLines
  • If InStr(1, eRegLine, "[", 1) > 0 Then sRegKey = eRegLine
  • If InStr(1, eRegLine, sSearchFor, 1) > 0 Then
  • If sRegKey <> eRegLine Then
  • .WriteLine(vbcrlf & sRegKey) & vbcrlf & eRegLine
  • Else
  • .WriteLine(vbcrlf & sRegKey)
  • End If
  • iCnt = iCnt + 1
  • End If
  • Next
  •  
  • Erase aRegFileLines
  •  
  • If iCnt < 1 Then
  • oWS.Popup "Recherche complétée dans " & FormatNumber(Timer - StartTime, 0) & " seconds." & _
  • vbcrlf & vbcrlf & "Pas instances de " & chr(34) & sSearchFor & chr(34) & _
  • " Trouvé.",, WScript.ScriptName & " " & Chr(169) & " Hackoo Crackoo", 4096
  • .Close
  • oFSO.DeleteFile(sOutTmp)
  • Cleanup()
  • End If
  • .Close
  •  
  • End With
  •  
  • oWS.Popup "Recherche complétée dans " & FormatNumber(Timer - StartTime, 0) & " seconds." & _
  • vbcrlf & vbcrlf & iCnt & " instances de " & chr(34) & sSearchFor & chr(34) & _
  • " Trouvé." & vbcrlf & vbcrlf & "Clicque sur OK pour ouvrir les Résultas dans WordPad.",, _
  • WScript.ScriptName & " " & Chr(169) & " Hackoo Crackoo", 4096
  •  
  • oWS.Run "WordPad " & sOutTmp, 3, True
  •  
  • oFSO.DeleteFile(sOutTmp)
  • End Sub
  •  
  •  
  • '*************************************************************
  • '* Affiche les informations concernant la version de Windows *
  • '* DOCmémo - www.docmemo.com *
  • '*************************************************************
  • Sub Info()
  • Set dtmConvertedDate = CreateObject("WbemScripting.SWbemDateTime")
  • strComputer = "."
  • strResultat=""
  • Set objWMIService = GetObject("winmgmts:" _
  • & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
  • Set colOperatingSystems = objWMIService.ExecQuery _
  • ("Select * from Win32_OperatingSystem")
  • For Each objOperatingSystem in colOperatingSystems
  • strResultat=strResultat & objOperatingSystem.Caption & vbCR
  • strResultat=strResultat & "Version: " & objOperatingSystem.Version & vbCR
  • strResultat=strResultat & "Numéro de série: " & objOperatingSystem.SerialNumber & vbCR
  • strResultat=strResultat & "Langue: " & objOperatingSystem.OSLanguage & vbCR
  • strResultat=strResultat & "Code pays: " & objOperatingSystem.CountryCode & vbCR
  • strResultat=strResultat & "Utilisateur enregistré: " & objOperatingSystem.RegisteredUser & vbCR
  • strResultat=strResultat & "Organisation: " & objOperatingSystem.Organization & vbCR
  • dtmConvertedDate.Value = objOperatingSystem.InstallDate
  • dtmInstallDate = dtmConvertedDate.GetVarDate
  • strResultat=strResultat & "Date installation: " & dtmInstallDate & vbCR
  • Next
  • Merlin.speak strResultat
  • wscript.sleep 30000
  • MsgBox strResultat,64, "les informations concernant la version de Windows"
  • end sub
  •  
  • '*********************************************************
  • '* Mémoire vive et mémoire virtuelle *
  • '* DOCmémo - www.docmemo.com *
  • '*********************************************************
  • Sub Memory()
  • strComputer = "."
  • Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
  • Set colCSItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem")
  • Resultat = ""
  • For Each objCSItem In colCSItems
  • Resultat=Resultat & "Mémoire physique totale (RAM) : " & objCSItem.TotalPhysicalMemory & " octets ou " & Round(objCSItem.TotalPhysicalMemory/1024/1024,2) & " Mo." & vbCR
  • Next
  • Set colOSItems = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem")
  • For Each objOSItem In colOSItems
  • Resultat=Resultat & "Mémoire physique libre : " & objOSItem.FreePhysicalMemory & " octets ou " & Round(objOSItem.FreePhysicalMemory/1024/1024,2) & " Mo." & vbCR
  • Resultat=Resultat & "Mémoire virtuelle totale (fichier d'échange) : " & objOSItem.TotalVirtualMemorySize & " octets ou " & Round(objOSItem.TotalVirtualMemorySize/1024/1024,2) & " Mo." & vbCR
  • Resultat=Resultat & "Mémoire virtuelle libre : " & objOSItem.FreeVirtualMemory & " octets ou " & Round(objOSItem.FreeVirtualMemory/1024/1024,2) & " Mo." & vbCR
  • Next
  • Merlin.Speak Resultat
  • wscript.sleep 40000
  • MsgBox Resultat ,64, "Mémoire vive et mémoire virtuelle"
  • end sub
  • '-----------------------------Shortcut()--------------------------------------
  • 'sub Shortcut()
  • 'dim shell,startupPath,link,temp,FSO
  • 'Set Shell = CreateObject("WScript.Shell")
  • 'startupPath = Shell.SpecialFolders("startup")
  • 'Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
  • 'temp=FSO.GetSpecialFolder(2)
  • 'Set link = Shell.CreateShortcut(startupPath & "\Merlin.lnk")
  • 'link.Description = "Merlin"
  • 'link.IconLocation = "magnify.exe, 0"
  • 'link.TargetPath = temp & "\Merlin.vbs"
  • 'link.WorkingDirectory = temp
  • 'link.Save
  • 'end sub
  • '----------------------------SpreadTo(x,name)----------------------------------
  • 'sub SpreadTo(x,name)
  • 'dim File,fso
  • 'Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
  • 'File = Wscript.ScriptFullName
  • 'fso.copyfile file ,x & "\" & name & ".vbs"
  • 'end sub
  • '-----------------------------GetIp--------------------------------------------
  • sub Ip()
  • Dim WshShell,obj,Command,Result,Temp,FileName,File,Ping
  • Set obj = WScript.CreateObject("Scripting.FileSystemObject")
  • Set WshShell=WScript.CreateObject("WScript.Shell")
  • 'GetTempFile=WshShell.ExpandEnvironmentStrings("%TEMP%") & "\" & "ip.txt"
  • FileName=GetTempFile("ip.txt")
  • Command = "%COMSPEC% /C ipconfig > %TEMP%\ip.txt"
  • Result = WshShell.Run(Command,0,True)
  • Temp = obj.GetSpecialFolder(2).Path
  • Set File = obj.OpenTextFile(FileName)
  • Ping = file.ReadAll
  • file.Close
  • Result = Ping
  • MsgBox Result,64," Adresse IP !" '
  • end sub
  • '------------------------------EnableTaskMgr----------------------------------------
  • sub EnableTaskMgr
  • Dim WshShell,System
  • System="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\"
  • Set WshShell=WScript.CreateObject("WScript.Shell")
  • Wshshell.RegWrite System, "REG_SZ"
  • WshShell.RegWrite System &"\DisableTaskMgr", 0, "REG_DWORD"
  • end sub
  • '-----------------------------DisableTaskMgr----------------------------------------
  • sub DisableTaskMgr
  • Dim WshShell,System
  • System="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\"
  • Set WshShell=WScript.CreateObject("WScript.Shell")
  • Wshshell.RegWrite System, "REG_SZ"
  • WshShell.RegWrite System &"\DisableTaskMgr", 1, "REG_DWORD"
  • end sub
  • '--------------------------------SetTimer-------------------------------------------
  • Function SetTimer()
  • Dim MinSpec,Timer
  • MinSpec = InputBox(ErrMsg & vbcrlf & "Enter number of minutes until " & _
  • "Shutdown. You will have an option to cancel " & _
  • "shutdown for 1 minute before time elapses.",Title)
  • If MinSpec = "" Then
  • Cleanup
  • ElseIf Not IsNumeric(MinSpec) Then
  • ErrMsg = "Invalid Selection!" & vbcrlf & vbcrlf
  • SetTimer()
  • ElseIf MinSpec < 1 Then
  • ErrMsg = "Invalid Selection!" & vbcrlf & vbcrlf
  • SetTimer()
  • Else
  • If MinSpec > 1 Then
  • Timer = (MinSpec - 1)/1000/60
  • SetTimer = (MinSpec - 1) * 1000 * 60
  • Else
  • Timer = MinSpec/1000/60
  • SetTimer = MinSpec * 1000 * 60
  • End If
  • End If
  • End Function
  • '------------------------------------------------------------------------------------
  • Sub ShutDownNow()
  • Const EWX_LOGOFF = 0
  • Const EWX_SHUTDOWN = 1
  • Const EWX_REBOOT = 2
  • Const EWX_FORCE = 4
  • Const EWX_POWEROFF = 8
  • Dim temps
  • Set ws = CreateObject("Wscript.Shell")
  •  
  • 'Last chance to abort shutdown.
  • If WS.popup("Shutting down in 1 minute (" & TimeValue(DateAdd("n",1, Now())) & ")." & _
  • vbcrlf & vbcrlf & "Click Cancel to abort shutdown, click OK to shutdown now.",_
  • 64, Title, 1 + 256 + 48 + 4096 ) = 2 Then
  • temps=TimeValue(DateAdd("n",1, Now()))
  • 'if MsgBox "Shutting down in 1 minute "& temps,64,"Hackoo Crackoo" = 2 Then
  • Msgbox "No reboot"
  • Call Cleanup
  • Else
  • ShutDown
  • End If
  • End Sub
  •  
  • Sub Cleanup
  • Set ws = Nothing
  • WScript.Quit
  • End Sub
  •  
  • Function ShutDown()
  • Set WS = CreateObject("WScript.Shell")
  • Command = "cmd /C shutdown -s -t 300 -c shutdown"
  • Result = Ws.Run(Command,0,True)
  • End Function
  • '*****************************************************
  • '* L'espace total et l'espace libre sur les lecteurs *
  • '* DOCmémo - www.docmemo.com *
  • '*****************************************************
  • sub FreeSpace()
  • strComputer = "."
  • Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
  • resultat=""
  • Set Disques = objWMIService.ExecQuery ("Select * from Win32_LogicalDisk Where DriveType = 3")
  • For Each objetDisque in Disques
  • EspaceLibre = objetDisque.FreeSpace
  • EspaceTotal = objetDisque.Size
  • EspaceLibrePc = EspaceLibre / EspaceTotal
  • resultat=resultat & "Lecteur " & objetDisque.DeviceID & vbCR
  • resultat=resultat & "Espace total : " & round(EspaceTotal/1073741824,2) & " Go" & vbcr
  • resultat=resultat & "Espace libre : " & round(EspaceLibre/1073741824,2) & " Go" & " (" & FormatPercent(EspaceLibrePc) &")" & vbcr & vbcr
  • Next
  • Merlin.speak resultat
  • wscript.sleep 25000
  • msgbox resultat,vbInformation,"Les lecteurs"
  • end sub
  • '--------------------------------------------WriteCode(sIn)--------------------------------------------------------------------------------
  • Function WriteCode(sIn)
  • 'If LCase(FileExt) = "htm" OR LCase(FileExt) = "html" Then
  • WriteCode = sIn & "<html><body bgcolor=#000000 text=#Green><br>"
  • 'Else
  • 'WriteCode = sIn
  • 'End If
  • End Function
  • '-----------------------------------------------Ping()-------------------------------------------------------------------------------------------
  • Function Ping()
  • FileName=GetTempFile("ip.txt")
  • ver="%COMSPEC% /C ver > %TEMP%\ip.txt"
  • Command = "%COMSPEC% /C ipconfig/all >> %TEMP%\ip.txt"
  • command2= "%COMSPEC% /C netstat -an -p TCP >> %TEMP%\ip.txt"
  • Resultver=WshShell.Run(ver,0,True)
  • Result = WshShell.Run(Command,0,True)
  • Result2 = WshShell.Run(Command2,0,True)
  • Temp = obj.GetSpecialFolder(2).Path
  • Set File = obj.OpenTextFile(FileName)
  • Ping = file.ReadAll
  • file.Close
  • 'set openipw = obj.openStreamFile(temp &"\Startup.htm", 8,True) 'For Writing
  • 'openipw.write ping
  • 'obj.DeleteFile FileName,True
  • End Function
  • '------------------------------GetTempFile(File)------------------------------------
  • Function GetTempFile(File)
  • Set WshShell=WScript.CreateObject("WScript.Shell")
  • GetTempFile=WshShell.ExpandEnvironmentStrings("%TEMP%") & "\" & File
  • End Function
  • '---------------------------------StartupList---------------------------------------
  • Sub StartupList
  • Dim WshShell,obj,Command,Result,Temp,FileName,File,ver,Resultver
  • Set obj = WScript.CreateObject("Scripting.FileSystemObject")
  • Set WshShell=WScript.CreateObject("WScript.Shell")
  •  
  • ' **************************Advanced User Tweaks**************************
  • ' The FileExt variable can be used to change the default output format
  • ' Suggestions: htm, doc, rtf. If not specified, defaults to .txt
  • FileExt = "" : If FileExt = "" Then FileExt = "htm"
  •  
  • ' The OpenWith variable is optional, to open results in specific program
  • ' If variable is empty, Windows will use default program for FileExt type
  • OpenWith = "" : If OpenWith <> "" Then OpenWith = Trim(OpenWith) & " "
  • ' ************************************************************************
  •  
  • With CreateObject("WScript.Network")
  • ComputerName = .ComputerName
  • UserName = .UserName
  • End With
  •  
  • Set fso = CreateObject("Scripting.FileSystemObject")
  • Set ws = CreateObject("WScript.Shell")
  • TmpFile = ws.ExpandEnvironmentStrings("%TEMP%") & "\Startup." & Trim(FileExt)
  • temp=FSO.GetSpecialFolder(2)
  • set lit = fso.OpenTextFile(temp &"\ip.txt", 1,True) 'For Reading
  •  
  • With fso.CreateTextFile(TmpFile, True)
  • .WriteLine "<center>INFORMATIONS SUR ORDINATEUR : " & ComputerName & ", Utilisateur : " & UserName & " @ " & Now() &"</center>"
  •  
  • '.WriteLine WriteCode("")
  •  
  • Do While Not lit.AtEndOfStream
  • oneline = lit.readline
  • 'MsgBox("Ligne lue: " & oneline)
  • .writeline "<html><body bgcolor=#000000 text=#Green><br>"
  • .writeline oneline
  • loop
  • For Each o in GetObject _
  • ("winmgmts:\\" & ComputerName & "\root\cimv2").ExecQuery(_
  • "Select Name, Command, User, Location from Win32_StartupCommand",,48)
  • If LCase(o.Command) <> "desktop.ini" _
  • AND LCase(o.User) <> ".default" _
  • AND InStr(LCase(o.User), "nt authority") = 0 Then
  • .Writeline "<br><br>"
  • .WriteLine WriteCode("Name: " & o.Name)
  • .WriteLine WriteCode("Command: " & o.Command)
  • .WriteLine WriteCode("User: " & o.User)
  • .WriteLine WriteCode("Startup Location: " & o.Location)
  • '.WriteLine WriteCode("")
  • Else
  • s = s & vbcrlf & WriteCode("Name: " & o.Name)
  • s = s & vbcrlf & WriteCode("Command: " & o.Command)
  • s = s & vbcrlf & WriteCode("User: " & o.User)
  • s = s & vbcrlf & WriteCode("Startup Location: " & o.Location)
  • s = s & WriteCode("") & vbcrlf
  • End If
  • Next
  •  
  • If s <> "" Then
  • .WriteLine WriteCode(String(60, "*"))
  • .WriteLine WriteCode("Additional non-relevant item(s) " & _
  • "in the Startup configuration:")
  • .WriteLine s
  • .WriteLine WriteCode("")
  • End If
  • '.WriteLine WriteCode("NOTE: This file will be deleted when you close " & _
  • '"it. If you wish to retain this information, " & _
  • ' "Print it or use File, Save As...")
  • '.WriteLine WriteCode("")
  • '.WriteLine WriteCode("(Startup list generated using " & _
  • ' "StartupList.vbs - © Bill James)")
  • '.Write pinghtml
  • .Close
  • End With
  • ws.Run OpenWith & TmpFile,,True
  • End sub
  •  
  • '----------------------------------------------------------------------------------*
  • '-------------------------------Liste des Processus--------------------------------*
  • ' ---------------------------------------------------------------------------------*
  • ' Script d'affichage détaillé des processus en cours
  • ' sur une machine locale ou distante
  • ' Fait appel à Internet Explorer pour la saisie
  • ' des paramètres et l'affichage des résultats
  • '
  • ' Jean-Claude BELLAMY © 2002
  • ' ---------------------------------------------------------------------------------*
  • SUB Process
  • Dim args, network, computer, fso, ts, tparam, tPrint, oIE, fExec, user,domain, system,process
  • Set network = Wscript.CreateObject("WScript.Network")
  • Set Shell = WScript.CreateObject("WScript.Shell")
  • ' Création du fichier HTML qui va servir de formulaire
  • fichtml=GetPath() & "processlist.html"
  • ficparam=GetPath() & "processlist.cfg"
  • ficprint=GetPath() & "processlist.txt"
  •  
  • local=lcase(network.ComputerName)
  • Set args=Wscript.Arguments
  • If args.count>0 Then
  • computer=lcase(args(0))
  • Else
  • computer=local
  • End If
  • If computer=local Then typeordi="local" else typeordi="distant"
  • RootTitle="Liste des processus sur " & computer & " (" & typeordi & ")"
  • Set fso = WScript.CreateObject("Scripting.FileSystemObject")
  • Set ts = fso.CreateTextFile(fichtml, True)
  • isparam=false
  • If fso.FileExists(ficparam) Then
  • Set tparam=fso.OpenTextFile(ficparam)
  • isparam=true
  • End If
  • '================ Choix des paramètres ================
  • WriteHTMLHeader
  • header="Paramètres à afficher dans "
  • header=header & "<input type=""checkbox"" name=""ie"" value=""ie"" checked >IE"
  • ' test d'existence de Excel
  • On Error Resume Next
  • ReadKey=shell.RegRead("HKEY_CLASSES_ROOT\.xls\")
  • If Err.Number=0 Then header=header & "<input type=""checkbox"" name=""excel"" value=""excel"" >Excel"
  • On error goto 0
  • header=header & "<input type=""checkbox"" name=""notepad"" value=""notepad"" >Bloc-notes"
  • ts.writeline "<b>" & header & " :</b><p>"
  • ts.writeline "<table>"
  • objet="Win32_Process"
  • Set System = GetObject("winmgmts:" & objet)
  • n=0
  • ncol=3
  • dim prop()
  • for each Property in System.Properties_
  • AddProp Property.Name
  • next
  • ' Ajout des méthodes GetOwner et GetOwnerSid"
  • AddProp "GetOwner"
  • AddProp "GetOwnerSid"
  • r=ncol-(n mod ncol)
  • If r<>ncol Then
  • For i = 1 To r
  • ts.writeline "<td></td>"
  • Next
  • ts.writeline "</tr>"
  • end if
  • ts.writeline "</table>"
  • WriteHTMLBottom "Afficher","Fermer"
  •  
  • If isParam Then tParam.Close
  • RunIE 600,600,true
  •  
  • DisplayIE=false
  • DisplayExcel=false
  • DisplayNotepad=false
  • if oIE.Document.processlistForm.IE.Checked then DisplayIE=true
  • if oIE.Document.processlistForm.Excel.Checked then DisplayExcel=true
  • if oIE.Document.processlistForm.Notepad.Checked then DisplayNotepad=true
  •  
  • Set tParam = fso.CreateTextFile(ficparam, True)
  • ' Utilisation de la fonction execute afin de créer dynamiquement
  • ' des commandes faisant intervenir des noms de champs variables
  • dim f(), res()
  • redim f(n), res(n)
  • lmax=0
  • for i = 0 to n-1
  • f(i) = "function testparam() " & vbcrlf
  • f(i) = f(i) & "testparam=0" & vbcrlf
  • f(i) = f(i) & "if oIE.Document.processlistForm.param" & i &".Checked then testparam=1" & vbcrlf
  • f(i) = f(i) & "end function" & vbcrlf
  • execute f(i)
  • res(i)=testparam()
  • state=""
  • If res(i)=1 Then
  • state="Checked"
  • l=len(prop(i))
  • If lmax<l then lmax=l
  • end if
  • tParam.writeline state
  • next
  • oIE.Quit
  • tParam.close
  •  
  • '================ Affichage des résultats ================
  • Set ts = fso.CreateTextFile(fichtml, True)
  • If DisplayExcel Then
  • Dim objXL
  • Set objXL = WScript.CreateObject("Excel.Application")
  • objXL.Workbooks.Add
  • objXL.Cells(1,1).Value = Titre
  • objXL.Visible = True
  • End If
  •  
  • If DisplayNotepad Then
  • Set tPrint = fso.CreateTextFile(ficprint, True)
  • tprint.writeline Titre
  • tprint.WriteBlankLines(1)
  • end if
  • WriteHTMLHeader
  • ts.writeline "<b>Liste des processus<b> (" & date & " " & time & ")<br>"
  • ts.writeline "<table border=""1"" cellspacing=""1"" cellpadding=""2"" style=""border-collapse: collapse"" bordercolor=""#111111"">"
  • ts.writeline "<tr>"
  • first=true
  • nl=2
  • nc=0
  • ts.writeline "<td bgcolor=""#C0C0C0"" valign=""top"">Terminer</td>"
  • For i= 0 To n-1
  • If res(i)=1 Then
  • If DisplayNotepad then
  • If not first Then tprint.write chr(9) else first=false
  • tprint.write prop(i)
  • end if
  • nc=nc+1
  • If DisplayExcel Then objXL.Cells(nl,nc).Value = prop(i)
  • comment=""
  • If lcase(prop(i))="executablepath" Then
  • comment="<br><i>Cliquer sur un lien pour afficher<br>le fichier dans l'explorateur</i>"
  • end if
  • ts.writeline "<td bgcolor=""#C0C0C0"" valign=""top"">" & prop(i) & comment & "</td>"
  • End If
  • Next
  • ts.writeline "</tr>"
  • If DisplayNotepad Then tprint.WriteBlankLines(2)
  •  
  • Set System=GetObject ("winmgmts:{impersonationLevel=impersonate}!//" & Computer).InstancesOf(objet)
  • nl=2
  • nc=0
  • nproc=0
  • dim ProcState(),ProcNum()
  • for each Process in System
  • nl=nl+1
  • first=true
  • SetKill Process.Handle
  • ts.writeline "<tr><a name=""" & Process.Handle & """>"
  • ts.writeline "<td align=""center""><input type=""button"" value=""M"" style=""font-family: Wingdings"" name=""" & Process.Handle & """ onClick='Kill("""& Process.Handle & """)'></td>"
  • nc=0
  • For i= 0 To n-3
  • If res(i)=1 Then
  • var ="Process." & prop(i)
  • valeur=eval(var)
  • If IsNull(valeur) Then valeur=""
  • link=""
  • If prop(i)="ExecutablePath" and valeur<>"" Then
  • filename=valeur
  • If computer<>local Then filename="\\" & computer & "\" & Replace(filename, ":", "$")
  • link="<a href=""#" & Process.Handle & """ onClick='Explore("""& filename & """)'>"
  • End If
  • addProcess 0,valeur,link
  • End If
  • Next
  • If res(n-2)=1 Then
  • result=Process.GetOwner(user,domain)
  • addProcess result, user & "/" & domain,""
  • end if
  • If res(n-1)=1 Then
  • result=Process.GetOwnerSid(SID)
  • addProcess result, SID,""
  • end if
  • ts.writeline "</tr>"
  • If DisplayNotepad Then tprint.writeline ""
  • next
  •  
  • If DisplayExcel Then
  • objXL.Rows("2:2").Select
  • objXL.Selection.Font.Bold = True
  • d1=int((nc-1)/26)
  • d2=((nc-1) mod 26)
  • If d1=0 Then l1max="" else l1max=chr(Asc("A")+d1-1)
  • l2max=chr(Asc("A")+d2)
  • objXL.Columns("A:" & l1max & l2max).Select
  • objXL.Selection.Columns.AutoFit
  • objXL.Rows("1:1").Select
  • objXL.Selection.Font.Bold = True
  • objXL.Selection.Font.Size = 12
  • end if
  •  
  • ts.writeline "</table>"
  •  
  • If DisplayNotepad Then
  • tprint.close
  • commande=shell.ExpandEnvironmentStrings("%windir%\notepad.exe " & chr(34) & ficprint & chr(34))
  • shell.Run commande, 1
  • end if
  •  
  • If DisplayIE Then
  • WriteHTMLBottom "","Fermer"
  • RunIE 600,400,false
  • End If
  •  
  • Wscript.quit
  • END SUB
  • '------------------------------------------------------------
  • Function FormatStr(ch,lmax)
  • l=len(ch)
  • If l<lmax Then
  • For k = l+1 To lmax
  • ch=ch & " "
  • Next
  • End If
  • FormatStr=ch
  • End Function
  • '------------------------------------------------------------
  • ' Fonction de récupération du répertoire courant
  • Function GetPath()
  • Dim path,temp,FSO
  • set fso =CreateObject("Scripting.FileSystemObject")
  • temp=fso.GetSpecialFolder(2) & "\"
  • 'path = WScript.ScriptFullName
  • 'GetPath = Left(temp, InStrRev(temp, "\"))
  • Getpath=temp
  • End Function
  • '------------------------------------------------------------
  • Sub WriteHTMLHeader
  • fichtml=GetPath() & "processlist.html"
  • Set ts = fso.CreateTextFile(fichtml, True)
  • ts.writeline "<html>"
  • ts.writeline "<head>"
  • ts.writeline "<title>" & Titre & "</title>"
  • ts.writeline "<STYLE TYPE=""text/css"">"
  • ts.writeline " body {"
  • ts.writeline " font-family: Verdana;"
  • ts.writeline " font-size: 8 pt }"
  • ts.writeline " h1, h2, h3, h4, h5, h6 { font-family: Verdana }"
  • ts.writeline "table {"
  • ts.writeline " table-border-color-light: rgb(102,204,204);"
  • ts.writeline " table-border-color-dark: rgb(0,102,102);"
  • ts.writeline " font-size: 8 pt;"
  • ts.writeline " font-family: Verdana }"
  • ts.writeline "</STYLE>"
  • ts.writeline "</head>"
  • ts.writeline "<body bgcolor=""#FFFFD2"">"
  • ts.writeline "<script language=""VBScript""> "
  • ts.writeline "<!--"
  • ts.writeline "Dim ready,flagfile,file,flagkill,ID"
  • ts.writeline "Sub B0_OnClick"
  • ts.writeline "ready=-1"
  • ts.writeline "End Sub"
  • ts.writeline "Sub B1_OnClick"
  • ts.writeline "ready=1"
  • ts.writeline "End Sub"
  •  
  • ts.writeline "Sub Window_OnLoad()"
  • ts.writeline "ready=0"
  • ts.writeline "flagfile=0"
  • ts.writeline "flagkill=0"
  • ts.writeline "file="""""
  • ts.writeline "ID=0"
  • ts.writeline "End Sub"
  •  
  • ts.writeline "Public Function CheckVal()"
  • ts.writeline "CheckVal=ready"
  • ts.writeline "End function"
  •  
  • ts.writeline "Public Function CheckFile()"
  • ts.writeline "CheckFile=flagfile"
  • ts.writeline "End function"
  •  
  • ts.writeline "Public Function CheckID()"
  • ts.writeline "CheckID=flagkill"
  • ts.writeline "End function"
  •  
  • ts.writeline "Public Sub ResetFile()"
  • ts.writeline "flagFile=0"
  • ts.writeline "End sub"
  •  
  • ts.writeline "Public Sub ResetID()"
  • ts.writeline "flagkill=0"
  • ts.writeline "End sub"
  •  
  • ts.writeline "Public Function GetFile()"
  • ts.writeline "GetFile=file"
  • ts.writeline "End function"
  •  
  • ts.writeline "Public Function GetID()"
  • ts.writeline "GetID=ID"
  • ts.writeline "End function"
  •  
  • ts.writeline "function Explore(filename)"
  • ts.writeline "flagfile=1"
  • ts.writeline "file=filename"
  • ts.writeline "End function"
  •  
  • ts.writeline "function Kill(handle)"
  • ts.writeline "flagkill=1"
  • ts.writeline "ID=handle"
  • ts.writeline "End function"
  •  
  • ts.writeline "'-->"
  • ts.writeline "</script>"
  • ts.writeline "<form name=""processlistForm"">"
  • ts.writeline "<h3><center>Ordinateur " & typeordi & " " & Computer & "</center></h3><hr>"
  • End Sub
  • ' -------------------------------------
  • Sub WriteHTMLBottom(B1,B0)
  • fichtml=GetPath() & "processlist.html"
  • Set ts = fso.CreateTextFile(fichtml, True)
  • ts.writeline "<br>"
  • If B1<>"" Then ts.writeline "<input type=""button"" value=""" & B1 & """ name=""B1"">"
  • If B0<>"" Then ts.writeline "<input type=""button"" value=""" & B0 & """ name=""B0"">"
  • ts.writeline "</form>"
  • ts.writeline "</body>"
  • ts.writeline "</html>"
  • ts.Close
  • End Sub
  • ' -------------------------------------
  • Sub RunIE(W,H,testclose)
  • ' Ouverture d'Internet Explorer
  • Set oIE = WScript.CreateObject("InternetExplorer.Application", "IE_")
  • oIE.Left = 350
  • oIE.Top = 150
  • oIE.Height = H
  • oIE.Width = W
  • oIE.MenuBar = 0
  • oIE.ToolBar = 0
  • oIE.StatusBar = 1
  • oIE.navigate fichtml
  • oIE.Visible = 2
  • Do While (oIE.Busy)
  • WScript.Sleep 200
  • Loop
  • shell.AppActivate Titre
  •  
  • ' Attente d'action sur le bouton ou fermeture de la fenêtre
  • On Error Resume Next
  • Do
  • WScript.Sleep 100
  • If oIE.Document.Script.CheckFile()<>0 Then
  • path=oIE.Document.Script.GetFile()
  • oIE.Document.Script.ResetFile
  • If path<>"" Then Shell.run "explorer /select," & path,1
  • End If
  • If oIE.Document.Script.CheckID()<>0 Then
  • ID=oIE.Document.Script.GetID()
  • oIE.Document.Script.ResetID
  • If ID<>0 Then
  • If GetStateKill(ID)=0 Then
  • MsgBox "Le processus " & ID & " n'existe plus", vbExclamation,"Terminaison de processus"
  • Else
  • rep=MsgBox("Etes-vous sûr de terminer le processus " & ID & "?", vbYesNo + vbQuestion,"Terminaison de processus")
  • If rep=vbYes Then
  • result=killprocess(ID)
  • If result=0 Then CancelKill(ID)
  • end if
  • End If
  • end if
  • End If
  • Loop While (oIE.Document.Script.CheckVal() = 0)
  • ' Si on ferme directement IE sans passer par un bouton,
  • ' cela provoque une erreur qui est détectée et alors
  • ' on quitte le script
  • If Err <> 0 Then
  • If testclose Then
  • Wscript.quit
  • else
  • On Error goto 0
  • exit sub
  • end if
  • end if
  • test=oIE.Document.Script.CheckVal()
  • If test=-1 Then
  • oIE.Quit
  • If testclose Then Wscript.quit
  • end if
  • On Error goto 0
  • End Sub
  • ' -------------------------------------
  • Sub AddProp(ch)
  • n=n+1
  • redim preserve prop(n)
  • prop(n-1)=ch
  • state=""
  • If isParam then If not tParam.AtEndOfStream Then state=tParam.ReadLine
  • If ((n-1) mod ncol)=0 Then ts.writeline "<tr>"
  • ts.writeline "<td><input type=""checkbox"" name=""param" & n-1 &""" value=""" & prop(n-1) & """ " & state & ">" & prop(n-1) & "</td>"
  • If (n mod ncol)=0 Then ts.writeline "</tr>"
  • End Sub
  • ' -------------------------------------
  • Sub AddProcess(result,ch, chlink)
  • tag=""
  • If IsNumeric(ch) Then tag=" align=""right"""
  • ts.writeline "<td" & tag & ">"
  • If result=0 Then
  • If chlink<>"" Then ts.writeline chlink
  • ts.writeline ch
  • If chlink<>"" Then ts.writeline "</a>"
  • end if
  • ts.writeline "</td>"
  • If DisplayNotepad Then
  • If not first Then tprint.write chr(9) else first=false
  • If result=0 Then tprint.write ch
  • end if
  • nc=nc+1
  • If DisplayExcel and result=0 Then objXL.Cells(nl,nc).Value = ch
  • End Sub
  • ' -------------------------------------
  • Function Titre
  • Titre=rootTitle & " " & Date & " " & Time
  • End Function
  • ' -------------------------------------
  • Function KillProcess(ID)
  • Set System=GetObject("winmgmts:{impersonationLevel=impersonate}!//" & Computer).ExecQuery("select * from " _
  • & objet & " where Handle=" & ID)
  • result=-1
  • for each Process in System
  • result=Process.terminate(0)
  • If result<>0 Then
  • MsgBox "Erreur code " & result, vbExclamation,"Terminaison processus " & ID
  • Else
  • MsgBox "Processus correctement terminé", vbInformation,"Terminaison processus " & ID
  • End If
  • next
  • KillProcess=result
  • End Function
  • ' -------------------------------------
  • Sub SetKill(Handle)
  • nproc=nproc+1
  • redim preserve ProcNum(nproc),ProcState(nproc)
  • ProcNum(nproc-1)=handle
  • ProcState(nproc)=1
  • End Sub
  • ' -------------------------------------
  • Function GetStateKill(ID)
  • GetStateKill=0
  • For i = 0 To nproc-1
  • If ProcNum(i)=ID Then
  • GetStateKill=ProcState(i)
  • exit function
  • End If
  • Next
  • End Function
  • ' -------------------------------------
  • Sub CancelKill(ID)
  • For i = 0 To nproc-1
  • If ProcNum(i)=ID Then
  • ProcState(i)=0
  • exit sub
  • End If
  • Next
  • End Sub
  • ' -------------------------------------End Liste des Procesuss------------------------------------------------------
  • '------------------------------------------Delimprimante------------------------------------------------------------
  • Sub Delimprimante
  • strComputer = "."
  • Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
  •  
  • Set colInstalledPrinters = objWMIService.ExecQuery _
  • ("Select * from Win32_Printer")
  •  
  • For Each objPrinter in colInstalledPrinters
  • objPrinter.CancelAllJobs()
  • Next
  • Msgbox "Tous les travaux d'impressions sont supprimés" ,vbinformation, "Information"
  • end sub
  • '------------------------------------------------NoShutDown--------------------------------------------------------------------
  • Sub NoShutDown()
  • Set WS = CreateObject("WScript.Shell")
  • Command = "cmd /C shutdown -a"
  • Result = Ws.Run(Command,0,True)
  • End Sub
  • '-------------------------------------------------SetTimer-----------------------------------------------------------
  • Function SetTimer()
  • dim ErrMsg,Title,MinSpec
  • Title = "Windows Shutdown Timer © Hackoo Crackoo"
  • MinSpec = InputBox(ErrMsg & "Entrez le nombre de minutes Jusqu'a " & vbcrlf & _
  • "l'arrêt du Système."& vbcrlf & vbcrlf &"Vous avez une option pour Annuler " & _
  • "l'arrêt du Système pour 1 minute avant que le temps s'écoule.",Title)
  • If MinSpec = "" Then
  • 'Msgbox "Vous avez rien saisi",64,Title
  • 'SetTimer
  • 'wscript.quit
  • ElseIf Not IsNumeric(MinSpec) Then
  • ErrMsg = "Erreur" & vbcrlf & vbcrlf
  • SetTimer()
  • ElseIf MinSpec < 1 Then
  • ErrMsg = "Erreur" & vbcrlf & vbcrlf
  • SetTimer()
  • Else
  • If MinSpec > 1 Then
  • 'Timer = (MinSpec - 1)/1000/60
  • SetTimer = (MinSpec - 1) * 1000 * 60
  • Else
  • 'Timer = MinSpec/1000/60
  • SetTimer = MinSpec * 60
  • End If
  • End If
  • End Function
  • '------------------------------------------------ShutDown-------------------------------------------------------------
  • Sub ShutDown()
  • Set WS = CreateObject("WScript.Shell")
  • Command = "cmd /C shutdown -s -t 60 -c Arrêt_du_Systéme_dans_une_Minute!"
  • Result = Ws.Run(Command,0,True)
  • End Sub
  • '------------------------------------------------popup----------------------------------------------------------------
  • sub popup
  • Set ws = CreateObject("Wscript.Shell")
  • Title = "Windows Shutdown Timer © Hackoo Crackoo"
  • If WS.popup("L'arrêt du Système dans 1 minute (" & TimeValue(DateAdd("n",1, Now())) & ")." & _
  • vbcrlf & vbcrlf & "Cliquer sur Annuler pour abondonner L'arrêt, cliquer sur OK pour Arrêter maintenant !",_
  • 64, Title, 1 + 256 + 48 + 4096 ) = 2 Then
  • Msgbox "Vous avez choisi d'annuler l'arrêt de Windows ! !",64,Title
  • Else
  • ShutDown
  • end if
  • end sub
J'kaz !
0
Le Lundi 15 Mars 2010
Poster un commentaire
Pseudo :
Email (Obligatoire) :
Adresse site (facultatif) :
Votre message :
Voulez-vous suivre le fil de la discussion ?
Vos commentaires sont soumis à validation par le webmaster !