Wednesday, November 2, 2011


Windows API Calls Programs

Found from http://www.angelfire.com/poetry/vbpoet/myvb.htm


Convert the letters in a string to all Lower case letters
Private Declare Function CharLower Lib "user32.dll" Alias "CharLowerA" (ByVal lpsz As String) As String
Private Sub Form_Load()
' Convert the string "This is a TEST for LOWER Case Convertion!" into lower-case.
Dim t As String  ' target string
t = CharLower("This is a TEST for LOWER Case Convertion!")  ' Convert to lower-case
MsgBox t
End
End Sub


Convert the letters in a string to all Upper case letters
Private Declare Function CharUpper Lib "user32.dll" Alias "CharUpperA" (ByVal lpsz As String) As String
Private Sub Form_Load()
' Convert the string "This is a test for upper Case Convertion!" into upper-case.
Dim t As String  ' target string
t = CharUpper("This is a test for upper Case Convertion!")  ' Convert to upper-case
MsgBox t
End
End Sub


Copy a file
Private Declare Function CopyFile Lib "kernel32.dll" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Sub Form_Load()
Dim retval As Long  ' return value
' copy the file
retval = CopyFile("D:\sample.txt", "D:\example.txt", 1)  '1 indicates return value if succeeded
If retval = 0 Then  ' failure
MsgBox "Error copying file."
Else  ' success
MsgBox "Copy succeeded."
End If
End
End Sub


Move a file
Private Declare Function MoveFile Lib "kernel32.dll" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long
Private Sub Form_Load()
Dim retval As Long  ' return value
retval = MoveFile("D:\showagent.txt", "D:\showagent1.txt")
If retval = 0 Then
MsgBox "File not found"
Else
MsgBox "File Move successful"
End If
End
End Sub


Display Shutdown dialog screen
Private Declare Sub ExitWindowsDialog Lib "shell32.dll" Alias "#60" (ByVal hwndOwner As Long)
Private Sub Form_Load()
' Shut Down Windows dialog box.
ExitWindowsDialog 0
End
End Sub


Display the restart or shutdown dialog
Private Declare Function RestartDialog Lib "shell32.dll" Alias "#59" (ByVal hwndOwner  As Long, ByVal lpstrReason As String, ByVal uFlags As Long) As Long
Private Sub Form_Load()
'Restart
retval = RestartDialog(Form1.hWnd, "I warn you that ", 2)
'Shutdown
'retval = RestartDialog(Form1.hWnd, "I warn you to Shutdown the system ", 1)
End
End Sub


Display shutdown dialog screen
Private Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal YourGuess As Long) As Long
Private Sub Form_Load()
SHShutDownDialog 0
End
End Sub


To LOGOFF or SHUTDOWN or REBOOT or FORCE LOGOFF
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Sub Command1_Click()
'Logoff
ExitWindowsEx 0, 0
'Shutdown
'ExitWindowsEx 1, 0
'Reboot
'ExitWindowsEx 2, 0
'Force Logoff
'ExitWindowsEx 4, 0
End Sub


Flash the Window
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
Private Declare Function FlashWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Command1_Click()
Dim c As Integer
Dim hactive As Long ' handle for the active window
Dim retval As Long  ' return value
hactive = GetActiveWindow()  ' get the handle of active window
For c = 1 To 20  ' flash ten times
retval = FlashWindow(hactive, 1)  'Change the look of the window
Sleep 500  ' Delay the execution for 1/2 minute
Next c
retval = FlashWindow(hactive, 0)  ' Bring the window to normal look
End Sub


Set Computer Name
Private Declare Function SetComputerName Lib "kernel32" Alias "SetComputerNameA" (ByVal lpComputerName As String) As Long
Private Sub Form_Load()
SetComputerName "Karthik"
End
End Sub


Get Computer Name
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Sub Form_Load()
Dim a As String * 256
x = GetComputerName(a, 256)
MsgBox Left(a, InStr(a, Chr(0)) - 1)
End
End Sub


Get the System directory of your OS
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Sub Form_Load()
Dim a As String * 256
GetSystemDirectory a, 256
MsgBox Left(a, InStr(a, Chr(0)) - 1)
End
End Sub


Get the Temp directory of your OS
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Sub Form_Load()
Dim a As String * 256
GetTempPath 256, a
MsgBox Left(a, InStr(a, Chr(0)) - 1)
End
End Sub


Get the Windows directory of your OS
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Sub Form_Load()
Dim a As String * 256
GetWindowsDirectory a, 256
MsgBox Left(a, InStr(a, Chr(0)) - 1)
End
End Sub


