Run-control vous alerte des qu'un programme s'enregistre pour se lancer au demarrage de windows xp
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 @+
Pour stopper le programme il suffit de compiler le projet ds le dossier stop (ds le Zip)
et de le lancer...
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
- Run-control vous alerte des qu'un programme s'enregistre pour se lancer au demarrage de windows xp
- Lancer extranet collaboratif - Forum Java
- Stock d'alerte par entrepot - Forum VB.NET
- Alerte speciale - Forum Javascript / DHTML
- Lancer un .cpl - Forum VB.NET
- Windows h ✓ - Forum C
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.