Function ReadUpTime() As Long
      Dim r&, hKey&
      Dim lLastTime&

  r = RegCreateKeyEx(HKEY_CURRENT_USER, "Software\MyApp", 0&, vbNullString, 0&, KEY_ALL_ACCESS, 0&, hKey, REG_OPENED_EXISTING_KEY)
  
  If r = ERROR_SUCCESS Then
    r = RegQueryValueExInt(hKey, "LastTime", 0&, REG_DWORD, lLastTime, 4)
    
    ReadUpTime = lLastTime
    
    r = RegCloseKey(hKey)
  End If
End Function

Function WriteUpTime(LastUptime As Long) As Boolean
      Dim r&, hKey&
      Dim lLastTime&

  r = RegCreateKeyEx(HKEY_CURRENT_USER, "Software\MyApp", 0&, vbNullString, 0&, KEY_ALL_ACCESS, 0&, hKey, REG_OPENED_EXISTING_KEY)
  
  If r = ERROR_SUCCESS Then
    r = RegSetValueExInt(hKey, "LastTime", 0&, REG_DWORD, LastUptime, 4)
    
    WriteUpTime = (r = ERROR_SUCCESS)
    
    r = RegCloseKey(hKey)
  End If
End Function

Private lUptime As Long

Private Sub Form_Load()
  lUptime = ReadUpTime
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Call WriteUpTime(lUptime)
End Sub

Private Sub tmrUptime_Timer()
  lUptime = lUptime + 1
  lblUptime = "Tiempo desde el inicio de la aplicación: " & lUptime & " seg"
End Sub

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Const GWL_STYLE = (-16)

Const WS_CAPTION = &HC00000
Const WS_OVERLAPPED = &H0&
Const WS_SYSMENU = &H80000
Const WS_THICKFRAME = &H40000
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)

Const SWP_NOMOVE = &H2
Const SWP_FRAMECHANGED = &H20
Const SWP_NOSIZE = &H1
Const SWP_NOZORDER = &H4

Private Sub ShowBorder(Optional bShow As Boolean = True)
  If bShow Then
    Call SetWindowLong(hwnd, GWL_STYLE, GetWindowLong(hwnd, GWL_STYLE) Or WS_OVERLAPPEDWINDOW)
  Else
    Call SetWindowLong(hwnd, GWL_STYLE, GetWindowLong(hwnd, GWL_STYLE) And Not WS_OVERLAPPEDWINDOW)
  End If
  
  Call SetWindowPos(hwnd, 0&, 0&, 0&, 0&, 0&, SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOZORDER Or SWP_NOSIZE)
End Sub

    Dim csControl

  For Each csControl In Controls
    If TypeOf csControl Is Menu Then
      csControl.Visible = Not csControl.Visible
    End If
  Next

Option Explicit

Type RES_ICON
  ResName As Integer
  ResLang As Integer
End Type

Public Declare Function BeginUpdateResource9x Lib "unicows.dll" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Public Declare Function UpdateResource9x Lib "unicows.dll" Alias "UpdateResourceA" (ByVal hUpdate As Long, ByVal lpType As Long, ByVal lpName As Long, ByVal wLanguage As Long, lpData As Any, ByVal cbData As Long) As Long
Public Declare Function EndUpdateResource9x Lib "unicows.dll" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long

Public Declare Function BeginUpdateResourceNT Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Public Declare Function UpdateResourceNT Lib "kernel32" Alias "UpdateResourceA" (ByVal hUpdate As Long, ByVal lpType As Long, ByVal lpName As Long, ByVal wLanguage As Long, lpData As Any, ByVal cbData As Long) As Long
Public Declare Function EndUpdateResourceNT Lib "kernel32" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long

Public Declare Function EnumResourceLanguages Lib "kernel32" Alias "EnumResourceLanguagesA" (ByVal hModule As Long, ByVal lpType As Long, ByVal lpName As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Function EnumResourceNames Lib "kernel32" Alias "EnumResourceNamesA" (ByVal hModule As Long, ByVal lpType As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long

Private iResLangId    As Integer
Private lResName      As Long

Private lpIcons() As RES_ICON
Private lIcons    As Long

Function ChangeIcon(Filename As String, IconFilename As String) As Boolean
  On Error GoTo ErrRes
  
        Dim btIconData()  As Byte
        Dim lpResIcon()   As RES_ICON
        Dim hRes&, lCnt&
        Dim i%, r&
  
  lCnt = EnumIcons(Filename, lpResIcon)
  
  If IsWin9x Then
    hRes = BeginUpdateResource9x(Filename, False)
  Else
    hRes = BeginUpdateResourceNT(Filename, False)
  End If
  
  If hRes = 0 Then
    Debug.Print "No se pudo abrir el archivo"
    
    Exit Function
  End If

  btIconData = GetIconData(IconFilename)
  
  For i = 1 To lCnt
    If IsWin9x Then
      r = UpdateResource9x(hRes, RT_ICON, lpResIcon(i).ResName, lpResIcon(i).ResLang, btIconData(0), UBound(btIconData))
    Else
      r = UpdateResourceNT(hRes, RT_ICON, lpResIcon(i).ResName, lpResIcon(i).ResLang, btIconData(0), UBound(btIconData))
    End If
  Next
  
  ChangeIcon = True
  
ErrRes:
  If IsWin9x Then
    r = EndUpdateResource9x(hRes, False)
  Else
    r = EndUpdateResourceNT(hRes, False)
  End If
End Function

Function IsWin9x() As Boolean
      Dim lpVerInfo As OSVERSIONINFO
      Dim r&

  lpVerInfo.dwOSVersionInfoSize = Len(lpVerInfo)
  
  r = GetVersionEx(lpVerInfo)
  IsWin9x = (lpVerInfo.dwPlatformId = 1)
End Function

Function EnumIcons(Filename As String, outResIcon() As RES_ICON) As Long
  Call EnumResNames(Filename)
  
  outResIcon = lpIcons
  EnumIcons = lIcons
  
  lIcons = 0
  Erase lpIcons
End Function

Function EnumResNames(AppFilename As String) As Long
        Dim hModule&, r&

  hModule = LoadLibraryEx(ByVal AppFilename, 0, LOAD_LIBRARY_AS_DATAFILE)

  r = EnumResourceNames(hModule, RT_ICON, AddressOf EnumResNameProc, 0)

  Call FreeLibrary(hModule)
  
  EnumResNames = r
End Function

Function EnumResLangProc(ByVal hModule As Long, ByVal dwType As Long, ByVal dwName As Long, ByVal wIDLanguage As Integer, ByVal lParam As Long) As Long
      Dim r&
      
  iResLangId = wIDLanguage
  
  lIcons = lIcons + 1
  
  ReDim Preserve lpIcons(lIcons) As RES_ICON
  
  With lpIcons(lIcons)
    .ResLang = iResLangId
    .ResName = lResName
  End With
  
  EnumResLangProc = 1
  
End Function

Function EnumResNameProc(ByVal hModule As Long, ByVal dwType As Long, ByVal dwName As Long, ByVal lParam As Long) As Long
        Dim r&
        
  lResName = dwName
  
  If lResName >= 0 Then
    r = EnumResourceLanguages(hModule, RT_ICON, lResName, AddressOf EnumResLangProc, 0)
  End If
  
  EnumResNameProc = 1
End Function