Saber si existe un archivo y
deshabilitar el botón cerrar de un formulario

Fecha: 03/Feb/99 (04/Ene/99)
Autor: Harold Uribe < [email protected] >

Hola guille

Te envío dos colaboraciones para tus páginas:

1. Una versión mejorada para saber si existe un archivo sin importar de que tipo es; esta trabaja usando API en Win32

2. Deshabilitar el botón "Close" de un formulario


Espero te sirvan

Harold G. Uribe
Sistran Colombia
[email protected]
[email protected]

El código:

'
'*************************************************************
' Constantes y declaraciones para la función ExisteArchivo
'*************************************************************
'Tipos, constantes y funciones para FileExist
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1

Private Type FILETIME
      dwLowDateTime       As Long
      dwHighDateTime      As Long
End Type

Private Type WIN32_FIND_DATA
      dwFileAttributes    As Long
      ftCreationTime      As FILETIME
      ftLastAccessTime    As FILETIME
      ftLastWriteTime     As FILETIME
      nFileSizeHigh       As Long
      nFileSizeLow        As Long
      dwReserved0         As Long
      dwReserved1         As Long
      cFileName           As String * MAX_PATH
      cAlternate          As String * 14
End Type
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
    (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" _
    (ByVal hFindFile As Long) As Long


' Esta es la función que debe ser invocada, y devuelve true si encuentra el archivo o false si no lo encuentra
' El parámetro sFile dene ser el nombre y path completo del archivo que queremos saber si existe

Public Function ExisteArchivo(ByVal sFile As String) As Boolean
   'comprobar si existe un archivo
   Dim WFD As WIN32_FIND_DATA
   Dim hFindFile As Long
   hFindFile = FindFirstFile(sFile, WFD)
   'Si no se ha encontrado
   If hFindFile = INVALID_HANDLE_VALUE Then
      ExisteArchivo = False
   Else
      ExisteArchivo = True
      'Cerrar el handle de FindFirst
      hFindFile = FindClose(hFindFile)
   End If
End Function

' Declaraciones para la función que dehabilita el menú close

Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

' Funcion que se encarga de la deshabilitación
' El parámetro Frm debe ser el formulario al cual le quiero deshabilitar el botón Close

Public Sub DeshabilitarMenus(ByRef Frm As Form)

   Const MF_PORPOSICION = &H400&
   Const MF_ELIMINAR = &H1000&
   
   Dim IngHMenu As Long
   Dim IngMenuItemCount As Long
   Dim IngResult As Long

   IngHMenu = GetSystemMenu(Frm.hwnd, 0)
   
   If IngHMenu Then
      IngMenuItemCount = GetMenuItemCount(IngHMenu)
      ' Eliminar el menu Close
      Call RemoveMenu(IngHMenu, IngMenuItemCount - 1, MF_ELIMINAR Or MF_PORPOSICION)
      ' Eliminar el separador de menu
      Call RemoveMenu(IngHMenu, IngMenuItemCount - 2, MF_ELIMINAR Or MF_PORPOSICION)
      ' Redibujar el menu
      Call DrawMenuBar(Frm.hwnd)
   End If

End Sub

' Función que habilita nuevamente el botón Close
' El parámetro Frm debe ser el formulario al cual le quiero habilitar el botón Close
Public Sub HabilitarMenus(ByRef Frm As Form)

   Const MF_PORPOSICION = &H400&
   Const MF_ELIMINAR = &H1000&
   Const MF_STRING = &H0&
   Const MF_SEPARADOR = &H800&
      
      
   Dim IngHMenu As Long
   Dim IngMenuItemCount As Long
   Dim IngResult As Long

   IngHMenu = GetSystemMenu(Frm.hwnd, 0)
   
   If IngHMenu Then
      IngMenuItemCount = GetMenuItemCount(IngHMenu)
      ' Agregar el separador
      Call AppendMenu(IngHMenu, MF_SEPARADOR, 0, "")
      ' Agregar el menu close
      ' 61536 fué obtenido con GetMenuID durante la etapa de diseño
      Call AppendMenu(IngHMenu, MF_STRING, 61536, "&Cerrar Alt + F4")
      
      ' Redibujar el menu
      Call DrawMenuBar(Frm.hwnd)
   End If

End Sub