[VB6] So löscht sich ein Program selbst

Die folgende Funktion kann benutzt werden, wenn man erreichen will, dass sich ein Programm – zum Beispiel im Rahmen eines De-installationsprozesses – selbst löscht.

Am besten den Code in ein Modul kopieren:

Declare Function ShellExecute Lib "shell32.dll" _
  Alias "ShellExecuteA" ( _
  ByVal hwnd As Long, _
  ByVal lpOperation As String, _
  ByVal lpFile As String, _
  ByVal lpParameters As String, _
  ByVal lpDirectory As String, _
  ByVal nShowCmd As Long) As Long
  
  
Private Declare Function CharToOemA Lib "user32.dll" (ByVal _
        lpszSrc As String, ByVal lpszDst As String) As Long
        
        
Private Befehl$
Private MeFile$
Private BatFile$

  
Sub Selfdestruction()
On Error Resume Next
    Dim ff As Long
    Dim BatFile As String
    ff = FreeFile

    'verhindert das auftauchen von "\\" im Dateinamen:
    If Len(App.Path) > 3 Then 'In einem Unterverzeichnis
        MeFile = App.Path & "\" & App.EXEName & ".exe"
        BatFile = App.Path & "\" & "Kill.bat"
    Else 'Direkt auf der Festplatte
        MeFile = App.Path & App.EXEName & ".exe"
        BatFile = App.Path & "Kill.bat"
    End If
 
    'falls Attribute (wie z.B. Schreibschutz)
    'gesetzt sind, werden diese augeschaltet
    If GetAttr(MeFile) Then SetAttr MeFile, 0

    'Konvertiert Dateinamen zu ANSI-Code
    Call CharToOemA(MeFile, MeFile)
    
    'verhindert Anzeigen der Befehle im DOS-Fenster
    If Comment Then Befehl = "@echo off" & vbCrLf
    Befehl = Befehl & ":Marke" & vbCrLf
    
    
    'Befehl zum Zerstören der EXE
    Befehl = Befehl & "Del " & Chr(34) & MeFile & Chr(34) & vbCrLf
    
     'falls EXE noch vorhanden (Zugriff verweigert) --> zurück zu :Marke
    Befehl = Befehl & "If Exist " & Chr(34) & MeFile & Chr(34) & " Goto Marke" & vbCrLf
    
    'gibt Text aus
    If Comment Then Befehl = Befehl & "echo." & vbCrLf & _
        "echo EXE wurde zerstoert" & vbCrLf & "echo." & vbCrLf
        
    'Bat-Datei zerstört sich selbst
    Befehl = Befehl & "del " & Chr(34) & BatFile & Chr(34)



    'Bat-Datei muss binär erstellt werden
    Open BatFile For Binary As #ff
        Put #ff, , Befehl
    Close #ff
 
    If Not Comment Then
'        Call Shell(BatFile, vbHide)
        RetVal = ShellExecute(0, "open", BatFile, "", "", SW_SHOWMAXIMIZED)
    Else
'        Call Shell(BatFile, vbNormalFocus)
        RetVal = ShellExecute(0, "open", BatFile, "", "", SW_SHOWMAXIMIZED)
    End If
    
    End
End Sub