1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
| ' ----------------------------------------------------------
' Script d'exploration de la BDR
' clefs HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist
'JC BELLAMY © 2007
'Mise à jour par Hackoo : Affichage des résultats en forme HTML
' ----------------------------------------------------------------
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.htm"
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)
ts.writeline "<body bgcolor=#000000 text=#Green>"
For Each SubKey In CollSubKey
Key2= Key & "\" & SubKey & "\count"
ts.WriteLine " "
ts.WriteLine "HKCU\" & key2 & "<br>"
ts.WriteLine "-------------------------------------------<br>"
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 & "<br>"
ts.WriteLine " -> " & FormatStrR(Count,5," ") & " fois " & LastExec & "<br>"
End If
next
next
ts.Close
Set Shell=Wscript.CreateObject("WScript.Shell")
shell.Run 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)
If m<1 or m>12 Then
wscript.echo "Erreur mois = " & m
If m<0 Then Njm=0 else Njm=365
exit function
End If
n=nbrmonth(m-1)
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 |
Exploration de la Base de Registre : "Historique et Nombre de fois d'exécutions"
Répondre avec citation
Partager