Sentinel 95 (16 bits)



Sentinel95 (VB4 16 bits) (23/Feb/97)
Utilidad para mostrar/comprobar los recursos libres, el espacio de las unidades de discos, los programas y tareas que se están ejecutando, lanza programas de forma automática y todo aderezado con alertas.



Baja el archivo con los listados y el ejecutable: (sentinel.zip 36.1 KB)

Los módulos y formularios que se usan son:

  • Sentinel.frm: (el listado)
    El form principal, mira las imagenes para hacerte "una composición del lugar"
  • gswE3D_n.bas: (el listado)
    Módulo con la rutina para hacer el efecto 3D
  • gswslp_n.bas: (el listado)
    Módulo para el efecto de las solapas.

 


Algunas "fotos" del programa:
Imagenes capturadas de cada una de las opciones disponibles.

Pantalla principal con los datos de la memoria, los recursos y el espacio en las 12 primeras unidades de disco duro, incluso si son discos de red, CD-ROM o extraibles.

Tareas Activas:
Los programas y carpetas.

Tareas Activas:
Todas, incluso las no visibles.

Configuración de las alertas:
Tiempo de chequeo, recursos, memoria, etc.

Configuración de las alertas:
Espacio en las unidades de disco y tiempo de chequeo.

Configuración de las alertas:
Tareas a comprobar y/o ejecutar si no están activas.

Pregunta:  ¿A que vienen tantas pantallas y nada de código?
Respuesta: ¡ Yo que sé ! Estaba aburrido y me puse a "capturar" imagenes.

¿Quieres código?
Toma código (es que llevo un "mogollón" de horas sin dormir y estoy medio "colgao")


 

 

'Declaraciones del Form

Option Explicit
Option Compare Text
'---------------------------------------------------------
' Sentinel (versión para 16 bits)       ( 2/Sep/96)
' (c) Guillermo Som Cerezo, 1996-97
'
' Última revisión:                      (28/Sep/96)
'
' Muestra los recursos libres, tareas activas, espacio
' libre en las unidades de disco y permite configurar
' alertas para recursos bajos, tareas no activas y si la
' memoria total no coincide con la especificada.
'---------------------------------------------------------
'Segundos de Lapso para chequear las unidades
Dim LapsoParaUnidades As Integer
Dim UltimoChequeoUnidades As Double
'Flag para cuando se cambian los LstCfg
Dim CambiandoLstCfg As Boolean
'Flag para cuando se cambian los valores de los Checks
Dim CambiandoChkCfg As Boolean
'Variables para controlar las alertas
Dim DesactivarAlertas As Boolean
Dim LapsoEntreChequeo As Integer       'Lapso de segundos entre cada chequeo
Dim AlertarMemoria As Boolean
Dim AlertarRecursos As Boolean
Dim AlertarUnidades As Boolean
Dim AlertarTareas As Boolean
'Tipo de tareas a mostrar
Dim TodasLasVentanas As Boolean
'Variables para las tareas a chequear y localización
Dim sTarea() As String          'Nombre de la tarea
Dim sPath() As String           'Localización
Dim nTareas As Integer          'Número de tareas a comprobar
Dim bActivada() As Boolean      'Tarea activada...
Dim CargaAutomatica As Boolean
'Tipos de datos para simular un TabStrip
Dim SolapaSentinel As Solapa    'Solapa principal
Dim SolapaCfg As Solapa         'Solapa de configuración de las alertas
'Flag para saber si se deben crear las solapas
Dim SolapaCreada As Boolean
'Constantes para cada solapa
Const SLPA_RECURSOS = 0
Const SLPA_TAREAS = 1
Const SLPA_CONFIGURAR = 2
Const SLPACFG_RECURSOS = 3
Const SLPACFG_UNIDADES = 4
Const SLPACFG_TAREAS = 5
'Tamaño inicial de la ventana
Dim iH As Integer
Dim iW As Integer
'
'Función para leer el espacio libre de los discos (del Setup1 de Visual Basic
Private Declare Function DiskSpaceFree Lib "StKit416.dll" () As Long
'Constantes para usar con GetFreeSystemResources()
Const GFSR_SYSTEMRESOURCES = &H0
Const GFSR_GDIRESOURCES = &H1
Const GFSR_USERRESOURCES = &H2
'Constantes para GetWindow
Const GW_CHILD = 5
Const GW_HWNDFIRST = 0
Const GW_HWNDLAST = 1
Const GW_HWNDNEXT = 2
Const GW_HWNDPREV = 3
Const GW_OWNER = 4
'
'Funciones 16 bits del API de Windows
Private Declare Function GetFreeSpace Lib "Kernel" (ByVal flag As Integer) As Long
Private Declare Function GetFreeSystemResources Lib "User" (ByVal fuSysResource As Integer) As Integer
Private Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
Private Declare Function GetVersion Lib "Kernel" () As Long
Private Declare Function GetModuleHandle Lib "Kernel" (ByVal lpModuleName As String) As Integer
Private Declare Function GetWinFlags Lib "Kernel" () As Long
'Declaración de Funciones de 16 bits para tomar las listas de tareas
Private Declare Function GetWindow Lib "User" (ByVal hwnd As Integer, ByVal wCmd As Integer) As Integer
Private Declare Function GetWindowText Lib "User" (ByVal hwnd As Integer, ByVal lpString As String, ByVal nMaxCount As Integer) As Integer
Private Declare Function GetWindowTextLength Lib "User" (ByVal hwnd As Integer) As Integer
Private Declare Function IsWindowVisible Lib "User" (ByVal hwnd As Integer) As Integer


