Run-control vous alerte des qu'un programme s'enregistre pour se lancer au demarrage de windows xp

Soyez le premier à donner votre avis sur cette source.

Vue 6 252 fois - Téléchargée 474 fois

Description

Ce code permet de verifier les differents cles et le repertoire ou se mettent
les programmes pour se lancer au demarrage de Windows
des qu'une cle ou un fichier est ajoute un message d'alerte vous previent
et vous demande si vous etes d'accord

Ce code n'est concu que pour Windows XP ds sa version Francaise
mais vous pouvez facileent l'adapter a d'autres version
seuls les chemin de cle ou de repertoire sont a changer...

Bien qu'il ne consomme pas plus de 0 a 1 % de Temps CPU
je cherche a l'optimiser
surtout au niveau consommation RAM

PS: Bien que je suis debutant et que le code ne soit pas tres complique
j'ai mis niveau initie car une connaissance minimal de la bdr est requise

Merci pour vos commentaires et vos conseils d'ameliorations
bonne prog @+

Source / Exemple :


Option Explicit
'
'La plupart de ces fonctions sont
'faites sur base des Exemples du site AllApi.net
'
Dim cnt As Integer
Dim Program
Dim IniList(1 To 6) As Collection
Dim VeriF(1 To 6)
Dim SearchStr
Dim Path
Dim Chm
Private Declare Function InitCommonControls Lib "Comctl32.dll" () As Long
Dim Sa(1 To 5)
Dim Sb(1 To 5)
'/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/
'                           Pour les fonctions du registre
 Const HKLM = &H80000002
 Const HKCU = &H80000001
 Const REG_OPTION_BACKUP_RESTORE = 4
Const REG_OPTION_VOLATILE = 1
Const REG_OPTION_NON_VOLATILE = 0
Const STANDARD_RIGHTS_ALL = &H1F0000
Const SYNCHRONIZE = &H100000
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Const KEY_CREATE_LINK = &H20
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Const KEY_EXECUTE = (KEY_READ)
Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Const REG_SZ = 1
Const ERROR_NO_MORE_ITEMS = 259&
Const HKEY_CURRENT_CONFIG = &H80000005
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As Any, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Any) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
'-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/

'-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/
                      'Pour le dossier de demarrage '
'(SystemDrive\Documents and Settings\UserName\Menu Demarrer\Demarrage\)

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type
'renvoi le path du dossier run
Private Function GetPath()
Dim strUserName As String
Dim sSave As String, Ret As Long
Dim disk, user
sSave = Space(255)
Ret = GetSystemDirectory(sSave, 255)
sSave = Left$(sSave, Ret)
disk = Left(sSave, 3)
strUserName = String(100, Chr$(0))
GetUserName strUserName, 100
strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
user = strUserName ' & Chr$(13)
GetPath = disk & "Documents and Settings\" & user & "\Menu Démarrer\Programmes\Démarrage\"
End Function
'function pour interroger la bdr
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
On Error Resume Next
   Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
   lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
   If lResult = 0 Then
           strBuf = String(lDataBufSize, Chr$(0))
           lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
            If lResult = 0 Then
                RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
        End If
    End If
End Function
'lire une valeur
Function ReadValue(hKey As Long, strPath As String, strValue As String)
    On Error Resume Next
    Dim Ret
    RegOpenKey hKey, strPath, Ret
    ReadValue = RegQueryStringValue(Ret, strValue)
    RegCloseKey Ret
End Function
'ecrire une valeur
Sub RegWrite(hKey As Long, strPath As String, strValue As String, strData As String)
    On Error Resume Next
    Dim Ret
    RegCreateKey hKey, strPath, Ret
    RegSetValueEx Ret, strValue, 0, REG_SZ, ByVal strData, Len(strData)
    RegCloseKey Ret
End Sub
'supprimer une valeur du registre
Private Function DeleteValue(ByVal hKey, ByVal Section As String, ByVal Key As String)
    Dim KeyValue As Long
    Call RegOpenKey(hKey, Section, KeyValue) '// Ouverture
    Call RegDeleteValue(KeyValue, Key) '// Supprime la valeur
    Call RegCloseKey(KeyValue) '// Fermeture
End Function
'Fonction pour verifier l'existence d'une cle
Public Function CleExist(Rac, Cle As String) As Boolean
Dim Result As Long
        RegOpenKeyEx Rac, Cle, 0, KEY_ALL_ACCESS, Result