Get your OS information
Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Sub Form_Load()
Dim os As OSVERSIONINFO  ' receives version information
Dim retval As Long  ' return value
os.dwOSVersionInfoSize = Len(os)  ' set the size of the structure
retval = GetVersionEx(os)  ' read Windows's version information
MsgBox "Windows version number:" & os.dwMajorVersion & Chr(Asc(".")) & os.dwMinorVersion
MsgBox "OS Version Info Size = " & os.dwOSVersionInfoSize
MsgBox "BuildNumber = " & os.dwBuildNumber
MsgBox "Platform ID = " & os.dwPlatformId 'Note If ID =0 win 3.x , ID=1 win9x and ID =2 WINNT
MsgBox "CSD Version = " & os.szCSDVersion
End
End Sub


Get the screen resolution
Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
Private Sub Form_Load()
MsgBox "Current Screen Resolution is " & GetSystemMetrics(SM_CXSCREEN) & " x " & GetSystemMetrics(SM_CYSCREEN)
End
End Sub


Add a file to recent documents menu
Private Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, ByVal pv As Any)
Private Sub Form_Load()
'  add the file D:\VBFinished\myagent.ini to the recent documentsmenu.
SHAddToRecentDocs 2, "D:\VBFinished\myagent.ini"
End
End Sub


Clear the recent documents menu
Private Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, ByVal pv As Any)
Private Sub Form_Load()
'Silently Clear the Documents menu entirely.
SHAddToRecentDocs 0, anything
End
End Sub


Clear recylebin without confirmation
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hwnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Private Declare Function SHUpdateRecycleBinIcon Lib "shell32.dll" () As Long
Private Sub Form_Load()
' Delete the contents in the Recycle Bin, without confirmation
Dim retval As Long  ' return value
retval = SHEmptyRecycleBin(Form1.hwnd, "", 1)
If retval <> 0 Then  ' error
retval = SHUpdateRecycleBinIcon()
End If
End
End Sub


To show or hide mouse pointer
Private Declare Function ShowCursor& Lib "user32" (ByVal bShow As Long)
Private Sub Command1_Click()
'To show the cursor, use this:
ShowCursor (1)
'To hide the cursor, use this:
ShowCursor (0)
End Sub


Delay
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Load()
MsgBox "Before Sleep"
Sleep 3000 ' Delay 3 seconds
MsgBox "After Sleep"
End
End Sub


Swap Mouse buttons
Private Declare Function SwapMouseButton Lib "user32" (ByVal bSwap As Long) As Long
Private Sub Command1_Click()
'Swap the mouse buttons
SwapMouseButton 1
End Sub
Private Sub Command2_Click()
'Bring to normal position
SwapMouseButton 0
End Sub
Private Sub Command3_Click()
End
End Sub


Enable or Disable CONTROL + ALT + DELETE
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Sub Command1_Click()
'Disable Ctrl+Alt+Del,Ctrl+Esc and Alt+Tab
SystemParametersInfo 97, True, waste, 0
End Sub
Private Sub Command2_Click()
'Enable Ctrl+Alt+Del,Ctrl+Esc and Alt+Tab
SystemParametersInfo 97, False, waste, 0
End Sub


Map Network drives or printers
Private Declare Function WNetConnectionDialog Lib "mpr.dll" (ByVal hwnd As Long, ByVal dwType As Long) As Long
Private Sub Command1_Click()
'Map Network Drives
x = WNetConnectionDialog(Form1.hwnd, 1)
End Sub
Private Sub Command2_Click()
'Map Network Printers
x = WNetConnectionDialog(Form1.hwnd, 2)
End Sub
Private Sub Command3_Click()
End
End Sub


Remove mapped network drives or printers
Private Declare Function WNetDisconnectDialog Lib "mpr.dll" (ByVal hwnd As Long, ByVal dwType As Long) As Long
Private Sub Command1_Click()
'Remove mapped Network Drives
x = WNetDisconnectDialog(Form1.hwnd, 1)
End Sub
Private Sub Command2_Click()
'Remove mapped Network Printers
x = WNetDisconnectDialog(Form1.hwnd, 2)
End Sub
Private Sub Command3_Click()
End
End Sub


Get network logged on username
Private Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long
Private Sub Form_Load()
Dim b As String * 128
WNetGetUser "", b, 128
MsgBox b
End
End Sub


Writing a string data into WIN.INI
Private Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Private Sub Form_Load()
' Set the "Wallpaper" setting in the [Desktop] section of WIN.INI  to C:\Windows\Plus!.bmp.
' WARNING: Use extreme caution when editing the WIN.INI file, because writing bad data to it can create disasterous results to the system!
Dim retval As Long  ' return value
' Set the value.
retval = WriteProfileString("Desktop", "Wallpaper", "C:\Windows\Plus!.bmp")
End
End Sub