Private Sub ActualizarChecksAlertas(ByVal Modo As Boolean)
    'Asignar los valores de los Checks...
    If Modo Then
        CambiandoChkCfg = True
        ChkCfg(0) = Abs(AlertarMemoria)
        ChkCfg(1) = Abs(AlertarRecursos)
        ChkCfg(2) = Abs(AlertarUnidades)
        ChkCfg(3) = Abs(AlertarTareas)
        ChkCfg(4) = Abs(DesactivarAlertas)
        TxtCfg(5) = LapsoEntreChequeo
        TxtCfg(6) = LapsoParaUnidades
        CambiandoChkCfg = False
    Else
        AlertarMemoria = ChkCfg(0)
        AlertarRecursos = ChkCfg(1)
        AlertarUnidades = ChkCfg(2)
        AlertarTareas = ChkCfg(3)
        DesactivarAlertas = ChkCfg(4)
        LapsoEntreChequeo = TxtCfg(5)
        LapsoParaUnidades = TxtCfg(6)
        If DesactivarAlertas Then
            Timer1.Enabled = False
        Else
            Timer1.Enabled = True
        End If
    End If
    If DesactivarAlertas Then
        LblMem(9) = " Todas las Alertas están Desactivadas."
    Else
        LblMem(9) = " Están Activadas las Alertas."
    End If
End Sub


Private Sub ActualizarInfo()
    Dim FreeSpace As Currency
    Dim temp
    Dim i As Integer
    Dim j As Integer
    Dim newVal As Integer
   
    Timer1.Enabled = False
    Timer1.Interval = LapsoEntreChequeo * 1000
    
    'Memoria libre
    ' SYSTEM = 0, GDI = 1, USER = 2
    j = 3
    For i = 0 To 2
        newVal = GetFreeSystemResources(i)
        LblMem(j) = newVal & "%"
        j = j + 2
    Next
    temp = GetFreeSpace(0)
    If Sgn(temp) = -1 Then
        ' Return of GetFreeSpace is an unsigned long
        ' so handle case when high bit is set (two's complement).
        FreeSpace = (temp + 1&) Xor &HFFFFFFFF
    Else
        FreeSpace = temp
    End If
    LblMem(1) = Format(FreeSpace / (1024& * 1024&), "#,###.00 \M\B")
    LblMem(0) = "Memoria Física: "
    
    Timer1.Enabled = True
End Sub


Private Sub ActualizarInfoUnidades()
    Dim sTmp As String
    Dim sTmp2 As String
    Dim sTmp3 As String
    Dim i As Integer
    Dim j As Integer
    
    Timer1.Enabled = False
    
    'Actualizar la información del espacio de las unidades
    sTmp = ""
    sTmp3 = Space$(22)
    CboCfg(0).Clear
    LstCfg(0).Clear
    LstCfg(1).Clear
    For i = 0 To Drive1.ListCount - 1
        sTmp2 = Drive1.List(i)
        j = InStr(sTmp2, ":")
        If j Then
            sTmp2 = UCase$(Left$(sTmp2, j - 1))
        End If
        'No leer los disquetes
        If sTmp2 > "B" Then
            LstCfg(0).AddItem sTmp2
            CboCfg(0).AddItem sTmp2
            LstCfg(1).AddItem GetSetting("Sentinel.ini", "Unidades", sTmp2, "0")
            LSet sTmp3 = DriveSpace(sTmp2, 22)
            sTmp = sTmp & sTmp3
        End If
    Next
    LblMem(8) = sTmp
    If LstCfg(0).ListCount Then
        LstCfg(0).ListIndex = 0
    End If
    
    Timer1.Enabled = True
End Sub


Private Sub ActualizarTareas()
    'Actualizar las tareas de los lists a las variables
    Dim i As Integer
    Dim j As Integer
    
    nTareas = 0
    ReDim sTarea(nTareas)
    ReDim sPath(nTareas)
    j = LstCfgTarea(0).ListCount
    For i = 0 To j - 1
        nTareas = nTareas + 1
        ReDim Preserve sTarea(nTareas)
        ReDim Preserve sPath(nTareas)
        sTarea(nTareas) = Trim$(LstCfgTarea(0).List(i))
        sPath(nTareas) = Trim$(LstCfgTarea(1).List(i))
    Next
    ReDim bActivada(nTareas)
End Sub


Private Sub AsignarTareas(sCommand As String)
    Dim i As Integer
    Dim p As Integer
    
    i = InStr(sCommand, "/P")
    If i Then
        nTareas = nTareas + 1
        ReDim Preserve sTarea(nTareas)
        ReDim Preserve sPath(nTareas)
        
        sTarea(nTareas) = RTrim$(Left$(sCommand, i - 1))
        sCommand = LTrim$(Mid$(sCommand, i + 2))
        sPath(nTareas) = sCommand
        If Len(Dir(sPath(nTareas))) = 0 Then
            nTareas = 0
        End If
    End If
    ReDim bActivada(nTareas)
End Sub


Private Sub CrearSolapaCfg()
    'Activa o crea las solapas de configuración
    If SolapaCreada Then
        gSolapa = SolapaCfg
        DibujarSolapas Me
        SolapaCfg = gSolapa
    Else
        ContSolapa(3).Visible = False
        ContSolapa(4).Visible = False
        ContSolapa(5).Visible = False
        SolapaCfg.Inicio = 3
        SolapaCfg.Numero = 3
        LblSolapa(3) = "Recursos"
        LblSolapa(4) = "Unidades"
        LblSolapa(5) = "Tareas"
        SolapaCfg.Bold = False
        SolapaCfg.Inset = False
        SolapaCfg.Efecto3D = False
        SolapaCfg.Arriba = False
        SolapaCfg.Activa = 3
        SolapaCfg.ActivaAnt = 3
    End If
End Sub


Function DriveSpace(D As String, ByVal Ancho As Integer) As String
    Dim DNum As Integer
    Dim TSpace As Long
    Dim TS$
    
    DNum = Asc(UCase$(D)) - Asc("A") + 1
    TSpace = GetDiskSpaceFree(D)
    If Ancho < 10 Then Ancho = 10
    TS$ = Space$(Ancho - 4)
    RSet TS$ = Format$(TSpace / (1024& * 1024&), "#,###,##0.00 MB")
    DriveSpace = Chr(DNum + Asc("A") - 1) & ": " & TS$ & " "
End Function


Function EspacioLibre(D As String) As Currency
    Dim TSpace As Long
    
    TSpace = GetDiskSpaceFree(D)
    EspacioLibre = TSpace / (1024& * 1024&)
End Function


'-----------------------------------------------------------
' FUNCTION: GetDiskSpaceFree
' Get the amount of free disk space for the specified drive
'
' IN: [strDrive] - drive to check space for
'
' Returns: Amount of free disk space, or -1 if an error occurs
'-----------------------------------------------------------
'
Function GetDiskSpaceFree(ByVal strDrive As String) As Long
    Dim strCurDrive As String
    Dim lDiskFree As Long
    Const gstrCOLON = ":"

    On Local Error Resume Next
    '
    'Save the current drive
    '
    strCurDrive = Left$(CurDir$, 2)
    '
    'Fixup drive so it includes only a drive letter and a colon
    '
    If InStr(strDrive, gstrCOLON) = 0 Or Len(strDrive) > 2 Then
        strDrive = Left$(strDrive, 1) & gstrCOLON
    End If
    '
    'Change to the drive we want to check space for.  The DiskSpaceFree() API
    'works on the current drive only.
    '
    ChDrive strDrive
    '
    'If we couldn't change to the request drive, it's an error, otherwise return
    'the amount of disk space free
    '
    If Err <> 0 Or (strDrive <> Left$(CurDir$, 2)) Then
        lDiskFree = -1
    Else
        lDiskFree = DiskSpaceFree()
        If Err <> 0 Then    'If Setup Toolkit's DLL couldn't be found
            lDiskFree = -1
        End If
    End If
    '
    GetDiskSpaceFree = lDiskFree
    '
    'Cleanup by setting the current drive back to the original
    '
    ChDrive strCurDrive

    Err = 0
