Cerrar Archivos desde Visual Basic...

Bueno yo se que se puede abrir cualquier programa desde una aplicacion de Visual Basic, mi pregunta es tambien se puede cerrar, es decir un comando o algo para poder cerrarla desde mi aplicacion de visual..
¿Si se puede?
¿Me podrias ayudar con esto?
Muchas Gracias... MV

1 Respuesta

Respuesta
1
Para cerrar aplicaciones desde VB hay que acudir a llamadas API:
Private Declare Function OpenProcess Lib "kernel32.dll" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" _
(ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" _
(ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" _
(ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" _
(ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function EnumProcesses Lib "psapi.dll" _
(ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" _
(ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "psapi.dll" _
(ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" _
(ByVal Handle As Long) As Long
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 260
End Type
Private Sub Command1_Click()
Dim lHwnd As Long
If fbEstaCargadaApp("Notepad.exe", lHwnd) Then
pTerminarApp lHwnd
End If
End Sub
Private Function fbEstaCargadaApp(ByVal sAppName As String, lHwnd As Long) As Boolean
Select Case flGetVersion
Case 1
fbEstaCargadaApp = fbEstaCargadaW95(sAppName, lHwnd)
Case 2
fbEstaCargadaApp = fbEstaCargadaAppNT(sAppName, lHwnd)
End Select
End Function
Private Function flGetVersion() As Long
Dim osInfo As OSVERSIONINFO
Dim RetValue As Integer
On Error GoTo TratarError
osInfo.dwOSVersionInfoSize = 148
osInfo.szCSDVersion = Space$(128)
RetValue = GetVersionExA(osInfo)
flGetVersion = osInfo.dwPlatformId
Exit Function
TratarError:
Err.Clear
flGetVersion = 2
End Function
Private Function fbEstaCargadaW95(ByVal sAppName As String, _
ByRef lHwnd As Long) As Boolean
Dim sAppQuery As String, bAppLoad As Boolean
Dim lProcess As Long, sName As String
Dim lSnap As Long, miProcess As PROCESSENTRY32
Const TH32CS_SNAPPROCESS = &H2&
Const hNull = 0
On Error GoTo TratarError
sAppQuery = "*" & UCase(sAppName) & "*"
bAppLoad = False
lSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If lSnap = hNull Then Exit Function
miProcess.dwSize = Len(miProcess)
lProcess = Process32First(lSnap, miProcess)
Do While lProcess
sName = Left$(miProcess.szExeFile, Len(miProcess.szExeFile) - 1)
sName = Replace(sName, Chr(0), Empty)
sName = UCase(Trim(sName))
'
' Miramos si es la aplicacion que buscamos
'
If (sName Like sAppQuery) Then
lHwnd = miProcess.th32ProcessID
bAppLoad = True
Exit Do
End If
lProcess = Process32Next(lSnap, miProcess)
Loop
fbEstaCargadaW95 = bAppLoad
Exit Function
TratarError:
Err.Clear
End Function
Private Function fbEstaCargadaAppNT(Optional ByVal sAppName As String, _
Optional ByRef lHwnd As Long, Optional ByRef ListaApps As Collection) As Boolean
Dim cb As Long
Dim cbNeeded As Long
Dim NumElements As Long
Dim ProcessIDs() As Long
Dim cbNeeded2 As Long
Dim NumElements2 As Long
Dim Modules(1 To 200) As Long
Dim lRet As Long
Dim ModuleName As String
Dim nSize As Long
Dim hProcess As Long
Dim i As Long
Dim sModName As String
Dim sAppQuery As String
Dim bAppLoad As Boolean
Const PROCESS_QUERY_INFORMATION = 1024 '&H400
Const PROCESS_VM_READ = 16
Const MAX_PATH = 260
On Error GoTo TratarError
sAppQuery = "*" & sAppName & "*"
bAppLoad = False
cb = 8
cbNeeded = 96
Do While cb <= cbNeeded
cb = cb * 2
ReDim ProcessIDs(cb / 4) As Long
lRet = EnumProcesses(ProcessIDs(1), cb, cbNeeded)
Loop
NumElements = cbNeeded / 4
For i = 1 To NumElements
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION _
Or PROCESS_VM_READ, 0, ProcessIDs(i))
If hProcess Then
lRet = EnumProcessModules(hProcess, Modules(1), 200, cbNeeded2)
If lRet <> 0 Then
ModuleName = Space(MAX_PATH)
nSize = 500
lRet = GetModuleFileNameExA(hProcess, Modules(1), ModuleName, nSize)
sModName = Left$(ModuleName, lRet)
'
' Miramos si es la aplicacion que buscamos
'
If (LCase(sModName) Like LCase(sAppQuery)) Then
lHwnd = CLng(ProcessIDs(i))
bAppLoad = True
End If
End If
End If
lRet = CloseHandle(hProcess)
If bAppLoad Then Exit For
Next
fbEstaCargadaAppNT = bAppLoad
Exit Function
TratarError:
Err.Clear
End Function
Public Sub pTerminarApp(ByVal lHwnd As Long)
Dim lProcess As Long
Dim lReturn As Long
Const PROCESS_ALL_ACCESS = &H1F0FFF
lProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, lHwnd)
lReturn = TerminateProcess(lProcess, 0&)
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas