|
|
1. Disabling CTRL-ALT-DEL, CTRL-ESC and ALT-TAB
2.How to get all running windows titles?
3. How to play a WAV file?
4. How to retrieve the name of the current user?
5.How to generate left-clicks, when you right-click?
6. How to get the dates of any file's creation,
last access and last modification? How to change them?
1. Disabling CTRL-ALT-DEL, CTRL-ESC and ALT-TAB
Win32 provides no direct method for disabling task-switching functions. They are, however, disabled whenever the screen saver is active in order to provide for password-protected savers. This can be exploited under Windows 95 by using API calls to declare the current application to be an active screen saver. The actual screen saver will not start while this is in effect. This also does not function under 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
Using: Place 2 buttons in a form and name them as cmdDisable and cmdEnable. Then write this code in the form. Now if you click on the cmdDisable button you will disable task-switching functions and enable it again if you click on the cmdEnable button.
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) ' re-enable Ctrl+Alt+Del and Alt+Tab before the program terminates! cmdEnable_Click End Sub
2.How to get all running windows titles?
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
Using: Place a ListBox and a CommandButton on your form. In the form place the next code:
Private Sub Command1_Click()
Dim hwnd&
Dim dummy&
Dim strCaption$
' Clear the listbox
List1.Clear
' The desktop is the highest window
hwnd& = GetDesktopWindow()
' It's first child is the 1st top level window
hwnd& = GetWindow(hwnd&, GW_CHILD)
' Now load all top level windows
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
3. How to play a WAV file?
Public Declare Function sndPlaySound Lib "winmm.dll" _
Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
' flag values for uFlags parameter
Public Const SND_SYNC = &H0 ' play synchronously (default)
Public Const SND_ASYNC = &H1 ' play asynchronously
Public Const SND_NODEFAULT = &H2 ' silence not default, if sound not found
Public Const SND_MEMORY = &H4 ' lpszSoundName points to a memory file
Public Const SND_ALIAS = &H10000 ' name is a WIN.INI [sounds] entry
Public Const SND_FILENAME = &H20000 ' name is a file name
Public Const SND_RESOURCE = &H40004 ' name is a resource name or atom
Public Const SND_ALIAS_ID = &H110000 ' name is a WIN.INI [sounds] entry identifier
Public Const SND_ALIAS_START = 0 ' must be > 4096 to keep strings in same section of resource file
Public Const SND_LOOP = &H8 ' loop the sound until next sndPlaySound
Public Const SND_NOSTOP = &H10 ' don't stop any currently playing sound
Public Const SND_VALID = &H1F ' valid flags / ;Internal /
Public Const SND_NOWAIT = &H2000 ' don't wait if the driver is busy
Public Const SND_VALIDFLAGS = &H17201F ' Set of valid flag bits. Anything outside
' this range will raise an error
Public Const SND_RESERVED = &HFF000000 ' In particular these flags are reserved
Public Const SND_TYPE_MASK = &H170007
Public Sub PlaySound(FileName As String)
Dim x%
x% = sndPlaySound(FileName, 1)
End Sub
Using:
PlaySound "chord.wav"
4. How to retrieve the name of the current user?
Declare Function GetUserName& Lib "advapi32.dll" _ Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long)
Using:
Dim s$, cnt&, dl& cnt& = 199 s$ = String$(200, 0) dl& = GetUserName(s$, cnt) Debug.Print Left$(s$, cnt); cnt
5.How to generate left-clicks, when you right-click?
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 the right button has released...
If Msg = WM_RBUTTONUP Then
wp = wParam
lp = lParam
' Double-click by the left mouse button
SendMessageBynum hwnd, WM_LBUTTONDOWN, wp, lp
SendMessageBynum hwnd, WM_LBUTTONUP, wp, lp
SendMessageBynum hwnd, WM_LBUTTONDBLCLK, wp, lp
SendMessageBynum hwnd, WM_LBUTTONUP, wp, lp
' Show pop-up menu
If Form1.Option1(1) Then
MyWindowProc = 0
Exit Function
End If
End If
' pass the rest messages onto VB's own Window Procedure
MyWindowProc = CallWindowProc(glngPrevWndProc, hwnd, Msg, wParam, lParam)
End Function
Using: Create a form and place a TextBox and two CheckBox (with Index=0 and =1)
Private Sub Form_Load() Dim l As Long ' Redirect Windows messages to our Window Procedure ' Module1.MyWindowProc glngPrevWndProc = GetWindowLong(Text1.hwnd, GWL_WNDPROC) SetWindowLong Text1.hwnd, GWL_WNDPROC, AddressOf MyWindowProc End Sub Private Sub Form_Unload(Cancel As Integer) ' pass control back to VB SetWindowLong Text1.hwnd, GWL_WNDPROC, glngPrevWndProc End Sub
6. How to get the dates of any file's creation,
last access and last modification? How to change them?
' Opens the specified file in binary mode.
' We need it to get the file's date and set a new date.
Declare Function lopen& Lib "kernel32" Alias "_lopen" _
(ByVal lpPathName As String, ByVal iReadWrite As Long)
' Closes the specified file.
Declare Function lclose& Lib "kernel32" _
Alias "_lclose" (ByVal hFile As Long)
Public Const READAPI = 0
Public Const WRITEAPI = 1
Public Const READ_WRITE = 2
' Retrieves time information for the specified file.
' The lpCreationTime, lpLastAcccessTime and lpLastWriteTime can be
' set to zero (pass ByVal As Long) if you do not need that
' information. File times returned by this function are UTC.
Declare Function GetFileTime& Lib "kernel32" _
(ByVal hFile As Long, lpCreationTime As FILETIME, _
lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME)
' Sets the file creation, access and last modification time.
Declare Function SetFileTime& Lib "kernel32" _
(ByVal hFile As Long, lpCreationTime As FILETIME, _
lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME)
' 64-bit number specifying the elapsed time
' since January 1, 1601, in 100-nanosecond increments.
Type FILETIME ' 8 Bytes
dwLowDateTime As Long
dwHighDateTime As Long
End Type
' Records an argument with FILETIME structure to
' the second one with SYSTEMTIME structure.
Declare Function FileTimeToSystemTime& Lib "kernel32" _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME)
' Records an argument with SYSTEMTIME structure to
' the second one with FILETIME structure.
Declare Function SystemTimeToFileTime& Lib "kernel32" _
(lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME)
' This structure contains date and time information.
Type SYSTEMTIME ' 16 Bytes
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
' Change C:\AUTOEXEC.BAT to any other file
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
' Increment the year of the file's creation
stCreated.wYear = stCreated.wYear + 5
SystemTimeToFileTime stCreated, ftCreated
SetFileTime lFileHwnd, ftCreated, ftAccessed, ftModified
' Check
GetFileTime lFileHwnd, ftCreated, ftAccessed, ftModified
FileTimeToSystemTime ftCreated, stCreated
With stCreated
Debug.Print .wDay & "." & .wMonth & "." & .wYear
End With
lDummy = lclose(lFileHwnd)
End Sub