End Function


Private Sub LeerTareas(sFic As String)
    Dim i As Integer
    Dim nFic As Integer
    Dim sTmp As String
    
    If Len(Dir$(sFic)) = 0 Then
        nTareas = 0
    Else
        nFic = FreeFile
        Open sFic For Input As nFic
        Do While Not EOF(nFic)
            nTareas = nTareas + 1
            ReDim Preserve sTarea(nTareas)
            ReDim Preserve sPath(nTareas)
            Line Input #nFic, sTmp
            sTarea(nTareas) = Trim$(sTmp)
            If Len(sTarea(nTareas)) = 0 Then
                nTareas = nTareas - 1
                Exit Do
            End If
            Line Input #nFic, sTmp
            sPath(nTareas) = Trim$(sTmp)
            If Len(Dir(sPath(nTareas))) = 0 Then
                nTareas = 0
                Exit Do
            End If
        Loop
        Close nFic
    End If
    ReDim bActivada(nTareas)
End Sub


Private Sub LeerTaskList(MiControl As Control)
    'Asignar a MiControl (Listx) las tareas activas...
    Dim CurrWnd As Long
    Dim Length As Long
    Dim ListItem As String
    Dim hwndDlg As Long
    
    
    MiControl.Clear
    'Con GW_HWNDFIRST, lee todas las ventanas,
    'así se puede guardar cualquier ventana abierta aunque
    'no se minimice.
    'Con GW_OWNER, si una ventana se activa y se termina,
    'sin minimizar, no se guarda esa ventana como abierta.
    '
    'IsWindowVisible, sólo tendrá en cuenta las que sean visibles
    '
    hwndDlg = Sentinel.hwnd
    CurrWnd = GetWindow(hwndDlg, GW_HWNDFIRST)
    
    If CurrWnd Then
        While CurrWnd <> 0
            If (CurrWnd <> hwndDlg And ((IsWindowVisible(CurrWnd) And TodasLasVentanas = False) Or TodasLasVentanas = True)) And (hwndDlg <> GetWindow(CurrWnd, GW_OWNER)) Then
                Length = GetWindowTextLength(CurrWnd)
                ListItem = Space$(Length + 1)
                Length = GetWindowText(CurrWnd, ListItem, Length + 1)
                If Length > 0 Then
                    'añadir a la lista
                    MiControl.AddItem ListItem
                End If
            End If
            CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
        Wend
    End If
End Sub


Private Sub PintarSolapas()
    gSolapa = SolapaSentinel
    DibujarSolapas Me
    SolapaSentinel = gSolapa
    If SolapaSentinel.Activa = SLPA_CONFIGURAR Then
        gSolapa = SolapaCfg
        DibujarSolapas Me
        SolapaCfg = gSolapa
    End If
End Sub


Private Sub TestEspacioUnidades()
    'Comprobar el espacio de los discos y si hay
    'que avisar...
    Dim i As Integer
    Dim j As Integer
    Dim sTmp2 As String
    Dim EspacioDeseado As Currency
    Dim EspacioActual As Currency
    
    
    For i = 0 To Drive1.ListCount - 1
        sTmp2 = Drive1.List(i)
        j = InStr(sTmp2, ":")
        If j Then
            sTmp2 = UCase$(Left$(sTmp2, j - 1))
        End If
        'No leer los disquetes
        If sTmp2 > "B" Then
            EspacioDeseado = GetSetting("Sentinel.ini", "Unidades", sTmp2, 0)
            EspacioActual = EspacioLibre(sTmp2)
            If EspacioDeseado > 0 Then
                If EspacioActual < EspacioDeseado Then
                    j = MsgBox("ATENCION, el espacio en la unidad " & sTmp2 & ": es " & Format(EspacioActual, "#,###.00") & vbCrLf & "el mínimo deseado es: " & Format(EspacioDeseado, "#,###.00") & vbCrLf & "Pulsa Cancelar para no alertar más en las unidades.", vbOKCancel + vbExclamation)
                    If j = vbCancel Then
                        AlertarUnidades = False
                        ActualizarChecksAlertas True
                        Exit For
                    End If
                End If
            End If
        End If
    Next
End Sub