If Result = 0 Then CleExist = False Else CleExist = True
    RegCloseKey Result
End Function
'enumerer les valeurs d'une clef
Public Function GetKeyNumber(Racine, Cle, NbrLst, Action) '1
Dim ii, VeriFic
Dim hKey As Long, NbCl As Integer, sName As String, sData As String, Ret As Long, RetData As Long
Const BUFFER_SIZE As Long = 255
If RegOpenKey(Racine, Cle, hKey) = 0 Then
        sName = Space(BUFFER_SIZE)
        sData = Space(BUFFER_SIZE)
        Ret = BUFFER_SIZE
        RetData = BUFFER_SIZE
        'enumeration des cles
    While RegEnumValue(hKey, NbCl, sName, Ret, 0, ByVal 0&, ByVal sData, RetData) <> ERROR_NO_MORE_ITEMS
            
            If RetData > 0 Then
' le nom des la cles ou programmes sont renvoye ds Left$(sName, ret)
' la commande ou le chemin du programmw sont renvoyee ds Left$(sData, RetData - 1)
                NbCl = NbCl + 1
'on choisi l'action
    Select Case Action
        Case 1 ' initier la liste de depart
                IniList(NbrLst).Add Left$(sName, Ret)
        Case 2 'on compte juste le nbr de cle
        Case 3 'ici on determine la cle qui a ete ajoutee
                VeriFic = 0
                'MsgBox IniList(NbrLst).Count & IniList(NbrLst).Item(NbCl)
                For ii = 1 To IniList(NbrLst).Count
                    If IniList(NbrLst).Item(ii) <> Left$(sName, Ret) Then VeriFic = VeriFic + 1
                Next ii
               ' MsgBox VeriFic
                    If VeriFic >= IniList(NbrLst).Count Then 'si il n'est pas dans la list c le bon
                        Chm = Left$(sData, RetData - 1) 'on renvoi la valeur
                        GetKeyNumber = Left$(sName, Ret) 'on renvoi le nom du prog
                        GoTo Fin
                    End If
End Select
'on vide les variables ...
sName = Space(BUFFER_SIZE)
sData = Space(BUFFER_SIZE)
Ret = BUFFER_SIZE
RetData = BUFFER_SIZE
        End If
DoEvents
    Wend
        RegCloseKey hKey 'on ferme la cle
        Else
    End If
   GetKeyNumber = NbCl 'on renvoi le nombre de cle
Fin:
DoEvents
End Function
Sub Main()
Dim x As Long
Sa(1) = "Software\Microsoft\Windows\CurrentVersion\Run"
Sa(2) = "Software\Microsoft\Windows\CurrentVersion\RunOnce"
Sa(3) = "Software\Microsoft\Windows\CurrentVersion\Run"
Sa(4) = "Software\Microsoft\Windows\CurrentVersion\RunOnce"
Sa(5) = "Software\Microsoft\Windows\CurrentVersion\RunOnceEx"

Sb(1) = HKCU
Sb(2) = HKCU
Sb(3) = HKLM
Sb(4) = HKLM
Sb(5) = HKLM

Path = GetPath
SearchStr = "*.*"

DoEvents
x = InitCommonControls
'set IniList = New Collection
Set IniList(1) = New Collection
Set IniList(2) = New Collection
Set IniList(3) = New Collection
Set IniList(4) = New Collection
Set IniList(5) = New Collection
Set IniList(6) = New Collection
DoEvents

RegWrite HKCU, "Software\Abes", "StandBy", "On"

'initialisation
'on compte combien il y a de valeurs dans la cle et on les notes
'dans la collection portant le meme numero
'Ex: GetKeyNumber(hkcu, "Software\Microsoft\Windows\CurrentVersion\Run", liste1, action1)
VeriF(1) = GetKeyNumber(Sb(1), Sa(1), 1, 1)
DoEvents
VeriF(2) = GetKeyNumber(Sb(2), Sa(2), 2, 1)
DoEvents
VeriF(3) = GetKeyNumber(Sb(3), Sa(3), 3, 1)
DoEvents
VeriF(4) = GetKeyNumber(Sb(4), Sa(4), 4, 1)
DoEvents
VeriF(5) = GetKeyNumber(Sb(5), Sa(5), 5, 1)
DoEvents
VeriF(6) = GetNumberFile(1)
DoEvents

