'Nonlus.vbs 'Gestion des messages non lus 'version 3.0 '(c) gilles ronsin 2005 ' 'Merci à JeanClaude Bellamy http://www.bellamyjc.net ' const HKLM = &H80000002 const HKCU = &H80000001 const REG_SZ = 1 const REG_EXPAND_SZ = 2 const REG_BINARY = 3 const REG_DWORD = 4 const REG_MULTI_SZ = 7 Dim Shell, oIE, ts, fso Set Shell = WScript.CreateObject ("WScript.Shell") Set fso = Wscript.CreateObject ("Scripting.FileSystemObject") 'récupération des infos Dim key,dureetous,duree Dim boite(), mail(), app(), nboite HTMLFile = getpath() & "nonlus.htm" strComputer = "." do Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ strComputer & "\root\default:StdRegProv") strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Unreadmail" oReg.EnumKey HKCU, strKeyPath, arrSubKeys on error resume next 'afin de palier à toute abération de la BDR nboite=0 If IsArray(arrSubKeys) then For Each subkey In arrSubKeys nboite=nboite+1 redim preserve boite(nboite), mail(nboite), app(nboite) boite(nboite)=subkey mail(nboite)=Shell.regread("HKCU\" & strKeyPath & "\" & subkey & "\MessageCount") app(nboite)=Shell.regread("HKCU\" & strKeyPath & "\" & subkey & "\Application") Next End If 'Lecture de la durée générale dureetous=Shell.RegRead("HKLM\" & StrKeyPath & "\MessageExpiryDays") If Err.Number = -2147024894 then dureetous = 3 Err.Clear ElseIf Err.Number<>0 Then MsgBox "Error # " & CStr(Err.Number) & " " & Err.Description End If 'Lecture de la durée courante duree=Shell.RegRead("HKCU\" & StrKeyPath & "\MessageExpiryDays") If Err.Number = -2147024894 then duree = 3 Err.Clear ElseIf Err.Number<>0 Then MsgBox "Error # " & CStr(Err.Number) & " " & Err.Description End If On Error Goto 0 'retour à la gestion normale d'erreur Set ts = fso.CreateTextFile(HTMLFile) ' ts.writeline "" ts.writeline "" ' ts.writeline "" ts.writeline "" ts.writeline "Gestion des messages non lus" ts.writeline "" ' ts.writeline "

Gestion des messages non lus

" ts.writeline "

vous avez " & nboite & " boite(s) déclarée(s) dans la base de registre


" ts.writeline "

Etat de fonctionnement


" ts.writeline "La fonction ""messages non lus"" est ...
" if dureetous then ts.writeline "... active pour tous les utilisateurs. Cliquez pour la désactiver.
" else ts.writeline "... inactive pour tous les utilisateurs. Cliquez pour l'activer.
" end if if duree then ts.writeline "... active pour l'utilisateur courant. Cliquez pour la désactiver.

" else ts.writeline "... inactive pour l'utilisateur courant. Cliquez pour l'activer.

" end if if nboite=0 then ts.writeline "Pas de boite à lettres activée." else ts.Writeline "" ts.writeline "" for i = 1 to nboite ts.writeline "" next ts.writeline "

Boite

Non Lus

Application

" & boite(i) & "" & mail(i) & "" & app(i) & "" ts.writeline "" ts.writeline "" ts.writeline "
" end if ts.writeline "
" ts.writeline "
(c) Gilles Ronsin 2005 - eMail aregtool@free.fr - " ts.writeline "http://gilles.ronsin.free.fr" ts.writeline "
Nota : filtre antispam : Tout mail ne contenant pas la balise [gilles] dans le sujet sera rejeté." ts.writeline "
" ts.close Set oIE = WScript.CreateObject ("InternetExplorer.Application","IE_") oIE.Left = 90 oIE.Top = 100 oIE.Height = 550 oIE.Width = 800 oIE.MenuBar = false oIE.AddressBar = false oIE.ToolBar = false oIE.StatusBar = false oIE.navigate HTMLFile oIE.visible = 2 Do While (oIE.busy) WScript.Sleep 200 Loop Shell.AppActivate "Gestion des messages non lus" On error Resume Next Do WScript.Sleep 50 Loop While (oIE.Document.Script.CheckVal()=0) If Err<>0 Then exit do End If on error goto 0 test=oIE.Document.Script.CheckVal() If Test=-1 Then exit do end if ligne=int((test-1)/3+1) On Error Resume Next select case test case "-2" Shell.RegWrite "HKLM\" & StrKeyPath & "\MessageExpiryDays",0, "REG_DWORD" If Err.Number=-2147024891 Then MsgBox "Vous devez être administrateur pour désactiver cette fonction pour tous les utilisateurs" ElseIf Err.Number<>0 Then MsgBox "Error # " & CStr(Err.Number) & " " & Err.Description End If case "-3" Shell.RegWrite "HKLM\" & StrKeyPath & "\MessageExpiryDays",3, "REG_DWORD" 'Shell.RegDelete "HKLM\" & StrKeyPath & "\MessageExpiryDays" If Err.Number=-2147024891 Then MsgBox "Vous devez être administrateur pour activer cette fonction pour tous les utilisateurs" ElseIf Err.Number<>0 Then MsgBox "Error # " & CStr(Err.Number) & " " & Err.Description End If case "-4" Shell.RegWrite "HKCU\" & StrKeyPath & "\MessageExpiryDays",0, "REG_DWORD" case "-5" 'Shell.RegWrite "HKCU\" & StrKeyPath & "\MessageExpiryDays",3, "REG_DWORD" Shell.RegDelete "HKCU\" & StrKeyPath & "\MessageExpiryDays" case else select case (test-1) mod 3 case "0" appli=app(ligne) select case appli case "msimn" shell.run """%programfiles%\Outlook Express\msimn.exe""",0,true case "http://www.hotmail.com/" shell.run "rundll32.exe ""%programfiles%\intern~1\hmmapi.dll"",OpenInboxHandler",0,true case else if appli<>"" then shell.run appli,0,true end select case "1" shell.regwrite "HKCU\" & strKeyPath & "\" & boite(ligne) & "\MessageCount", 0, "REG_DWORD" case "2" If MsgBox("-tes-vous sûr de supprimer " & Boite(ligne) & " ?" & vbCrLf & _ "(Ceci est sans conséquence sur le fonctionnement futur)",vbYesNo,"Avertissement")=vbYes Then shell.Regdelete "HKCU\" & StrKeyPath & "\" & Boite(ligne) & "\" end if end select end select On Error Goto 0 oIE.Quit ' fso.DeleteFile(HTMLfile) loop closeIE fso.DeleteFile(HTMLFile) wscript.quit Function GetPath() Dim Path path = Wscript.ScriptFullName GetPath = Left(path, InStrRev(path,"\")) end function sub CloseIE oIE.quit Set oIE=Nothing end sub