Private Sub TestTareas()
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim sTmp As String
    Dim p As Integer
    Dim iHalladas As Integer
    Dim vTmp
    
    'Comprobar si alguna de las tareas indicadas
    'ya no está en memoria, los recursos, etc.
    
    Timer1.Enabled = False
    LeerTaskList List1
    ActualizarTareas
    
    Timer1.Interval = LapsoEntreChequeo * 1000
    
    For i = 1 To nTareas
        bActivada(i) = False
    Next
    k = List1.ListCount - 1
    iHalladas = 0
    For i = 1 To nTareas
        'Si no se ha encontrado anteriormente
        If bActivada(i) = False Then
            For j = 0 To k
                sTmp = Trim$(List1.List(j))
                If InStr(sTmp, sTarea(i)) Then
                    iHalladas = iHalladas + 1
                    bActivada(i) = True
                End If
            Next
        End If
    Next
    For i = 1 To nTareas
        If bActivada(i) = False Then
            'Esta tarea no está activa
            If CargaAutomatica Then
                j = vbYes
            Else
                j = MsgBox("ATENCION, el programa: " & sTarea(i) & vbCrLf & "( " & sPath(i) & " )" & vbCrLf & "no está activo, ¿Quieres cargarlo?" & vbCrLf & "Pulsa en Cancelar para no avisar cuando una tarea no esté activada.", vbYesNoCancel + vbQuestion)
            End If
            If j = vbYes Then
                'Activarla dejandola minimizada y no en primer plano (17/Jul/96)
                vTmp = Shell(sPath(i), vbMinimizedNoFocus)
                bActivada(i) = True
            ElseIf j = vbCancel Then
                AlertarTareas = False
                ActualizarChecksAlertas True
                Exit For
            End If
        End If
    Next
    LeerTaskList List1
    Timer1.Enabled = True
End Sub


Private Function Valor(queValor As String) As Currency
    'Quitar los caracteres no numéricos...
    Dim sTmp As String
    Dim sTmp2 As String
    Dim c As String
    Dim i As Integer
    
    sTmp = Trim$(queValor)
    sTmp2 = ""
    For i = 1 To Len(sTmp)
        c = Mid$(sTmp, i, 1)
        If InStr("0123456789.", c) Then
            sTmp2 = sTmp2 & c
        ElseIf c = "," Then
            sTmp2 = sTmp2 & "."
        End If
    Next
    Valor = CCur(sTmp2)
End Function


Private Sub CboCfg_Click(Index As Integer)
    Static EstoyAqui As Boolean

    If EstoyAqui Then Exit Sub

    EstoyAqui = True
    LstCfg(0).ListIndex = CboCfg(Index).ListIndex
    TxtCfg(2) = Val(LstCfg(1).List(LstCfg(1).ListIndex))
    EstoyAqui = False
End Sub


Private Sub ChkCfg_Click(Index As Integer)
    If CambiandoChkCfg Then Exit Sub
    
    CambiandoChkCfg = True
    ActualizarChecksAlertas False
    CambiandoChkCfg = False
End Sub


Private Sub CmdActualizar_Click()
    ActualizarInfo
    ActualizarInfoUnidades
End Sub


Private Sub CmdActUnidades_Click()
    Dim i As Integer
    Timer1.Enabled = False
    CambiandoLstCfg = True
    'Asignar a los list de las unidades el dato...
    i = LstCfg(0).ListIndex
    LstCfg(1).RemoveItem i
    LstCfg(1).AddItem Trim$(TxtCfg(2)), i
    'Guardar la información en el fichero ini
    SaveSetting "Sentinel.ini", "Unidades", LstCfg(0).List(i), LstCfg(1).List(i)
    CambiandoLstCfg = False
    Timer1.Enabled = True
End Sub


Private Sub CmdReleer_Click()
    LeerTaskList List1
End Sub


Private Sub CmdSalir_Click()
    Unload Me
End Sub


Private Sub CmdTareasAsignar_Click()
    'Asignar al list de tareas a controlar
    LstCfgTarea(0).AddItem Trim$(TxtCfg(3))
    LstCfgTarea(1).AddItem Trim$(TxtCfg(4))
    ActualizarTareas
End Sub


Private Sub CmdTareasExaminar_Click()
    'Mostrar diálogo de abrir...
    On Local Error Resume Next
    
    CommonDialog1.CancelError = True
    CommonDialog1.Flags = cdlOFNFileMustExist Or cdlOFNPathMustExist
    CommonDialog1.DefaultExt = ".exe"
    CommonDialog1.Filter = "Ejecutables (*.exe;*.bat;*.com)|*.exe;*.bat;*.com|Todos los archivos (*.*)|*.*"
    CommonDialog1.ShowOpen
    If Err Then
        Exit Sub
    Else
        'Asignar el nombre al Text
        TxtCfg(4) = CommonDialog1.filename
    End If
