21. Деактивация нажатий на клавиши CTRL-ALT-DEL, CTRL-ESC и ALT-TAB Top

Win32 не позволяет напрямую отключать переключение между задачами. Тем не менее, реакции на нажатие этих клавиш не происходит, если активен хранитель экрана (screen saver) в режиме с включенной проверкой пароля. Т.е. нам необходимо объявить текущее приложение, как активный хранитель экрана. Это может быть сделано с помощью функции API в Windows 95/98. Пока наше приложение объявлено, как хранитель экрана, ни один реальный хранитель экрана не может быть запущен. В Windows NT это не работает.

Public Declare Function SystemParametersInfo Lib "user32" _
  Alias "SystemParametersInfoA" (ByVal uAction As Long, _
                                 ByVal uParam As Long, lpvParam As Any, _
                                 ByVal fuWinIni As Long) As Long

Public Const SPI_SCREENSAVERRUNNING = 97

Использование: Поместите 2 кнопки на форму и присвойте им имена cmdDisable и cmdEnable. Далее запишите следующий код в модуле формы. Теперь, если вы запустите данную программу, после нажатия на кнопку cmdDisable реакция на нажатие клавиш переключения между задачами будет отключена, а при нажатии на cmdEnable снова восстановлена.

Private Sub cmdDisable_Click()
  SystemParametersInfo SPI_SCREENSAVERRUNNING, True, ByVal 1&, 0
End Sub 

Private Sub cmdEnable_Click()
  SystemParametersInfo SPI_SCREENSAVERRUNNING, False, ByVal 1&, 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
 ' необходимо вкючить реакцию на нажатие системных клавиш до завершения программы!
  cmdEnable_Click
End Sub
22. Как получить список заголовков всех запущенных приложений? Скачайте этот пример Top
Public Declare Function GetDesktopWindow Lib "user32" () As Long 
Public Declare Function GetWindow Lib "user32" _ 
   (ByVal hwnd As Long, ByVal wCmd As Long) As Long 
Public Declare Function GetWindowText Lib "user32" _ 
   Alias "GetWindowTextA" (ByVal hwnd As Long, _ 
                           ByVal lpString As String, _ 
                           ByVal cch As Long) As Long 
Public Declare Function GetWindowTextLength Lib "user32" _ 
   Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long 

Public Const GW_HWNDFIRST = 0 
Public Const GW_HWNDLAST = 1 
Public Const GW_HWNDNEXT = 2 
Public Const GW_HWNDPREV = 3 
Public Const GW_OWNER = 4 
Public Const GW_CHILD = 5

Использование: Поместите на форму объекты ListBox и CommandButton. В модуле формы поместите следующий код:

Private Sub Command1_Click() 
   Dim hwnd& 
   Dim dummy& 
   Dim strCaption$ 

  ' Очищает listbox 
   List1.Clear 

  ' Рабочий стол - самое первое окно 
   hwnd& = GetDesktopWindow() 

  ' Первое дочернее окно - окно первого уровня 
   hwnd& = GetWindow(hwnd&, GW_CHILD) 

  ' Теперь получим заголовки окон всех уровней 
   Do 
      dummy& = GetWindowTextLength(hwnd&) 
      If dummy <> 0 Then 
         strCaption = String(dummy + 1, " ") 
         dummy = GetWindowText(hwnd&, strCaption, dummy + 1) 
         List1.AddItem strCaption 
      End If 
      hwnd& = GetWindow(hwnd&, GW_HWNDNEXT) 
   Loop While hwnd& <> 0 
End Sub
23. Как проиграть WAV файл? Top
Public Declare Function sndPlaySound Lib "winmm.dll" _
  Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

' значения флагов для uFlags параметра
Public Const SND_SYNC = &H0            ' проиграть синхронно (по умолчанию)
Public Const SND_ASYNC = &H1           ' проиграть асинхронно

Public Const SND_NODEFAULT = &H2       ' если файл не найден, не будет тишины, как по умолчанию

