BenEskew.com Just another web developer's personal weblog.

Visual Basic Code Snippets #11

In this next update I'll re-post my Visual Basic code snippets (which are older than five years by the way) that pertain to Window Actions and File Functions.

Completely Destroy File and Its Information

Compatibility: Win. 98-XP

Add the following code into a module within your project...

Public Sub DestroyFile(sFileName As String)
Dim Block1 As String, Block2 As String, Blocks As Long
Dim hFileHandle As Integer, iLoop As Long, offset As Long
'Create two buffers with a specified 'wipe-out' characters
Const BLOCKSIZE = 4096
Block1 = String(BLOCKSIZE, "X")
Block2 = String(BLOCKSIZE, " ")
'Overwrite the file contents with the wipe-out characters
hFileHandle = FreeFile
Open sFileName For Binary As hFileHandle
Blocks = (LOF(hFileHandle) \ BLOCKSIZE) + 1
For iLoop = 1 To Blocks
offset = Seek(hFileHandle)
Put hFileHandle, , Block1
Put hFileHandle, offset, Block2
Next iLoop
Close hFileHandle
'Now you can delete the file, which contains no sensitive data
Kill sFileName
End Sub

Add the following code to wherever you want the code to execute...

Call DestroyFile("C:\filetodestroy.jpg") 'modify file path of course

Cut, Copy, Paste and Undo

Compatibility: Win. 98-XP

Add the following code into a module within your project...

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const WM_UNDO = &H304

Cut:
Add the following code where you want the code to execute...

Clipboard.SetText Text1.SelText
Text1.SelText = ""

Copy:
Add the following code where you want the code to execute...

Clipboard.SetText Text1.SelText

Paste:
Add the following code where you want the code to execute...

Text1.SelText = Clipboard.GetText(1)

Undo:
Add the following code where you want the code to execute...

Call SendMessage(Text1.hwnd, WM_UNDO, 0&, 0&)

Visual Basic Code Snippets #10

In this next update I'll re-post my Visual Basic code snippets (which are older than five years by the way) that pertain to Window Actions and File Functions.

Minimize All Active Windows

Compatibility: Win. 98-XP

Add the following code into a module within your project...

Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Const VK_LWIN = &H5B
Public Const KEYEVENTF_KEYUP = &H2

Add the following code into a command button or wherever you want the code to execute...

Call keybd_event(VK_LWIN, 0, 0, 0)
Call keybd_event(&H4D, 0, 0, 0)
Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)

Load a Text Box with Items from a Text File

Compatibility: Win. 98-XP

Add the following code into a module within your project...

Public Sub LoadText(Lst As TextBox, file As String)
'Call LoadText (Text1,"C:\Windows\System\Saved.txt")
On Error GoTo error
Dim mystr As String
Open file For Input As #1
Do While Not EOF(1)
Line Input #1, a$
texto$ = texto$ + a$ + Chr$(13) + Chr$(10)
Loop
Lst = texto$
Close #1
Exit Sub
error:
X = MsgBox("File Not Found", vbOKOnly, "Error")
End Sub

Add a TextBox named Text1 and make sure there is a text file named test.txt with "test" inside it inside the directory where you are working on your project and add the following code wherever you want the code to execute...

Call LoadText(Text1, "test.txt")

Save Data to a Text File

Compatibility: Win. 98-XP

Add the following code into a module within your project...

Public Sub SaveText(Lst As TextBox, file As String)
'Call SaveText (Text1,"C:\Windows\System\Saved.txt")
On Error GoTo error
Dim mystr As String
Open file For Output As #1
Print #1, Lst
Close 1
Exit Sub
error:
X = MsgBox("There has been an error!", vbOKOnly, "Error")
End Sub

Add a TextBox named Text1 and add the following code wherever you want the code to execute...

Call SaveText(Text1, "C:\Program Files\Program Name\test.txt")

Visual Basic Code Snippets #11

Visual Basic Code Snippets #9

In this next update I'll continue to re-post my Visual Basic code snippets (which are older than five years by the way) that pertain to System Functions.

Toggle NumLock Key On/Off

Compatibility: Win. 98-XP

Add the following code into a module within your project...

Option Explicit

Public Sub ToggleNumLock(TurnOn As Boolean)
'To turn numlock on, set turnon to true
'To turn numlock off, set turnon to false
Dim bytKeys(255) As Byte
Dim bnumLockOn As Boolean
'Get status of the 256 virtual keys
GetKeyboardState bytKeys(0)
bnumLockOn = bytKeys(VK_NUMLOCK)
Dim typOS As OSVERSIONINFO
If bnumLockOn <> TurnOn Then
If typOS.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
bytKeys(VK_NUMLOCK) = 1
SetKeyboardState bytKeys(0)
Else
'Simulate Key Press
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
End If
End If
End Sub

Add the following code where you want the code to execute...

'To turn numlock on...
Call ToggleNumLock(True)

'To turn numlock off...
Call ToggleNumLock(False)

BEEP!

Compatibility: Win. 98-XP

Add the following code into a module within your project...

Public Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Add the following code where you want the code to execute...

Dim X%
X% = Beep(1500, 300)

Disable/Enable Task Manager

Compatibility: Win. 98-XP

Add the following code into a module within your project...

Public Declare Function SystemParametersInfo Lib "User32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As String, ByVal fuWinIni As Long) As Long

Add the following code where you want the code to execute...

'this will disable ctrl+alt+del
Call SystemParametersInfo(97, True, 0&, 0)

'this will enable ctrl+alt+del
Call SystemParametersInfo(97, False, 0&, 0)

Get the Windows User Name

Compatibility: Win. 98-XP

Add the following code into a module within your project...

Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Add the following code where you want the code to execute...

Dim X As String
X = String(50, Chr(0))
Call GetComputerName(X$, 50)
MsgBox "Your computer is named: " & X, 32, "Name"

Visual Basic Code Snippets #10