End Sub


Private Sub CmdTareasMostrar_Click()
    TodasLasVentanas = Not TodasLasVentanas
    If TodasLasVentanas Then
        CmdTareasMostrar.Caption = "Sólo las tareas visibles"
    Else
        CmdTareasMostrar.Caption = "Todas las tareas"
    End If
    LeerTaskList List1
End Sub


Private Sub Form_Activate()
    If SolapaCreada Then
        gSolapa = SolapaSentinel
        DibujarSolapas Me
        SolapaSentinel = gSolapa
    Else
        ContSolapa(0).Visible = False
        ContSolapa(1).Visible = False
        ContSolapa(2).Visible = False
        Load LblSolapa(1)
        Load LblSolapa(2)
        LblSolapa(1).Visible = True
        LblSolapa(2).Visible = True
        SolapaSentinel.Inicio = 0
        SolapaSentinel.Numero = 3
        LblSolapa(0).Caption = "Recursos"
        LblSolapa(1).Caption = "Tareas Activas"
        LblSolapa(2).Caption = "Configurar Alertas..."
        SolapaSentinel.Bold = False
        SolapaSentinel.Inset = False
        SolapaSentinel.Efecto3D = False
        SolapaSentinel.Arriba = True
        SolapaSentinel.Activa = 0
        If WindowState <> vbMinimized Then
            gSolapa = SolapaSentinel
            DibujarSolapas Me
            SolapaSentinel = gSolapa
            LblSolapa_Click 0
        End If
        'Crear  la solapa de configuración
        CrearSolapaCfg
        SolapaCreada = True
    End If
End Sub


Private Sub Form_Load()
    Dim sTmp As String
    Dim sTmp2 As String
    Dim sTmp3 As String
    Dim i As Integer
    Dim j As Integer
    
    iW = Width
    iH = Height
    Top = GetSetting("Sentinel.ini", "UltimaPosicion", "Top", Top)
    Left = GetSetting("Sentinel.ini", "UltimaPosicion", "Left", Left)
    
    TodasLasVentanas = False
    i = InStr(App.Comments, "evisión")
    sTmp = " © Guillermo Som Cerezo, "
    If i Then
        sTmp = sTmp & "r" & Mid$(App.Comments, i)
    Else
        sTmp = sTmp & "1996"
    End If
    LblGuille = sTmp
    
    sTmp = Trim$(Command$)
    If Len(sTmp) Then
        i = InStr(sTmp, "/AUTO")
        If i Then
            sTmp = Left$(sTmp, i - 1) & Mid$(sTmp, i + 5)
            CargaAutomatica = True
        End If
        If Left$(sTmp, 1) = "@" Then
            'Es un fichero
            sTmp = Mid$(sTmp, 2)
            LeerTareas sTmp
        Else
            AsignarTareas sTmp
        End If
    End If
    
    LapsoEntreChequeo = GetSetting("Sentinel.ini", "Alertas", "LapsoEntreChequeo", 10)
    'Valor por defecto 5 minutos
    LapsoParaUnidades = GetSetting("Sentinel.ini", "Unidades", "LapsoParaUnidades", 300)
    Label1(2) = Format(Fix(LapsoParaUnidades / 60), "00") & "m " & Format(LapsoParaUnidades Mod 60, "00") & "s"
    'Leer la configuración de las alertas, etc.
    DesactivarAlertas = GetSetting("Sentinel.ini", "Alertas", "DesactivarTodas", False)
    AlertarMemoria = GetSetting("Sentinel.ini", "Alertas", "Memoria", False)
    AlertarRecursos = GetSetting("Sentinel.ini", "Alertas", "Recursos", False)
    AlertarUnidades = GetSetting("Sentinel.ini", "Alertas", "Unidades", False)
    AlertarTareas = GetSetting("Sentinel.ini", "Alertas", "Tareas", False)
    ActualizarChecksAlertas True
    '
    ActualizarInfo
    ActualizarInfoUnidades
    'Tareas a controlar
    LstCfgTarea(0).Clear
    LstCfgTarea(1).Clear
    'Asignar a los list las tareas especificadas en la línea de comandos...
    '
    j = Val(GetSetting("Sentinel.ini", "Tareas", "NumTareas", "1"))
    For i = 0 To j - 1
        sTmp = Trim$(GetSetting("Sentinel.ini", "Tareas", "Tarea" & CStr(i), ""))
        sTmp2 = Trim$(GetSetting("Sentinel.ini", "Tareas", "Comando" & CStr(i), ""))
        If Len(sTmp) <> 0 And Len(sTmp2) <> 0 Then
            LstCfgTarea(0).AddItem sTmp
            LstCfgTarea(1).AddItem sTmp2
        End If
    Next
    ActualizarTareas
    'Recursos
    TxtCfg(0) = GetSetting("Sentinel.ini", "Recursos Minimos", "Memoria", 0)
    TxtCfg(1) = GetSetting("Sentinel.ini", "Recursos Minimos", "Recursos", 0)
    
    'Leer las Ventanas activas
    LeerTaskList List1
    Timer1.Interval = LapsoEntreChequeo * 1000   '1000 = 1 segundo
    Timer1.Enabled = True
    'TestTareas