Timing ' lance la boucle de verification...

End Sub
Public Sub MessageBox(value, programs, list As Integer)
Dim reponse As Integer ' fonction d'envoi d'alerte
Dim i As Integer
If list <> 6 Then GoTo 1
reponse = MsgBox("                          ATTENTION !" & vbCrLf & "" & vbCrLf & "Le programme : " & programs & vbCrLf & "" & vbCrLf & "s'est enregistre pour se lancer au" & vbCrLf & vbCrLf & "demarage de Windows, dans le dossier :  " & vbCrLf & vbCrLf & Path & vbCrLf & "" & vbCrLf & "               Voulez vous le laisser faire ?                              ", 4404, "RunControl")
GoTo 2
1
reponse = MsgBox("                          ATTENTION !" & vbCrLf & "" & vbCrLf & "Le programme : " & programs & vbCrLf & "" & vbCrLf & "a enregistre la cle suivante :" & vbCrLf & vbCrLf & value & vbCrLf & vbCrLf & "pour se lancer au demarage de Windows  " & vbCrLf & "" & vbCrLf & "               Voulez vous le laisser faire ?                              ", 4404, "RunControl")
2
    Select Case reponse
            Case vbYes
            'on met la liste a jour
                    VeriF(list) = VeriF(list) + 1
                    IniList(list).Add programs
                    DoEvents
            Case vbNo
            'on supprime la cle ou le fichier
                        If list <> 6 Then
                        DeleteValue Sb(list), Sa(list), programs
                        Else
                             DeleteFile (Path & programs)
                             DoEvents
                        End If
               
            End Select
End Sub
Sub Timing() ' "Timer" de verification
Dim Comp
Dim i
Dim cnt As Integer
Start:
'Porte de sortie du program
'si la valeur est Off on ferme
If ReadValue(HKCU, "Software\Abes", "StandBy") = "Off" Then GoTo Fin
DoEvents
'verification ....
For cnt = 1 To 6 ' Boucle pour verifier les cles et le dossier de demarrage
        ' si cnt <> de 6 on appel GetKeyNumber
        ' sinon on appel GetNumberFile
    If cnt <> 6 Then _
            Comp = GetKeyNumber(Sb(cnt), Sa(cnt), cnt, 2) _
        Else _
            Comp = GetNumberFile(2)
            DoEvents
        'VeriF(cnt) contient le nbr de cle(s) ou fichiers de depart
        'comp contient le nbr de cle(s) ou fichiers actuel
    If Comp < VeriF(cnt) Then 'si il maque un fichier on reinitialise la list

        While IniList(cnt).Count > 0
            i = IniList(cnt).Count
            IniList(cnt).Remove (i)
        Wend
            If cnt <> 6 Then VeriF(cnt) = GetKeyNumber(Sb(cnt), Sa(cnt), cnt, 1) Else VeriF(cnt) = GetNumberFile(1)
    End If
    DoEvents
    
        'si comp est > VeriF(cnt) un programme a ete ajouer
        'donc on appel GetKeyNumber ou GetNumberFile (action 3) pour savoir le quel
    If Comp > VeriF(cnt) Then
        'MsgBox cnt
        If cnt <> 6 Then Program = GetKeyNumber(Sb(cnt), Sa(cnt), cnt, 3) Else Program = GetNumberFile(3)
        'on envoi le message d'alerte
            Call MessageBox(Chm, Program, cnt)
    End If
        DoEvents
        Sleep 50
        DoEvents
