[VB6]Melt file

Post new topic   Reply to topic

View previous topic View next topic Go down

[VB6]Melt file

Post  ~Fleck on Thu Jul 02, 2009 7:04 am

Code:

Private Sub Form_Unload(Cancel As Integer)
  Shell "cmd /c del " & App.EXEName & ".exe", vbHide
End Sub

u may sometimes want to delay it a little , so add a long function , like a function that take time ., ping 127.0.0.1 , or "assoc" to list files extensions and it will be like this:
Shell "cmd /c assoc&&del " & App.EXEName & ".exe", vbHide
but the code up works to me
here is the other one , uses priorities to do the same (calling cmd to remove the file)
Code:

Const NORMAL_PRIORITY_CLASS = &H20
Const REALTIME_PRIORITY_CLASS = &H100
Const THREAD_PRIORITY_NORMAL = 0
Const THREAD_PRIORITY_IDLE = -15
Const IDLE_PRIORITY_CLASS = &H40
Const DETACHED_PROCESS = &H8
Const CREATE_SUSPENDED = &H4
Const THREAD_PRIORITY_TIME_CRITICAL = 15
Const SW_HIDE = 0
Const STARTF_USESHOWWINDOW = &H1

Type STARTUPINFO
        cb As Long
        lpReserved As String
        lpDesktop As String
        lpTitle As String
        dwX As Long
        dwY As Long
        dwXSize As Long
        dwYSize As Long
        dwXCountChars As Long
        dwYCountChars As Long
        dwFillAttribute As Long
        dwFlags As Long
        wShowWindow As Integer
        cbReserved2 As Integer
        lpReserved2 As Long
        hStdInput As Long
        hStdOutput As Long
        hStdError As Long
End Type

Type PROCESS_INFORMATION
        hProcess As Long
        hThread As Long
        dwProcessId As Long
        dwThreadId As Long
End Type

Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type

Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Declare Function GetEnvironmentVariable Lib "kernel32" Alias "GetEnvironmentVariableA" (ByVal lpName As String, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Declare Function GetCurrentProcess Lib "kernel32" () As Long
Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
Declare Function GetCurrentThread Lib "kernel32" () As Long
Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long


Public Function DeleteMe() As Boolean
Dim szModule        As String
Dim szComspec      As String
Dim szParams        As String

Dim si              As STARTUPINFO
Dim pi              As PROCESS_INFORMATION
Dim sa1            As SECURITY_ATTRIBUTES
Dim sa2            As SECURITY_ATTRIBUTES

    szModule = String(512, 0)
    szComspec = String(512, 0)
    szParams = String(512, 0)
 
    '// get file path names:
    If ((GetModuleFileName(0, szModule, 512) <> 0) And (GetShortPathName(szModule, szModule, 512) <> 0) And (GetEnvironmentVariable("COMSPEC", szComspec, 512) <> 0)) Then
        '// set command shell parameters
        szComspec = Left(szComspec, InStr(szComspec, Chr(0)) - 1)
        szModule = Left(szModule, InStr(szModule, Chr(0)) - 1)
       
        szComspec = szComspec & " /c del " & szModule
       
        '// set struct members
        With si
            .cb = Len(si)
            .dwFlags = STARTF_USESHOWWINDOW
            .wShowWindow = SW_HIDE
        End With
        '// increase resource allocation to program
        Call SetPriorityClass(GetCurrentProcess(), REALTIME_PRIORITY_CLASS)
        Call SetThreadPriority(GetCurrentThread(), THREAD_PRIORITY_TIME_CRITICAL)

        '// invoke command shell
        'Debug.Print CreateProcess(vbNullString, szComspec, sa1, sa2, 0&, CREATE_SUSPENDED Or DETACHED_PROCESS, 0&, vbNullString, si, pi)
        If CreateProcess(vbNullString, szComspec, sa1, sa2, 0, CREATE_SUSPENDED Or DETACHED_PROCESS, 0, vbNullString, si, pi) Then
            '// suppress command shell process until program exits
            Call SetPriorityClass(pi.hProcess, IDLE_PRIORITY_CLASS)
            Call SetThreadPriority(pi.hThread, THREAD_PRIORITY_IDLE)

            '// resume shell process with new low priority
            Call ResumeThread(pi.hThread)

            '// everything seemed to work
            DeleteMe = True
            Exit Function
        Else '// if error, normalize allocation
            Call SetPriorityClass(GetCurrentProcess(), NORMAL_PRIORITY_CLASS)
            Call SetThreadPriority(GetCurrentThread(), THREAD_PRIORITY_NORMAL)
        End If
    End If
    DeleteMe = False
End Function

_________________

Thanks to FusioN for this awesome sig :]

~Fleck
Moderator
Moderator

Posts: 274
Activity: -258
Reputation: 8
Join date: 2009-06-28
Age: 16
Location: 127.0.0.1

Back to top Go down

Re: [VB6]Melt file

Post  ~Fleck on Thu Jul 02, 2009 7:05 am

*or*
Code:

Dim KILLFILE As String
Private Declare Function GetWindowsDirectory _
Lib "kernel32" Alias "GetWindowsDirectoryA" ( _
ByVal lpBuffer As String, _
ByVal nSize As Long) _
As Long
Private Sub Form_Load()
If App.Path <> GetWinDir() Then
    FileCopy App.Path & "\" & App.EXEName & ".exe", GetWinDir & "\thisisthecopiedfile.exe"
    KILLFILE = App.Path & App.EXEName & ".exe"
    Shell GetWinDir() & "\thisisthecopiedfile.exe " & KILLFILE '
    End
Else
    MsgBox "Hello from " & App.Path
    Kill Command
End If
End Sub
Public Function GetWinDir() As String
Dim Temp As String * 256
Dim x As Integer
    x = GetWindowsDirectory(Temp, Len(Temp))
    GetWinDir = Left$(Temp, x)
End Function

_________________

Thanks to FusioN for this awesome sig :]

~Fleck
Moderator
Moderator

Posts: 274
Activity: -258
Reputation: 8
Join date: 2009-06-28
Age: 16
Location: 127.0.0.1

Back to top Go down

View previous topic View next topic Back to top


Post new topic   Reply to topic
Permissions of this forum:
You cannot reply to topics in this forum