Public Const SND_MEMORY = &H4          ' lpszSoundName указывает на файл в памяти
Public Const SND_ALIAS = &H10000       ' имя является записью в WIN.INI [звуки]
Public Const SND_FILENAME = &H20000    ' имя является имененм файла
Public Const SND_RESOURCE = &H40004    ' имя ссылается имя в файле ресурсов
Public Const SND_ALIAS_ID = &H110000   ' имя является названием идентификатора звука в файле WIN.INI [звуки]

Public Const SND_ALIAS_START = 0       ' должно быть > 4096, чтобы позволить находиться строковым записям в той же секции файла ресурсов

Public Const SND_LOOP = &H8            ' зациклить проигрывание файла до следующего вызова sndPlaySound
Public Const SND_NOSTOP = &H10         ' не прекращать проигрывание активных звуков
Public Const SND_VALID = &H1F          ' значимые флаги / ;Internal /

Public Const SND_NOWAIT = &H2000       ' не ждать, если драйвер занят

Public Const SND_VALIDFLAGS = &H17201F ' Множество значимых флагов. Всё, что выходит за
                                       ' за рамки этого диапазона будет вызывать ошибку.
Public Const SND_RESERVED = &HFF000000 ' Частично эти флаги зарезервированы

Public Const SND_TYPE_MASK = &H170007


Public Sub PlaySound(FileName As String)
Dim x%
  x% = sndPlaySound(FileName, 1)
End Sub

Использование:

PlaySound "chord.wav"
24. Как получить имя текущего пользователя? Top
Declare Function GetUserName& Lib "advapi32.dll" _
   Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long)

Использование:

Dim s$, cnt&, dl&
cnt& = 199
s$ = String$(200, 0)
dl& = GetUserName(s$, cnt)
Debug.Print Left$(s$, cnt); cnt
25. Как сгенерировать нажатие левой кнопкой мыши, когда нажата правая? Top
Public Declare Function CallWindowProc Lib "user32" _
  Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
                           ByVal hwnd As Long, _
                           ByVal Msg As Long, _
                           ByVal wParam As Long, _
                           ByVal lParam As Long) As Long