Next cnt
'la boucle de verification est terminee, on recommence....
DoEvents
DoEvents
Sleep 100
GoTo Start
Fin:
End
End Sub
'-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/
Private Function StripNulls(OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = OriginalStr
End Function
Public Function GetNumberFile(Action As Integer) 'renvoi le nombre de fichier ds le repertoire
    Dim VeriFi                                   'fait a partir du code de Allapi.net
    Dim FileCount As Integer
    Dim FileName As String ' Walking filename variable...
    Dim i As Integer ' For-loop counter...
    Dim hSearch As Long ' Search Handle
    Dim WFD As WIN32_FIND_DATA
    Dim Cont As Integer
    If Right(Path, 1) <> "\" Then Path = Path & "\"
    Cont = True
    hSearch = FindFirstFile(Path & "*", WFD)
    hSearch = FindFirstFile(Path & SearchStr, WFD)
    
    
    Cont = True
    If hSearch <> INVALID_HANDLE_VALUE Then
    DoEvents
        While Cont
            FileName = StripNulls(WFD.cFileName)
            If (FileName <> ".") And (FileName <> "..") Then
        Select Case Action
              
            Case 1 'on initialise la liste des fichiers de depart
              IniList(6).Add FileName
                FileCount = FileCount + 1
            Case 2 ' on compte juste le nbr de fichiers
                FileCount = FileCount + 1
            Case 3 'on determine quel fichier a ete ajoute
                Dim ii
                VeriFi = 0
                    For ii = 1 To IniList(6).Count
                        If IniList(6).Item(ii) <> FileName Then VeriFi = VeriFi + 1
                    Next ii
                        If VeriFi >= IniList(6).Count Then GetNumberFile = FileName: GoTo Fin
        End Select
                End If
            Cont = FindNextFile(hSearch, WFD) ' Get next file
            DoEvents
            
           Wend
        Cont = FindClose(hSearch)
            
    

    End If
GetNumberFile = FileCount
Fin:
DoEvents
End Function
'-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/

Conclusion :


Pour stopper le programme il suffit de compiler le projet ds le dossier stop (ds le Zip)
et de le lancer...

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

draluorg
Messages postés
627
Date d'inscription
vendredi 23 avril 2004
Statut
Membre
Dernière intervention
25 novembre 2010
-
Eh oui c'est l'executable car j'ai laisse tombe ce projet et les sources sont toujours a l'etat de brouillon.

En fait j'utilise CreateEvent, RegNotifyChangeKeyValue et WaitForMultipleObjects.

Je recois donc un evenement lorsqu'une cle est modifiee, je n'ai donc pas besoin de verifier a interval si il y a eu modification.

Seul probleme WaitForMultipleObjects ne gere que 64 objet(cles dans ce cas) et donc il faut creer un thread par bloc de 64 cles.

J'utilise une dll en C++ pour les threads, c'est relativement stable mais ca reste delicat.

++
violent_ken
Messages postés
1822
Date d'inscription
mardi 31 mai 2005
Statut
Membre
Dernière intervention
26 octobre 2010
-
A l'exécutable, en fait.

Je ne connais pas la méthode que tu as employée, mais elle est efficace au niveau du ratio performance/nombre de clés vérifiées, vraiment.
@+
violent_ken
Messages postés
1822
Date d'inscription
mardi 31 mai 2005
Statut
Membre
Dernière intervention
26 octobre 2010
-
Salut, je vais jetter un coup d'oeil attentif à ta source (moi même ayant programmé ceci pour mon projet).

Merci, @+ (et il est vrai que cette source date un peu ;)
draluorg
Messages postés
627
Date d'inscription
vendredi 23 avril 2004
Statut
Membre
Dernière intervention
25 novembre 2010
-
Salut,

Erf wai c'est vieux ce code, j'en ai refais un depuis, base sur RegNotifyChangeKeyValue en multithread, avec sauvegarde des cles et comparaisons au demarrage et a l'arret de Windows etc...
Par defaut il a une centaine de cles, mais on peut lui en ajouter soit une par une soit depuis un liste, possibilite aussi de verouiller des cles etc...

Tu peux le voir ici: http://systemzeb.free.fr/ZebRegNotify.zip

++
violent_ken
Messages postés
1822
Date d'inscription
mardi 31 mai 2005
Statut
Membre
Dernière intervention
26 octobre 2010
-
Salut !

Pour le nombre de clé et valeurs de clé à checker, c'est bien plus que 8 ou 30 (en comptant tout les modules démarrant au démarrage de Windows, par exemple avec l'explorateur). Faut ajouter à çà les dossiers "Demarrage" et les tasks Windows.

J'ai fait le même genre de code pour mon projet, et l'utilisation CPU pour checker toutes les clés (peut être 200) bouffe pas moins de 10% de CPU...alors si on prend une intervalle assez importante (5000 ms), çà passe, mais c'est pas fameux pour un prog. d'arrière plan. Faudrait pouvoir hooker tout çà (à la manière de Regmon, mais çà nécessite d'installer un driver, et c'est plus de mon niveau).

Voilà ! @+

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.