End Sub


Private Sub Form_Resize()
    Static UltimoEstado As Integer

    If WindowState <> vbMinimized Then
        Caption = "Sentinel para Windows95"
        Height = iH
        Width = iW
        'Guardar la posición
        'SaveSetting "Sentinel.ini", "UltimaPosicion", "Top", Top
        'SaveSetting "Sentinel.ini", "UltimaPosicion", "Left", Left
        '
        'Esto es para que se repinten las solapas,
        'ya que al pasar de estar minimizada a normal,
        'no se ven. En Paint no funciona ya que al pintar
        'las líneas para el efecto 3D, se entra en un bucle
        'sin fin. (creo)
        If UltimoEstado = vbMinimized Then
            PintarSolapas
        End If
    Else
        Caption = "Recursos: " & LblMem(3)
    End If
    UltimoEstado = WindowState
End Sub


Private Sub Form_Unload(Cancel As Integer)
    'Guardar la configuración de las alertas, etc.
    Dim i As Integer
    Dim j As Integer
    
    Timer1.Enabled = False
    
    If WindowState <> vbMinimized Then
        SaveSetting "Sentinel.ini", "UltimaPosicion", "Top", Top
        SaveSetting "Sentinel.ini", "UltimaPosicion", "Left", Left
    End If
    ActualizarChecksAlertas False
    SaveSetting "Sentinel.ini", "Alertas", "LapsoEntreChequeo", LapsoEntreChequeo
    'Leer la configuración de las alertas, etc.
    SaveSetting "Sentinel.ini", "Alertas", "DesactivarTodas", DesactivarAlertas
    SaveSetting "Sentinel.ini", "Alertas", "Memoria", AlertarMemoria
    SaveSetting "Sentinel.ini", "Alertas", "Recursos", AlertarRecursos
    SaveSetting "Sentinel.ini", "Alertas", "Unidades", AlertarUnidades
    SaveSetting "Sentinel.ini", "Alertas", "Tareas", AlertarTareas
    'Tareas a controlar
    j = LstCfgTarea(0).ListCount
    SaveSetting "Sentinel.ini", "Tareas", "NumTareas", CStr(j)
    For i = 0 To j - 1
        SaveSetting "Sentinel.ini", "Tareas", "Tarea" & CStr(i), LstCfgTarea(0).List(i)
        SaveSetting "Sentinel.ini", "Tareas", "Comando" & CStr(i), LstCfgTarea(1).List(i)
    Next
    'Recursos
    SaveSetting "Sentinel.ini", "Recursos Minimos", "Memoria", TxtCfg(0)
    SaveSetting "Sentinel.ini", "Recursos Minimos", "Recursos", TxtCfg(1)
    'Unidades
    CambiandoLstCfg = True
    'Guardar la información en el fichero ini
    For i = 0 To LstCfg(0).ListCount - 1
        SaveSetting "Sentinel.ini", "Unidades", LstCfg(0).List(i), LstCfg(1).List(i)
    Next
    SaveSetting "Sentinel.ini", "Unidades", "LapsoParaUnidades", LapsoParaUnidades
    
    Set Sentinel = Nothing
    End
End Sub


Private Sub LblSolapa_Click(Index As Integer)
    If Index <= SLPA_CONFIGURAR Then
        SolapaSentinel.Activa = Index
        gSolapa = SolapaSentinel
        ActivarSolapa Me
        SolapaSentinel = gSolapa
    End If
    If Index = SLPA_RECURSOS Then
        '
    ElseIf Index = SLPA_TAREAS Then
        LeerTaskList List1
    ElseIf Index = SLPA_CONFIGURAR Then
        CrearSolapaCfg
    Else
        SolapaCfg.Activa = Index
        gSolapa = SolapaCfg
        ActivarSolapa Me
        SolapaCfg = gSolapa
    End If
End Sub


