These are just random notes and programs that may have incomplete descriptions. Any scripts or programs use at your risk
Tuesday, November 22, 2011
This is an example of a vb.net 2010 console application i wrote to send emails off an open relay.
Imports System.Net.Mail
Module Module1
Sub Main()
'Arguments
Dim inputArgumentEmailto As String = "/emailto="
Dim inputArgumentSubject As String = "/subject="
Dim inputArgumentSMTP As String = "/smtp="
Dim inputArgumentBody As String = "/body="
Dim inputArgumentEmailFrom As String = "/emailfrom="
Dim inputArgumentQuestion As String = "/?"
' Dim inputQuestion As String = ""
Dim inputEmailto As String = ""
Dim inputSubject As String = ""
Dim inputSMTP As String = ""
Dim inputBody As String = ""
Dim inputEmailFrom As String = ""
Dim strTestArgs As Boolean
For Each s As String In My.Application.CommandLineArgs
If s.ToLower.StartsWith(inputArgumentQuestion) Then
' if /? is an argument then post help
Console.WriteLine("Email Application")
Console.WriteLine("Created by Tony Unger 11/22/2011")
Console.WriteLine("Ver. 1.0")
Console.WriteLine("This requires an open relay")
Console.WriteLine("------------------------------")
Console.WriteLine("Parameters")
Console.WriteLine("")
Console.WriteLine("/emailto=")
Console.WriteLine("/subject=")
Console.WriteLine("/smtp=")
Console.WriteLine("/body=")
Console.WriteLine("/emailfrom=")
Console.WriteLine("")
Console.WriteLine("Example:")
Console.WriteLine("/emailto=toTony@asdf.com")
Console.WriteLine("/subject=**Alert")
Console.WriteLine("/smtp=192.168.1.1")
Console.WriteLine("/emailfrom=FromTony@asdf.com")
Console.WriteLine("/body=body")
Console.WriteLine(" ""/body=This is an alert"" ")
Exit Sub
End If
'Sets arg to string values
If s.ToLower.StartsWith(inputArgumentEmailto) Then
inputEmailto = s.Remove(0, inputArgumentEmailto.Length)
End If
If s.ToLower.StartsWith(inputArgumentSubject) Then
inputSubject = s.Remove(0, inputArgumentSubject.Length)
End If
If s.ToLower.StartsWith(inputArgumentSMTP) Then
inputSMTP = s.Remove(0, inputArgumentSMTP.Length)
End If
If s.ToLower.StartsWith(inputArgumentBody) Then
inputBody = s.Remove(0, inputArgumentBody.Length)
End If
If s.ToLower.StartsWith(inputArgumentEmailFrom) Then
inputEmailFrom = s.Remove(0, inputArgumentEmailFrom.Length)
End If
Next
'Checks if all args are there
If inputEmailto = "" Then
Console.WriteLine("/emailto= is required")
strTestArgs = True
End If
If inputSubject = "" Then
Console.WriteLine("/subject= is required")
strTestArgs = True
End If
If inputSMTP = "" Then
Console.WriteLine("/smtp= is required")
strTestArgs = True
End If
If inputBody = "" Then
Console.WriteLine("/body= is required")
strTestArgs = True
End If
If inputEmailFrom = "" Then
Console.WriteLine("/emailfrom= is required")
strTestArgs = True
End If
' If any args are missing exit sub
If strTestArgs = True Then
Exit Sub
End If
EmailtoSupport(inputEmailto, inputSubject, inputSMTP, inputBody, inputEmailFrom)
End Sub
Public Sub EmailtoSupport(inputEmailto As String, inputSubject As String, inputSMTP As String, inputBody As String, inputEmailFrom As String)
Try
Dim Mail As New MailMessage
Mail.Subject = inputSubject
Mail.To.Add(inputEmailto)
Mail.From = New MailAddress(inputEmailFrom)
Mail.Body = inputBody
Dim SMTP As New SmtpClient(inputSMTP)
SMTP.Port = "25"
SMTP.Send(Mail)
Console.WriteLine("Email Sent!")
Catch ex As Exception
If ex.Message.ToString = "Failure sending mail." Then
Console.WriteLine("There was a failure sending the email.")
Console.WriteLine("check your smtp address")
Console.WriteLine("This program will only use port 25")
Else
Console.WriteLine(ex.Message.ToString)
End If
End Try
End Sub
End Module
Monday, November 14, 2011
Batch file to start performance counters on system startup
Requirements:
Create folder on the c: drive
c:\perflogs\
Download
7-Zip
http://www.7-zip.org/download.html
copy 7za.exe to c:\perflogs
open perfmon and create the counters you wish to use
Add each counter name you created to the batch code under
:logmans in this format logman start countername
Create a schedule task that will run the created batch file at system startup
On reboot all csv files will be added to a zip file called performance{date}.zip
Then performance counters will be started.
REM Tony Unger
REM 8/26/2011
REM Initial Release 1.0
REM This batch file that compress all file in the c:\perflog directory to
performance%date:~4,2%%date:~7,2%%date:~10,4%.zip then purges all the old entries
rem then it starts the performance log again
7za.exe a -tzip c:\perflogs\performance%date:~4,2%%date:~7,2%%date:~10,4%.zip c:\perflogs\*.csv
if exist c:\perflogs\performance%date:~4,2%%date:~7,2%%date:~10,4%.zip goto PurgeOldRecords
:Exit
exit
:PurgeOldRecords
del *.blg
del *.csv
goto logmans
:logmans
logman start DiskSpace
logman start Memory
logman start CPU
logman start SQLMemory
go to exit
Create folder on the c: drive
c:\perflogs\
Download
7-Zip
http://www.7-zip.org/download.html
copy 7za.exe to c:\perflogs
open perfmon and create the counters you wish to use
Add each counter name you created to the batch code under
:logmans in this format logman start countername
On reboot all csv files will be added to a zip file called performance{date}.zip
Then performance counters will be started.
REM Tony Unger
REM 8/26/2011
REM Initial Release 1.0
REM This batch file that compress all file in the c:\perflog directory to
performance%date:~4,2%%date:~7,2%%date:~10,4%.zip then purges all the old entries
rem then it starts the performance log again
7za.exe a -tzip c:\perflogs\performance%date:~4,2%%date:~7,2%%date:~10,4%.zip c:\perflogs\*.csv
if exist c:\perflogs\performance%date:~4,2%%date:~7,2%%date:~10,4%.zip goto PurgeOldRecords
:Exit
exit
:PurgeOldRecords
del *.blg
del *.csv
goto logmans
:logmans
logman start DiskSpace
logman start Memory
logman start CPU
logman start SQLMemory
go to exit
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
Subscribe to:
Posts (Atom)
-
Running solidcore you may run into a problem where you have to disable it with out using epo or the local CLI Here are the steps. ...
-
Wrote this to get certificate expiration information for certificates that expired 5 days ago to ones that expire in 90 days. Wrap an invoke...
-
List Certificate Templates function get-CertificateTemplates { [ CmdletBinding ()] Param ( [ Parameter ( Mandatory = $True, Va...