Get  a string data from WIN.INI
Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Private Sub Form_Load()
' Read the value "Wallpaper" from under the [Desktop] section  of WIN.INI.  If an error occurs, the function will return "Error"
Dim wallpaper As String  ' receives string read from WIN.INI
Dim slength As Long  ' receives length of string read from WIN.INI
Dim buffer As String * 255
' Read the string from WIN.INI
slength = GetProfileString("Desktop", "Wallpaper", "Error", buffer, 255)
wallpaper = Mid(buffer, 1, InStr(buffer, Chr(0)) - 1) ' extract the returned string from the buffer
If wallpaper = "Error" Then
MsgBox "Could not read information from WIN.INI."
Else
MsgBox "Current Wallpaper is " & wallpaper
End If
End
End Sub


Get a integer data from WIN.INI
Private Declare Function GetProfileInt Lib "kernel32" Alias "GetProfileIntA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal nDefault As Long) As Long
Private Sub Form_Load()
' Read the value "WallpaperStyle" under the [Desktop] section of the WIN.INI file.  Return -1 if an error occured.
Dim tile As Long  ' receives the information read from WIN.INI
' Read the data from WIN.INI
tile = GetProfileInt("Desktop", "TileWallPaper", -1)
If tile = 0 Then
MsgBox "Wallpaper is not tiled."
End If
If tile = 1 Then
MsgBox "Wallpaper is tiled"
End If
End
End Sub


Write a string data to an  INI file
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Sub Form_Load()
' Set the value India to "country" in the [ReleaseSoft] section of G:\myagent.ini .
'Also set the value 14 to "zip" under the same section
Dim retval As Long  ' return value
' Set the string value.
retval = WritePrivateProfileString("ReleaseSoft", "country", "India", "G:\myagent.ini")
' Set the numeric value.
retval = WritePrivateProfileString("ReleaseSoft", "zip", "14", "G:\myagent.ini")
End
End Sub


Write a section of data to an INI file
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Private Sub Form_Load()
'Write a section in the user defined INI file
x = WritePrivateProfileSection("Karthik", "Grade=Best", "G:\myagent.ini")
'Note : When executing next line the previously written value Grade=best will be erased
x = WritePrivateProfileSection("Very Big ", "email=vb_poet@hotmail.com", "G:\myagent.ini")
End
End Sub


Get an integer data from an INI file
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Private Sub Form_Load()
' Read the "Accesscode" value under the "[Sample]" section
' of the INI file G:\myagent.ini
Dim mycode As Long  ' receives the value returned from the INI file
mycode = GetPrivateProfileInt("Sample", "AccessCode", -1, "G:\myagent.ini")
' Display the result
If mycode = -1 Then  ' failure
MsgBox "Could not read the information from the INI file."
Else
MsgBox "Access Code = " & mycode
End If
End
End Sub
'Note: Values read are not case sensitive


Get a string data from an INI file
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Sub Form_Load()
' Read the "email" value under the [ReleaseSoft] section of
' the INI file G:\myagent.ini.
Dim mymail As String  ' receives the value read from the INI file
Dim slength As Long  ' receives length of the returned string
mymail = Space(255)  ' provide enough room for the function to put the value into the buffer
' Read from the INI file
slength = GetPrivateProfileString("ReleaseSoft", "email", "-1", mymail, 255, "G:\myagent.ini")
mymail = Left(mymail, slength)  ' extract the returned string from the buffer
If mymail <> "-1" Then
MsgBox "Mail ID is  " & mymail
Else
MsgBox "Data not found"
End If
End
End Sub


Get the length of a string
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Sub Form_Load()
' Display the length of the string "Mission Impossible"
Dim slength As Long  ' receives the length of the string
slength = lstrlen("Mission Impossible")  ' find the length of the string
MsgBox "The string 'Mission Impossible' contains " & slength & " characters."
End
End Sub


Copy a string to another variable
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Sub Form_Load()
' Copy the source string to the target string
Dim source As String, target As String  ' the two strings
Dim retval As Long  ' return value
source = "Mission Impossible"  ' the source string to copy
target = Space(Len(source))
retval = lstrcpy(target, source)  ' set target to equal source
MsgBox "Source string = " & source
MsgBox "Target string = " & target
End
End Sub


