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)