Option Explicit
 
Private Const MAX_PATH = 260
 
Private Declare Function GetTempFileName Lib "kernel32" Alias _
  "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, _
  ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal _
nBufferLength As Long, ByVal lpBuffer As String) As Long
 
Private Declare Function CharToOemA Lib "user32.dll" (ByVal _
        lpszSrc As String, ByVal lpszDst As String) As Long
 
Private Declare Function SetFileAttributes Lib "kernel32" Alias _
  "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As _
  Long) As Long
 
Private Function CreateTempFileName$()
Dim p$, d$, i&
 
 p = Space(MAX_PATH + 1)
 d = Space(MAX_PATH + 1)
 GetTempPath MAX_PATH, d
 GetTempFileName d, "$", 0, p
 CreateTempFileName = Left(p, InStr(p, Chr(0)) - 1)
End Function
 
Public Sub Loeschen()
Dim batchname$, exename$
If MsgBox("'" & App.Title & "' löschen?", 36, "Frage") = 6 Then
  batchname = CreateTempFileName()
  batchname = Left(batchname, Len(batchname) - 3) & "bat"
  exename = App.Path
  If Right(exename, 1) <> "\" Then exename = exename & "\"
  exename = exename & App.exename & ".exe"
  SetFileAttributes App.exename, 0
  Call CharToOemA(exename, exename)  'Damit auch pfade mit umlauten gelöscht 
  ' werden können
 
  Open batchname For Output As #1
      Print #1, ":Label1"
      Print #1, "del """ & exename & """"
      Print #1, "if Exist """ & exename & """ goto Label1"
      Print #1, "rmdir """ & App.Path & """"
      Print #1, "del " & batchname
      Print #1, ""
      Print #1, ""
   Close #1
' Wichtig: Das aktuelle Verzeichnis muß gewechselt werden, da dieses sonst 
' nicht gelöscht werden kann:
   ChDir "c:\"
   Shell batchname, vbHide
   Beep
   MsgBox "Programm ist gelöscht!"
   End
  End If
End Sub