Programme qui s'auto-supprime

Description

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

Codes Sources

A voir également

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.