Public Declare Function GetWindowLong Lib "user32" _
  Alias "GetWindowLongA" (ByVal hwnd As Long, _
                          ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "user32" _
  Alias "SetWindowLongA" (ByVal hwnd As Long, _
                          ByVal nIndex As Long, _
                          ByVal dwNewLong As Long) As Long

Public Const GWL_WNDPROC = (-4)

Declare Function SendMessageBynum Lib "user32" _
   Alias "SendMessageA" (ByVal hwnd As Long, _
                         ByVal wMsg As Long, _
                         ByVal wParam As Long, _
                         ByVal lParam As Long) As Long

Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_RBUTTONUP = &H205

Public glngPrevWndProc As Long

Dim wp As Long, lp As Long

Public Function MyWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  ' Если правая кнопка мыши отпущена после нажатия...
   If Msg = WM_RBUTTONUP Then
      wp = wParam
      lp = lParam
     
     ' Дважды щёлкнуть левой кнопкой мыши
      SendMessageBynum hwnd, WM_LBUTTONDOWN, wp, lp
      SendMessageBynum hwnd, WM_LBUTTONUP, wp, lp
      SendMessageBynum hwnd, WM_LBUTTONDBLCLK, wp, lp
      SendMessageBynum hwnd, WM_LBUTTONUP, wp, lp
      
     ' Показывать всплывающее меню
      If Form1.Option1(1) Then
         MyWindowProc = 0
         Exit Function
      End If
   End If
 
 ' остальные сообщения передаются для обработки стандартной
 ' процедуре окна
  MyWindowProc = CallWindowProc(glngPrevWndProc, hwnd, Msg, wParam, lParam)
End Function

Использование: Создайте форму и поместите на неё текстовое поле и 2 радио-кнопки с индексами, равными 0 и 1

Private Sub Form_Load()
   Dim l As Long
 ' Перенаправление сообщений Windows от формы к собственной
 ' процедуре обработки сообщений Module1.MyWindowProc
  glngPrevWndProc = GetWindowLong(Text1.hwnd, GWL_WNDPROC)
  SetWindowLong Text1.hwnd, GWL_WNDPROC, AddressOf MyWindowProc
End Sub

Private Sub Form_Unload(Cancel As Integer)
 ' Возвращение управления форме
  SetWindowLong Text1.hwnd, GWL_WNDPROC, glngPrevWndProc
End Sub
 
26. Как узнать дату создания, изменения и доступа к любому файлу? Как изменить эти значения? Top
' Открывает указанный файл в режиме двоичного доступа.
' Эта функция необходима нам для получения доступа к датам файла и изменения их.
Declare Function lopen& Lib "kernel32" Alias "_lopen" _
      (ByVal lpPathName As String, ByVal iReadWrite As Long)

' Закрывает указанный файл.
Declare Function lclose& Lib "kernel32" _
      Alias "_lclose" (ByVal hFile As Long)

Public Const READAPI = 0
Public Const WRITEAPI = 1
Public Const READ_WRITE = 2

' Получает информацию из указанного файла о дате времени.
' Аргументы lpCreationTime, lpLastAcccessTime и lpLastWriteTime могут быть
' установлены в ноль (тогда передайте эти аргументы ByVal As Long), если
' вам они не нужны. Дата возращается этой функцией в формате UTC.
Declare Function GetFileTime& Lib "kernel32" _
      (ByVal hFile As Long, lpCreationTime As FILETIME, _
       lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME)

' Устанавливает время создания, изменения и последнего доступа к файлу.
Declare Function SetFileTime& Lib "kernel32" _
      (ByVal hFile As Long, lpCreationTime As FILETIME, _
       lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME)

' 64-битное число, указывающее на прошедшее время
' с 1 января 1601 г. с единицей измерения 100 наносекунд.
Type FILETIME  '  8  бит
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type



' Записывает аргумент со структурой FILETIME
' во второй аргумент со структурой SYSTEMTIME.
Declare Function FileTimeToSystemTime& Lib "kernel32" _
      (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME)

' Записывает аргумент со структурой SYSTEMTIME
' во второй аргумент со структурой FILETIME.
Declare Function SystemTimeToFileTime& Lib "kernel32" _
      (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME)

' Эта структура содержит информацию о времени и дате.
Type SYSTEMTIME  '  16 бит
     wYear As Integer
     wMonth As Integer
     wDayOfWeek As Integer
     wDay As Integer
     wHour As Integer
     wMinute As Integer
     wSecond As Integer
     wMilliseconds As Integer
End Type

Использование:
Sub Main()
Dim lFileHwnd  As Long
Dim lDummy     As Long
Dim ftModified As FILETIME
Dim ftCreated  As FILETIME
Dim ftAccessed As FILETIME
Dim stCreated  As SYSTEMTIME

  ' Поменяйте C:\AUTOEXEC.BAT на любой другой файл
   lFileHwnd = lopen("C:\AUTOEXEC.BAT", READ_WRITE)
   GetFileTime lFileHwnd, ftCreated, ftAccessed, ftModified
   FileTimeToSystemTime ftCreated, stCreated
   With stCreated
      Debug.Print .wDay & "." & .wMonth & "." & .wYear & ", " & _
            .wHour & ":" & .wMinute & ":" & .wSecond & ":" & .wMilliseconds
   End With
  ' Увеличивает год создания файла на 5
   stCreated.wYear = stCreated.wYear + 5
   SystemTimeToFileTime stCreated, ftCreated
   SetFileTime lFileHwnd, ftCreated, ftAccessed, ftModified
   
  ' Проверка
   GetFileTime lFileHwnd, ftCreated, ftAccessed, ftModified
   FileTimeToSystemTime ftCreated, stCreated
   With stCreated
      Debug.Print .wDay & "." & .wMonth & "." & .wYear
   End With
   
   lDummy = lclose(lFileHwnd)
   
End Sub