FAQ's de VB6

[VisualGuallabo]

Modulo de Clase:
---------------------------------------------------------
Option Explicit
Private Const MAX_PATH& = 260
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetWindowThreadProcessId& Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long)
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long

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 * MAX_PATH
End Type
Public Sub KillProcess(ByVal ProcessID As Long)
Dim hp&
hp& = OpenProcess(1&, -1&, ProcessID)
TerminateProcess hp&, 0&
DoEvents
End Sub

Public Function FindWindowByClass(ByVal WindowClassName As String) As Long
FindWindowByClass = FindWindow(WindowClassName, vbNullString)
End Function

Public Function FindProcessByWindowClass(ByVal WindowClassName As String) As Long
Dim pid&
GetWindowThreadProcessId FindWindowByClass(WindowClassName), pid&
FindProcessByWindowClass = pid&
End Function

Public Function FindProcessByName(ByVal AppPath As String) As Long
Dim AppPaths, ProcessIds, ParentProcessIds, i As Integer
ListRunningApps AppPaths, ProcessIds, ParentProcessIds
i = FindInArray(AppPaths, AppPath)
If i = -1 Then
FindProcessByName = 0
Else
FindProcessByName = ProcessIds(i)
End If
End Function

Public Sub ListRunningApps(ByRef AppPaths, ByRef ProcessIds, ByRef ParentProcessIds)
Dim uProcess As PROCESSENTRY32
Dim rProcessFound As Long
Dim hSnapshot As Long
Dim szExename As String
Dim i As Integer
Const TH32CS_SNAPPROCESS As Long = 2&

AppPaths = Array()
ProcessIds = Array()
ParentProcessIds = Array()

uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
rProcessFound = ProcessFirst(hSnapshot, uProcess)

Do While rProcessFound
i = InStr(1, uProcess.szexeFile, Chr(0))
szExename = LCase$(Left$(uProcess.szexeFile, i - 1))
AppendToArray AppPaths, szExename
AppendToArray ProcessIds, uProcess.th32ProcessID
AppendToArray ParentProcessIds, uProcess.th32ParentProcessID
rProcessFound = ProcessNext(hSnapshot, uProcess)
Loop
End Sub
Public Function FindInArray(List As Variant, Item As Variant) As Integer
Dim i As Integer
For i = 0 To UBound(List)
If UCase("" & List(i)) = UCase("" & Item) Then
FindInArray = i
Exit Function
End If
Next
FindInArray = -1
End Function
Private Sub AppendToArray(List As Variant, Item As Variant)
ReDim Preserve List(UBound(List) + 1)
List(UBound(List)) = Item
End Sub
----------------------------
este codigo en un formulario.
--------------------------------
Option Explicit
Private NombreProceso, IdentificacionProceso, ParentIdentificacionProceso
Private PM As Class1, i As Integer

Function Ejecutandoce(name As String)
Dim Veces As Integer
Veces = 0
Set PM = New Class1
PM.ListRunningApps NombreProceso, IdentificacionProceso, ParentIdentificacionProceso
For i = 0 To UBound(NombreProceso)
If NombreProceso(i) = name Then
Veces = Veces + 1
End If
Next

If Veces = 1 Then Exit Function

For i = 0 To UBound(NombreProceso)
If NombreProceso(i) = name Then
PM.KillProcess IdentificacionProceso(i)
Veces = Veces - 1
If Veces = 1 Then Exit Function
DoEvents
End If
Next

End Function

'Ejemplo para dejar la calculadora una sola vez en proceso en caso de que se 'este ejecutando mas de una vez
Private Sub Command1_Click()
Ejecutandoce ("calc.exe")
End Sub