'Unread.vbs
'Unread Mail Management
'version 3.1
'(c) gilles ronsin 2005
'
'Thanks to Jean-Claude Bellamy [MVP] http://www.bellamyjc.net
' and Claude LaFrenière [MVP Shell user W xp] & http://www.sysinternals.com/Forum/ 's moderator
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")
'fetchings informations
Dim key,dureetous,duree
Dim boite(), mail(), app(), nboite
HTMLFile = getpath() & "unread.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 'To prevent any registry malfunctions
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
'Duration Reading
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
'Current duration reading
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'return to normal error management
Set ts = fso.CreateTextFile(HTMLFile)
ts.writeline ""
ts.writeline ""
ts.writeline "Unreaded Mail Management"
ts.writeline ""
'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 "Unread Messages Management"
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
closeIE
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 "You Must be administrator to disable this function for all users"
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 "You Must be administrator to enable this function for all users"
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("Are you sure ? " & Boite(ligne) & " ?" & vbCrLf & _
"(This have no consequences for later use)",vbYesNo,"Warning")=vbYes Then
shell.Regdelete "HKCU\" & StrKeyPath & "\" & Boite(ligne) & "\"
end if
end select
end select
On Error Goto 0
CloseIE
'fso.DeleteFile(HTMLfile)
loop
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