Ce programme s'auto-supprime, en se copiant d'abord dans le répertoire temporaire. Il peut être très utile pour faire, par exemple, une désinstallation. Le seul problème est qu'il reste encore le programme dans le répertoire temporaire, mais en général, il est vidé assez souvent.
Source / Exemple :
'Dans un module
'**************************************************
'* NOM : Auto Suppression d'un programme
'* DATE : 11/04/2002
'*
'* AUTEUR : Florent
'*
'* DESCRIPTION :
'* Permet de faire un programme qui
'* s'auto-supprime, en se copiant
'* dans le répertoire temporaire
'* de Windows.
'*
'**************************************************
Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long 'Pour récupérer le répertoire temporaire
Public Const MAX_PATH = 260
Private Declare Function GetTickCount Lib "kernel32" () As Long 'Pour la pause
Public Sub xWait(ByVal MilsecToWait As Long)
'Permet de faire une pause dans un programme de x milisecondes.
Dim lngEndingTime As Long
lngEndingTime = GetTickCount() + (MilsecToWait)
Do While GetTickCount() < lngEndingTime
DoEvents
Loop
End Sub
Public Function RecupCheminTemp()
'Permet de récupérer le répertoire temporaire de Windows
Dim RepertoireStr As String
Dim ResltatLng As Long
RepertoireStr = String(MAX_PATH, 0)
ResltatLng = GetTempPath(MAX_PATH, RepertoireStr)
If ResltatLng <> 0 Then
RecupCheminTemp = Left(RepertoireStr, InStr(RepertoireStr, Chr(0)) - 1)
Else
RecupCheminTemp = ""
End If
End Function
Public Function DeleteApp()
On Error Resume Next
'On récupère le répertoire temporaire
Dim temp
temp = RecupCheminTemp
If temp = "" Then MsgBox "Erreur : impossible de trouver le chemin du répertoire temporaire !", vbExclamation, "Erreur": Exit Function
If Right(temp, 1) <> "\" Then temp = temp & "\"
'On récupère le chemin de l'application
Dim exe
exe = App.Path
If Right(exe, 1) <> "\" Then exe = exe & "\"
exe = exe & App.EXEName & ".exe"
'On supprime l'application dans le répertoire temporaire si elle y est déjà
Kill temp & App.EXEName & ".exe"
'On se copie dans le répertoire temporaire
FileCopy exe, temp & App.EXEName & ".exe"
'On sauvegarde dans la base de registre que l'on veut se supprimer
SaveSetting App.Title, "Suppression", "App", exe
'On lance l'application dans le répertoire temporaire
Shell (temp & App.EXEName & ".exe")
'on quitte
End
End Function
Public Function CheckDelete()
On Error Resume Next
'On vérifie si il faut ou non supprimer l'application
If GetSetting(App.Title, "Suppression", "App") <> "" Then
'On attends 2 secondes que l'autre application se quitte
Call xWait(2000)
'On supprime l'autre application
Kill GetSetting(App.Title, "Suppression", "App")
'On sauvegarde
SaveSetting App.Title, "Suppression", "App", ""
'On quitte
End
End If
End Function
'Dans la form
Private Sub Command1_Click()
'Supprime
DeleteApp
End Sub
Private Sub Form_Load()
'Vérifie si l'on doit supprimer
CheckDelete
End Sub
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.