Private Sub LstCfg_Click(Index As Integer)
    If CambiandoLstCfg Then Exit Sub

    CambiandoLstCfg = True
    If Index = 0 Then
        LstCfg(1).ListIndex = LstCfg(0).ListIndex
    Else
        LstCfg(0).ListIndex = LstCfg(1).ListIndex
    End If
    CboCfg(0).ListIndex = LstCfg(0).ListIndex
    CambiandoLstCfg = False
End Sub


Private Sub LstCfgTarea_Click(Index As Integer)
    Static EstoyAqui As Boolean

    If EstoyAqui Then Exit Sub

    EstoyAqui = True
    If Index = 0 Then
        LstCfgTarea(1).ListIndex = LstCfgTarea(0).ListIndex
    Else
        LstCfgTarea(0).ListIndex = LstCfgTarea(1).ListIndex
    End If
    TxtCfg(3) = LstCfgTarea(0).List(LstCfgTarea(0).ListIndex)
    TxtCfg(4) = LstCfgTarea(1).List(LstCfgTarea(1).ListIndex)
    EstoyAqui = False
End Sub


Private Sub LstCfgTarea_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    Dim i As Integer
    
    'Borrar el item seleccionado
    If KeyCode = vbKeyDelete Then
        If LstCfgTarea(Index).ListCount > 0 Then
            i = LstCfgTarea(0).ListIndex
            LstCfgTarea(0).RemoveItem i
            LstCfgTarea(1).RemoveItem i
        End If
    End If
End Sub


Private Sub Timer1_Timer()
    Dim i As Integer
    
    Screen.MousePointer = vbArrowHourglass
    
    'Los recursos etc, siempre estarán actualizados
    ActualizarInfo
    If DesactivarAlertas Then Exit Sub
    
    If AlertarMemoria Then
        If Valor(LblMem(1)) < Valor(TxtCfg(0)) Then
            i = MsgBox("ATENCION, la Memoria Física " & LblMem(1) & vbCrLf & "es menor que la mínima especificada: " & TxtCfg(0) & vbCrLf & "Pulsa Cancelar para no alertar en la memoria.", vbExclamation + vbOKCancel)
            If i = vbCancel Then
                AlertarMemoria = False
                ActualizarChecksAlertas True
            End If
        End If
    End If
    If AlertarRecursos Then
        If Val(LblMem(3)) < Val(TxtCfg(1)) Then
            i = MsgBox("ATENCION, los Recursos del Sistema son menores que los mínimos especificados." & vbCrLf & "Pulsa Cancelar para alertar si los recursos son bajos.", vbExclamation + vbOKCancel)
            If i = vbCancel Then
                AlertarRecursos = False
                ActualizarChecksAlertas True
            End If
        End If
    End If
    If AlertarUnidades Then
        If Timer > UltimoChequeoUnidades + LapsoParaUnidades Then
            'chequear el espacio en cada unidad, etc...
            TestEspacioUnidades
            UltimoChequeoUnidades = Timer
        End If
    End If
    If AlertarTareas Then
        TestTareas
    End If
    If WindowState = vbMinimized Then
        Caption = "Recursos: " & LblMem(3)
    End If
    Screen.MousePointer = vbDefault
End Sub


Private Sub TxtCfg_Change(Index As Integer)
    Dim i As Long
    
    If Index = 5 Then
        If CambiandoChkCfg Then Exit Sub
        CambiandoChkCfg = True
        i = Val(TxtCfg(Index))
        If i < 0 Or i > 65 Then
            i = 10
        End If
        LapsoEntreChequeo = i
        TxtCfg(Index) = LapsoEntreChequeo
        CambiandoChkCfg = False
        If i = 0 Then
            DesactivarAlertas = True
            ActualizarChecksAlertas True
        End If
    ElseIf Index = 6 Then
        If CambiandoChkCfg Then Exit Sub
        CambiandoChkCfg = True
        i = Val(TxtCfg(Index))
        'máximo 1 hora: 3600 segundos
        If i < 0 Or i > 3600 Then i = 300
        LapsoParaUnidades = i
        TxtCfg(Index) = LapsoParaUnidades
        Label1(2) = Format(Fix(LapsoParaUnidades / 60), "00") & "m " & Format(LapsoParaUnidades Mod 60, "00") & "s"
        CambiandoChkCfg = False
        If i = 0 Then
            AlertarUnidades = False
            ActualizarChecksAlertas True
        End If
    End If
End Sub

Link al listado de gswE3D_n.bas Módulo para hacer efectos tridimensionales en los controles. 

 

Link al listado de gswSolapa.bas Módulo para crear efectos de contenedores con solapas (tabs) 


ir al índice