' ----------------------------------------------------------
' Script d'exploration de la BDR 
' clefs HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist
'
' JC BELLAMY © 2007
' ----------------------------------------------------------
const HKEY_CLASSES_ROOT    = &H80000000 
Const HKEY_CURRENT_USER    = &H80000001
const HKEY_LOCAL_MACHINE   = &H80000002
const HKEY_USERS           = &H80000003 
const HKEY_CURRENT_CONFIG = &H80000005 
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD  = 4
Const REG_MULTI_SZ = 7

FileName="exploreBDR.txt"
nbrmonth=array(31,28,31,30,31,30,31,31,30,31,30,31)
Dim sNames,iTypes

strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
    strComputer & "\root\default:StdRegProv")
Key = "Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist"
oReg.EnumKey HKEY_CURRENT_USER, Key, CollSubKey

Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set ts  = fso.CreateTextFile(FileName, True)
For Each SubKey In CollSubKey
	Key2= Key & "\" & SubKey & "\count"
	ts.WriteLine " " 
	ts.WriteLine "HKCU\" & key2		
	ts.WriteLine "-------------------------------------------"
	lRC = oReg.EnumValues(HKEY_CURRENT_USER, Key2, sNames, iTypes) 
	For i = LBound(sNames) To UBound(sNames)
		s=sNames(i)
		If s<>"" Then 
			r=""
			For k = 1 To len(s)
				c=Mid(s, k,1)
				a = Asc(c)
				If a>=97 and a <=122 Then
					a=a+13
			        If a>122 Then a=a-26
				Elseif a>=65 and a <=90 Then
					a=a+13
			        If a>90 Then a=a-26
					End If
			    r=r+chr(a)
				Next
			p=InStr(1,r,":")
			If p>0 Then
				verb=left(r,p-1)
				value=mid(r,p+1)
			else
				verb=r
				value=""
				end if
			lRC = oReg.GetBinaryValue(HKEY_CURRENT_USER, Key2, sNames(i), uBinary)
			Count=0
			For m = 7 To 4 step -1
				Count=Count*256+ uBinary(m)				
				Next
			lastExec=""
			If UBound(uBinary)=15 Then
				LastDate=0
				For m = 15 To 8 step -1
					LastDate=LastDate*256+ uBinary(m)
					Next
				If LastDate<>0 Then
					LastDate=LastDate / 10000000 ' nombre de secondes écoulées depuis le 01/01/1601
					Nbj=int(LastDate/86400) 'nombre de jours écoulés depuis le 01/01/1601
					Nsec=LastDate-Nbj*86400
					Nbc=0
					annee=1601
					While Nbc+Nbja(annee)<=Nbj
						Nbc=Nbc+Nbja(annee)
						annee=annee+1
						Wend
					Reste=Nbj-Nbc
					Nbc=0
					mois=1
					While Nbc+Njm(annee,mois)<Reste
						Nbc=Nbc+Njm(annee,mois)
						mois=mois+1		
						Wend 
					Jour=Reste-Nbc+1
					Secondes=Nsec mod 60
					Minutes=int(Nsec/60) mod 60
					Heures=int(Nsec/3600)
					lastExec=FormatStrR(jour,2,"0") & "/" & FormatStrR(mois,2,"0") & "/" & FormatStrR(annee,4,"0") _
 						 & " " & FormatStrR(Heures,2,"0") & ":" & FormatStrR(Minutes,2,"0") & ":" & FormatStrR(Secondes,2,"0")
					End If
				End If
			ts.WriteLine "[" & verb & "] " & value
			ts.WriteLine "  -> " & FormatStrR(Count,5," ") & " fois " & LastExec 
			End If
		next
	next
ts.Close
Set Shell=Wscript.CreateObject("WScript.Shell")
shell.Run "notepad.exe " & FileName
'--------------------------------------------------------------------
Function FormatStrR(ch,lmax,pad)
l=len(ch)
If l<lmax Then 
	For k = l+1 To lmax
		ch=pad & ch
		Next
	End If
FormatStrR=ch
End Function
'--------------------------------------------------------------------
Function Nbja(a)
if ((a mod 4 =0) and (a mod 100 <>0)) or (a mod 400 = 0) then Nbja=366 else Nbja=365
End Function
'--------------------------------------------------------------------
Function Njm(a,m)
n=nbrmonth(m)
if (((a mod 4 =0) and (a mod 100 <>0)) or (a mod 400 = 0)) and (m=2) then n=n+1
Njm=n
End Function