Copy  n-1 number of characters from source string to the target string
Private Declare Function lstrcpyn Lib "kernel32.dll" Alias "lstrcpynA" (ByVal lpString1 As Any, ByVal lpString2 As Any, ByVal iMaxLength As Long) As Long
Private Sub Form_Load()
' Copy the specified n-1 number of characters from source string to the target string
Dim source As String, target As String  ' the two strings
Dim retval As Long  ' return value
source = "Mission Impossible"  ' the source string to copy
target = Space(7)
retval = lstrcpyn(target, source, 7)
target = Left(target, Len(target) - 1)  ' remove the terminating null character
MsgBox "Source string = " & source
MsgBox "Target string = " & target
End
End Sub


Change Wallpaper Immediately
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_UPDATEINIFILE = 1
Dim pic As String
Private Sub Form_Load()
        pic = "C:\windows\clouds.bmp"
        SystemParametersInfo SPI_SETDESKWALLPAPER, 0, pic, SPIF_UPDATEINIFILE
End Sub


Play A Wave File
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Sub Command1_Click()
Dim a As Long
a = PlaySound("c:\windows\media\tada.wav", 1, 1)
End Sub


Open & Close CDROM  Drive Door
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Dim lo As Long
Dim sc As Long
'To open the CD door, use this code:
lo = mciSendString("set CDAudio door open", sc, 127, 0)
'To close the CD door, use this code:
lo = mciSendString("set CDAudio door closed", sc, 127, 0)


Hide / Show Start Button, Desktop and Taskbar
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function EnableWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Sub taskBar(Visible As Boolean)
Dim hWnd As Long
hWnd = FindWindow("Shell_TrayWnd", "")
If Visible Then
ShowWindow hWnd, 5
Else
ShowWindow hWnd, 0
End If
End Sub
Public Sub desktop(Visible As Boolean)
Dim hWnd As Long
hWnd = FindWindow("Progman", "Program Manager")
If Visible Then
ShowWindow hWnd, 5
Else
ShowWindow hWnd, 0
End If
End Sub

Public Sub button(Visible As Boolean)
Dim hWnd, dwnd As Long
hWnd = FindWindow("Shell_TrayWnd", "")
dwnd = FindWindowEx(hWnd, 0, "Button", vbNullString)
If Visible Then
ShowWindow dwnd, 5
Else
ShowWindow dwnd, 0
End If
End Sub

'Show the stuff checked 
Private Sub Command1_Click()
If Check1.Value = 1 Then
taskBar (True)
End If
If Check2.Value = 1 Then
desktop (True)
End If
If Check3.Value = 1 Then
button (True)
End If
End Sub

'Hide the stuff checked 
Private Sub Command2_Click()
If Check1.Value = 1 Then
taskBar (False)
End If
If Check2.Value = 1 Then
desktop (False)
End If
If Check3.Value = 1 Then
button (False)
End If
End Sub



Check windows boot manner
Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Private Sub Form_Load()
'Check booted manner
x = GetSystemMetrics(67)
Select Case x
Case 0
MsgBox "Normal Boot"
Case 1
MsgBox "Safe mode"
Case 2
MsgBox "Safe mode with Network"
End Select
End
End Sub


Get drive type
Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Const DRIVE_UNKNOWN = 0
Private Const DRIVE_DOES_NOT_EXIST = 1
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
Private Sub Form_Load()
Select Case GetDriveType("C:\")
    Case DRIVE_UNKNOWN
        MsgBox "Type Unknown", vbExclamation
    Case DRIVE_DOES_NOT_EXIST
        MsgBox "Type Unknown", vbCritical
    Case DRIVE_REMOVABLE
        MsgBox "The disk can be removed from the drive", vbInformation
    Case DRIVE_FIXED
        MsgBox "The disk can not be removed from the drive", vbInformation
    Case DRIVE_REMOTE
        MsgBox "The drive is a remote (network) drive", vbInformation
    Case DRIVE_CDROM
        MsgBox "The drive is a CD-ROM drive", vbInformation
    Case DRIVE_RAMDISK
        MsgBox "The drive is a RAM disk", vbInformation
    End Select
End
End Sub


Get windows about box
Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hWnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
Private Sub Form_Load()
ShellAbout hWnd, "Karthikeyan ", "For More Details contact KARTHIKEYAN", hIcon
End
End Sub


Get the time elapsed after system boot
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Private Sub Form_Load()
Dim m As Long
Dim s As Long
m = CStr(GetTickCount) / 1000 / 60
Label1.Caption = "You have been using this computer for past " & m & " minutes "
End Sub


Show / Hide your application in tasklist (No API)
Private Sub Option1_Click()
App.TaskVisible = True
End Sub
Private Sub Option2_Click()
App.TaskVisible = False
End Sub

No comments:

Post a Comment