Option Explicit

Public colFicActivos As New Collection
Type PROCESSENTRY32
   dwSize              As Long
   cntUsage            As Long
   th32ProccessID      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

Declare Function CreateToolhelpSnapshot Lib "Kernel32" Alias "CreateToolhelp32Snapshot" _
      (ByVal lFlags As Long, ByVal lProccessID As Long) As Long

Declare Function ProcessFirst Lib "Kernel32" Alias "Process32First" _
      (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long

Declare Function ProcessNext Lib "Kernel32" Alias "Process32Next" _
      (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
    
Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)

' Guarda los ficheros activos en una colección
Sub cargaFicherosActivos()    
    Dim hSnapShot   As Long
    Dim uProceso    As PROCESSENTRY32
    Dim res         As Long
    Dim i           As Integer
    '//Vaciar colección
    While colFicActivos.Count > 0
        colFicActivos.Remove 1
    Wend
    i = 0
    hSnapShot = CreateToolhelpSnapshot(2&, 0&)
    If hSnapShot <> 0 Then
        uProceso.dwSize = Len(uProceso)
        res = ProcessFirst(hSnapShot, uProceso)
        '//Ir guardando elementos
        Do While res
            colFicActivos.Add Left$(uProceso.szExeFile, InStr(uProceso.szExeFile, Chr$(0)) - 1), CStr(i)
            res = ProcessNext(hSnapShot, uProceso)
            i = i + 1
        Loop
        Call CloseHandle(hSnapShot)
    End If    
End Sub

' Busca una cadena contenida en cualquier fichero que está activo
Function LookFicheroLike(strFicheroComp As String) As Boolean
    LookFicheroLike = False
    Dim i As Integer
    For i = 1 To colFicActivos.Count
        If InStr(UCase$(colFicActivos(i)), UCase$(strFicheroComp)) Then
            LookFicheroLike = True
        End If
    Next i
End Function

' Busca el nombre de un fichero(sin ruta) y sin extensión(opcional)
Function LookExisteFichero(strFicheroComp As String, Optional booExtension) As Boolean
    LookExisteFichero = False
    Dim i As Integer
    For i = 1 To colFicActivos.Count
        '// Eliminamos la ruta
        Dim strActivo   As String
        Dim strFichero As String
        Dim strCaracter As String
        Dim r           As Integer
        strFichero = ""
        strActivo = UCase$(colFicActivos(i))
        r = Len(strActivo)
        strCaracter = ""
        While strCaracter <> ""
            strCaracter = Mid$(strActivo, r, 1)
            r = r - 1
        Wend
        strFichero = Right$(strActivo, Len(strActivo) - (r + 1))
        '// Si recibe el segundo parametro quita la extensión
        If Not IsMissing(booExtension) Then
            strFichero = Left$(strFichero, InStr(strFichero, ".") - 1)
        End If
        '// Se comparan
        'MsgBox strFichero
        If strFichero = UCase$(strFicheroComp) Then
            LookExisteFichero = True
        End If
    Next i
End Function