雑記帳

日常の出来事や、読んだ本のあらすじや感想など書いています。

自分自身を消す方法

2006-02-21 15:58:06 | Visual Basic
自分自身を消す方法
解読できないけど、いつか使いたいと思うことがありそう。
その時利用させてもらおう。もらいました。

Private Sub Command1_Click()
    Dim FSO As Object   'Scripting.FileSystemObject
    Dim FilePath As String
    Dim S As Object   'Scripting.TextStream

    'Set FSO = New Scripting.FileSystemObject
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FilePath = FSO.BuildPath(App.Path, App.EXEName & ".EXE")

    Set S = FSO.CreateTextFile(FilePath & ".VBS", True, False)
    S.WriteLine "On Error Resume Next"
    S.WriteLine "Set FSO = WScript.CreateObject(""Scripting.FileSystemObject"")"
    S.WriteLine "FSO.DeleteFile """ & FilePath & ".VBS"", True"
    S.WriteLine "Do Until FSO.FileExists(""" & FilePath & ".DEL"")"
    S.WriteLine "  WScript.Sleep 100"
    S.WriteLine "Loop"
    S.WriteLine "FSO.DeleteFile """ & FilePath & ".DEL"", True"
    S.WriteLine "Set WshShell = WScript.CreateObject(""WScript.Shell"")"
    S.Write "If WshShell.Popup(""削除します「" & FilePath & "」"", 10, ""自動削除"","
    S.WriteLine CStr(vbOKCancel Or vbSystemModal Or vbInformation) & ") = vbOK Then"
    S.WriteLine "  WScript.Sleep 500"
    S.WriteLine "  FSO.DeleteFile """ & FilePath & """, True"
    S.WriteLine "  WshShell.Popup ""削除しました。"", 10, ""自動削除""," & CStr(vbInformation)
    S.WriteLine "Else"
    S.WriteLine "  WshShell.Popup ""削除中止"", 10, ""自動削除""," & CStr(vbInformation)
    S.WriteLine "End If"
    S.Close
    Set S = Nothing

    Shell "WSCRIPT.EXE """ & FilePath & ".VBS""", vbNormalFocus

    Set S = FSO.CreateTextFile(FilePath & ".DEL", True, False)
    S.WriteLine FilePath
    S.Close
    Unload Me
    Set S = Nothing
    Set FSO = Nothing
End Sub

コメントを投稿