VB5 Codes

Site hosted by Angelfire.com: Build your free website today!

Name Code

Stay On Top Module:
Public Declare Sub SetWindowPos Lib "user32" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer)
Form Load:
Call SetWindowPos(hWnd, -1, 0, 0, 0, 0, &H2 Or &H1)

Center Form Module:
Sub CenterForm (Frm As Form)
Form1.Top = (Screen.Height * .85) / 2 - Form1.Height / 2
Form1.Left = Screen.Width / 2 - Form1.Width / 2
End Sub
Form Load:
centerform me

Disable Ctrl + Alt + Delete Module:
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fu WinIni As Long) As Long
Sub DisableCtrlAltDelete(bDisabled As Boolean)
Dim X As Long
X = SystemParametersInfo(97, bDisabled, CStr(1),0)
End Sub
Put this code where you want to activate the Sub:
Call DisableCtrlAltDelete(True)
To let the user use Ctrl+Alt+Delete use this code:
Call DisableCtrlAltDelete(False)

Drag a form with your Mouse Module:
Declare Function ReleaseCapture Lib "user32" () As Long
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 HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN=&HAl
Form_MouseDown:
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&

Open/Close the Cd-Rom Drive Module:
DeclareFunction mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand as string, ByVal lpstrReturnString as string, ByVal hwndCallback as long) As Long
To Close the Cd-Rom use this code:
retvalue = mciSendString("set CD Audio door closed", returnstring, 127, 0)
To Open the Cd-Rom use this code:
retvalue = mciSendString("set CD Audio door open", returnstring, 127, 0)

Flash Bar Module:
Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
Timer:
timer1.interval = 600
Call FlashWindow(Me.hwnd, True)

Fade Form Blue Form Load:
Form1.show
Dim X
Dim y
Dim red
Dim green
Dim blue
X = form1.Width
y = form1.Height
red = 255
green = 255
blue = 255
Do Until red = 0
y = y - form1.Height / 255 * 1
red = red - 1
form1.Line (0, 0)-(X, y), RGB(0, 0, red), BF
Loop

See how long windows has been running Module:
Declare Function GetTickCount& Lib "kernel32" ()
Command Button:
Dim lngReturn As Long
lngReturn = GetTickCount()
MsgBox ("Windows has been running for " & (lngReturn / 1000) & " seconds.")

Rename A File Command Button:
Name "Path to file" As "Path you want renamed file to be"

Send Text to ClipBoard Command Button:
Clipboard.SetText Text1.text

Delate A File Command Button:
Kill("Path to file goes here")

Open A File Using Default Program Command Button:
Shell( "Path to file goes here")

Rename A File Command Button:
Name "Path to file" As "Path you want renamed file to be"

Get Size of a file Command Button:
kilo = FileLen("Path of File goes here") / 1000
Text1.Text = kilo

Min All open windows Module:
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const KEYEVENTF_KEYUP = &H2
Const VK_LWIN = &H5B

Command Button:
' 77 is the character code for the letter 'M'
Call keybd_event(VK_LWIN, 0, 0, 0)
Call keybd_event(77, 0, 0, 0)
Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)

3D Tunel Form:
Form1.Show
Form1.Scale (0, 100)-(100, 0)
Form1.BackColor = vbBlack
Form1.ForeColor = vbBlack
For X% = 0 To 100
Form1.ForeColor = RGB(90, 90, 90)
Form1.Line (X%, 0)-(100 - X%, 100)
Form1.ForeColor = RGB(r%, g%, b%)
Form1.Line (0, X%)-(100, 100 - X%)
current = Timer
Do: DoEvents
Loop Until Timer - current > 1E-99
Next X%
For X% = 10 To 50
Me.Line (50 - X%, 50 + X%)-(50 + X%, 50 - X%), , BF
current = Timer
Do: DoEvents
Loop Until Timer - current > 1E-99
Next X%

Center Form at top of Screen Form:
With form1
.Left = (Screen.Width - .Width) / 2
.Top = (Screen.Height - .Height) / (Screen.Height)
End With

Alot of lines Command Button:
If Form1.WindowState = vbMinimized Then Exit Sub
Form1.BackColor = vbBlack
Form1.ScaleHeight = 100
Form1.ScaleWidth = 100
For x = 0 To 300
DoEvents
X1 = Int(Rnd * 101)
X2 = Int(Rnd * 101)
Y1 = Int(Rnd * 101)
Y2 = Int(Rnd * 101)
colo = Int(Rnd * 15)
Form1.Line (X1, Y1)-(X2, Y2), QBColor(colo)
Form1.Line (X1, Y2)-(X2, Y1), QBColor(colo)
Form1.Line (X2, Y1)-(X1, Y2), QBColor(colo)
Form1.Line (Y1, Y2)-(X1, X2), QBColor(colo)
Next x

Lag Text Command Button:
Dim X As Integer
Dim current As Variant
Dim Y As String
Y = Form1.Label1.Caption
Form1.Label1.Caption = ""
Form1.Show
For X = 0 To Len(Y)
If X = 0 Then
Form1.Label1.Caption = ""
current = Timer
Do While Timer - current < 0.1
DoEvents
Loop
GoTo done
Else: End If
Form1.Label1.Caption = Left(Y, X)
current = Timer
Do While Timer - current < 0.05
DoEvents
Loop
done:
Next X

Shut down the Computer Module:
Private Const EWX_SHUTDOWN As Long = 1
Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
Code:
lngResult = ExitWindowsEx(EWX_SHUTDOWN, 0&)

Reboot the Computer Module:
Private Const EWX_REBOOT As Long = 2
Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
Code:
lngResult = ExitWindowsEx(EWX_REBOOT, 0&)

Find free Disk Space on a Computer Module:
Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long
Public Type DiskInformation
lpSectorsPerCluster As Long
lpBytesPerSector As Long
lpNumberOfFreeClusters As Long
lpTotalNumberOfClusters As Long
End Type

Code:
Dim info As DiskInformation
Dim lAnswer As Long
Dim lpRootPathName As String
Dim lpSectorsPerCluster As Long
Dim lpBytesPerSector As Long
Dim lpNumberOfFreeClusters As Long
Dim lpTotalNumberOfClusters As Long
Dim lBytesPerCluster As Long
Dim lNumFreeBytes As Double
Dim sString As String

lpRootPathName = "c:\"
lAnswer = GetDiskFreeSpace(lpRootPathName, lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters)
lBytesPerCluster = lpSectorsPerCluster * lpBytesPerSector
lNumFreeBytes = lBytesPerCluster * lpNumberOfFreeClusters
sString = "Number of Free Bytes : " & lNumFreeBytes & vbCr & vbLf
sString = sString & "Number of Free Kilobytes: " & (lNumFreeBytes / 1024) & "K" & vbCr & vbLf
sString = sString & "Number of Free Megabytes: " & Format(((lNumFreeBytes / 1024) / 1024), "0.00") & "MB"
MsgBox sString

Check for existance of a file Code:
Public Function FileExists(strPath As String) As Integer
FileExists = Not (Dir(strPath) = "")
End Function

Change the Windows Wallpager Module:
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
Public Const SPI_SETDESKWALLPAPER = 20
Code:
Dim lngSuccess As Long
Dim strBitmapImage As String
strBitmapImage = "c:\windows\straw.bmp"
lngSuccess = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, strBitmapImage, 0)

Move File to the Recycle Bin Module:
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long
End Type
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Code:
Dim typOperation As SHFILEOPSTRUCT
With typOperation
.wFunc = FO_DELETE
.pFrom = "filename.txt" 'File to move to bin
.fFlags = FOF_ALLOWUNDO
End With
SHFileOperation typOperation

Retrieve Windows User Name Module:
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Code:
Sub Get_User_Name()
Dim lpBuff As String * 25
Dim ret As Long, UserName As String
ret = GetUserName(lpBuff, 25)
UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
MsgBox UserName
End Sub

Retrieve the Computer Name Module:
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Codes:
Dim strBuffer As String
Dim lngBufSize As Long
Dim lngStatus As Long
lngBufSize = 255
strBuffer = String$(lngBufSize, " ")
lngStatus = GetComputerName(strBuffer, lngBufSize)
If lngStatus <> 0 Then
MsgBox ("Computer name is: " & Left(strBuffer, lngBufSize))
End If

Associate a File Extension with an Application Module:
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
' Return codes from Registration functions.
Const ERROR_SUCCESS = 0&
Const ERROR_BADDB = 1&
Const ERROR_BADKEY = 2&
Const ERROR_CANTOPEN = 3&
Const ERROR_CANTREAD = 4&
Const ERROR_CANTWRITE = 5&
Const ERROR_OUTOFMEMORY = 6&
Const ERROR_INVALID_PARAMETER = 7&
Const ERROR_ACCESS_DENIED = 8&
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const MAX_PATH = 260&
Private Const REG_SZ = 1
Code:
Dim sKeyName As String
Dim sKeyValue As String
Dim ret&
Dim lphKey&
'This creates a Root entry called "MyApp".
sKeyName = "MyApp"
sKeyValue = "My Application"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
'This creates a Root entry called .BAR associated with "MyApp".
sKeyName = ".BAR"
sKeyValue = "MyApp"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
'This sets the command line for "MyApp".
sKeyName = "MyApp"
sKeyValue = "c:\mydir\my.exe %1"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "shell\open\command", REG_SZ, sKeyValue, MAX_PATH)

Swap Left and Right Mouse Buttons Module:
Private Declare Function SwapMouseButton& Lib "user32" (ByVal bSwap As Long)
Code:
'swap Left and Right mouse buttons
SwapMouseButton (True)
'set mouse buttons back to normal
SwapMouseButton (False)

Hide Mouse from User Module:
Declare Function ShowCursor& Lib "user32"(ByVal bShow As Long)
Code:
'To hide the cursor, use this:
ShowCursor (False)
'To show the cursor, use this:
ShowCursor (True)

Keep Mouse Pointer Inside of a Form Module:
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Code:
'The form should not be set to sizable or this will not work. You should also call the code each time the user moves the form.
Dim lngX As Long
Dim lngY As Long
Dim lngReturn As Long
Dim NewRect As RECT
'Get the screens Twips per pixel (form's scalemode must be Twips)
lngX = Screen.TwipsPerPixelX
lngY = Screen.TwipsPerPixelY
'Set cursor region to that of form With NewRect
.Left = Me.Left / lngX
.Top = Me.Top / lngY
.Right = .Left + Me.Width / lngX
.Bottom = .Top + Me.Height / lngY
End With
lngReturn = ClipCursor(NewRect)

Back To Main Page

To Submit VB5 Codes Send Mail To:

Name	Code
Stay On Top	Module: Public Declare Sub SetWindowPos Lib "user32" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) Form Load: Call SetWindowPos(hWnd, -1, 0, 0, 0, 0, &H2 Or &H1)
Center Form	Module: Sub CenterForm (Frm As Form) Form1.Top = (Screen.Height * .85) / 2 - Form1.Height / 2 Form1.Left = Screen.Width / 2 - Form1.Width / 2 End Sub Form Load: centerform me
Disable Ctrl + Alt + Delete	Module: Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fu WinIni As Long) As Long Sub DisableCtrlAltDelete(bDisabled As Boolean) Dim X As Long X = SystemParametersInfo(97, bDisabled, CStr(1),0) End Sub Put this code where you want to activate the Sub: Call DisableCtrlAltDelete(True) To let the user use Ctrl+Alt+Delete use this code: Call DisableCtrlAltDelete(False)
Drag a form with your Mouse	Module: Declare Function ReleaseCapture Lib "user32" () As Long 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 HTCAPTION = 2 Public Const WM_NCLBUTTONDOWN=&HAl Form_MouseDown: ReleaseCapture SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
Open/Close the Cd-Rom Drive	Module: DeclareFunction mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand as string, ByVal lpstrReturnString as string, ByVal hwndCallback as long) As Long To Close the Cd-Rom use this code: retvalue = mciSendString("set CD Audio door closed", returnstring, 127, 0) To Open the Cd-Rom use this code: retvalue = mciSendString("set CD Audio door open", returnstring, 127, 0)
Flash Bar	Module: Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long Timer: timer1.interval = 600 Call FlashWindow(Me.hwnd, True)
Fade Form Blue	Form Load: Form1.show Dim X Dim y Dim red Dim green Dim blue X = form1.Width y = form1.Height red = 255 green = 255 blue = 255 Do Until red = 0 y = y - form1.Height / 255 * 1 red = red - 1 form1.Line (0, 0)-(X, y), RGB(0, 0, red), BF Loop
See how long windows has been running	Module: Declare Function GetTickCount& Lib "kernel32" () Command Button: Dim lngReturn As Long lngReturn = GetTickCount() MsgBox ("Windows has been running for " & (lngReturn / 1000) & " seconds.")
Rename A File	Command Button: Name "Path to file" As "Path you want renamed file to be"
Send Text to ClipBoard	Command Button: Clipboard.SetText Text1.text
Delate A File	Command Button: Kill("Path to file goes here")
Open A File Using Default Program	Command Button: Shell( "Path to file goes here")
Rename A File	Command Button: Name "Path to file" As "Path you want renamed file to be"
Get Size of a file	Command Button: kilo = FileLen("Path of File goes here") / 1000 Text1.Text = kilo
Min All open windows	Module: Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Const KEYEVENTF_KEYUP = &H2 Const VK_LWIN = &H5B Command Button: ' 77 is the character code for the letter 'M' Call keybd_event(VK_LWIN, 0, 0, 0) Call keybd_event(77, 0, 0, 0) Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)
3D Tunel	Form: Form1.Show Form1.Scale (0, 100)-(100, 0) Form1.BackColor = vbBlack Form1.ForeColor = vbBlack For X% = 0 To 100 Form1.ForeColor = RGB(90, 90, 90) Form1.Line (X%, 0)-(100 - X%, 100) Form1.ForeColor = RGB(r%, g%, b%) Form1.Line (0, X%)-(100, 100 - X%) current = Timer Do: DoEvents Loop Until Timer - current > 1E-99 Next X% For X% = 10 To 50 Me.Line (50 - X%, 50 + X%)-(50 + X%, 50 - X%), , BF current = Timer Do: DoEvents Loop Until Timer - current > 1E-99 Next X%
Center Form at top of Screen	Form: With form1 .Left = (Screen.Width - .Width) / 2 .Top = (Screen.Height - .Height) / (Screen.Height) End With
Alot of lines	Command Button: If Form1.WindowState = vbMinimized Then Exit Sub Form1.BackColor = vbBlack Form1.ScaleHeight = 100 Form1.ScaleWidth = 100 For x = 0 To 300 DoEvents X1 = Int(Rnd * 101) X2 = Int(Rnd * 101) Y1 = Int(Rnd * 101) Y2 = Int(Rnd * 101) colo = Int(Rnd * 15) Form1.Line (X1, Y1)-(X2, Y2), QBColor(colo) Form1.Line (X1, Y2)-(X2, Y1), QBColor(colo) Form1.Line (X2, Y1)-(X1, Y2), QBColor(colo) Form1.Line (Y1, Y2)-(X1, X2), QBColor(colo) Next x
Lag Text	Command Button: Dim X As Integer Dim current As Variant Dim Y As String Y = Form1.Label1.Caption Form1.Label1.Caption = "" Form1.Show For X = 0 To Len(Y) If X = 0 Then Form1.Label1.Caption = "" current = Timer Do While Timer - current < 0.1 DoEvents Loop GoTo done Else: End If Form1.Label1.Caption = Left(Y, X) current = Timer Do While Timer - current < 0.05 DoEvents Loop done: Next X
Shut down the Computer	Module: Private Const EWX_SHUTDOWN As Long = 1 Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long Code: lngResult = ExitWindowsEx(EWX_SHUTDOWN, 0&)
Reboot the Computer	Module: Private Const EWX_REBOOT As Long = 2 Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long Code: lngResult = ExitWindowsEx(EWX_REBOOT, 0&)
Find free Disk Space on a Computer	Module: Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long Public Type DiskInformation lpSectorsPerCluster As Long lpBytesPerSector As Long lpNumberOfFreeClusters As Long lpTotalNumberOfClusters As Long End Type Code: Dim info As DiskInformation Dim lAnswer As Long Dim lpRootPathName As String Dim lpSectorsPerCluster As Long Dim lpBytesPerSector As Long Dim lpNumberOfFreeClusters As Long Dim lpTotalNumberOfClusters As Long Dim lBytesPerCluster As Long Dim lNumFreeBytes As Double Dim sString As String lpRootPathName = "c:\" lAnswer = GetDiskFreeSpace(lpRootPathName, lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters) lBytesPerCluster = lpSectorsPerCluster * lpBytesPerSector lNumFreeBytes = lBytesPerCluster * lpNumberOfFreeClusters sString = "Number of Free Bytes : " & lNumFreeBytes & vbCr & vbLf sString = sString & "Number of Free Kilobytes: " & (lNumFreeBytes / 1024) & "K" & vbCr & vbLf sString = sString & "Number of Free Megabytes: " & Format(((lNumFreeBytes / 1024) / 1024), "0.00") & "MB" MsgBox sString
Check for existance of a file	Code: Public Function FileExists(strPath As String) As Integer FileExists = Not (Dir(strPath) = "") End Function
Change the Windows Wallpager	Module: 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 Public Const SPI_SETDESKWALLPAPER = 20 Code: Dim lngSuccess As Long Dim strBitmapImage As String strBitmapImage = "c:\windows\straw.bmp" lngSuccess = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, strBitmapImage, 0)
Move File to the Recycle Bin	Module: Private Type SHFILEOPSTRUCT hwnd As Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAnyOperationsAborted As Long hNameMappings As Long lpszProgressTitle As Long End Type Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long Private Const FO_DELETE = &H3 Private Const FOF_ALLOWUNDO = &H40 Code: Dim typOperation As SHFILEOPSTRUCT With typOperation .wFunc = FO_DELETE .pFrom = "filename.txt" 'File to move to bin .fFlags = FOF_ALLOWUNDO End With SHFileOperation typOperation
Retrieve Windows User Name	Module: Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long Code: Sub Get_User_Name() Dim lpBuff As String * 25 Dim ret As Long, UserName As String ret = GetUserName(lpBuff, 25) UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1) MsgBox UserName End Sub
Retrieve the Computer Name	Module: Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long Codes: Dim strBuffer As String Dim lngBufSize As Long Dim lngStatus As Long lngBufSize = 255 strBuffer = String$(lngBufSize, " ") lngStatus = GetComputerName(strBuffer, lngBufSize) If lngStatus <> 0 Then MsgBox ("Computer name is: " & Left(strBuffer, lngBufSize)) End If
Associate a File Extension with an Application	Module: Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long ' Return codes from Registration functions. Const ERROR_SUCCESS = 0& Const ERROR_BADDB = 1& Const ERROR_BADKEY = 2& Const ERROR_CANTOPEN = 3& Const ERROR_CANTREAD = 4& Const ERROR_CANTWRITE = 5& Const ERROR_OUTOFMEMORY = 6& Const ERROR_INVALID_PARAMETER = 7& Const ERROR_ACCESS_DENIED = 8& Private Const HKEY_CLASSES_ROOT = &H80000000 Private Const MAX_PATH = 260& Private Const REG_SZ = 1 Code: Dim sKeyName As String Dim sKeyValue As String Dim ret& Dim lphKey& 'This creates a Root entry called "MyApp". sKeyName = "MyApp" sKeyValue = "My Application" ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&) ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&) 'This creates a Root entry called .BAR associated with "MyApp". sKeyName = ".BAR" sKeyValue = "MyApp" ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&) ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&) 'This sets the command line for "MyApp". sKeyName = "MyApp" sKeyValue = "c:\mydir\my.exe %1" ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&) ret& = RegSetValue&(lphKey&, "shell\open\command", REG_SZ, sKeyValue, MAX_PATH)
Swap Left and Right Mouse Buttons	Module: Private Declare Function SwapMouseButton& Lib "user32" (ByVal bSwap As Long) Code: 'swap Left and Right mouse buttons SwapMouseButton (True) 'set mouse buttons back to normal SwapMouseButton (False)
Hide Mouse from User	Module: Declare Function ShowCursor& Lib "user32"(ByVal bShow As Long) Code: 'To hide the cursor, use this: ShowCursor (False) 'To show the cursor, use this: ShowCursor (True)
Keep Mouse Pointer Inside of a Form	Module: Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long Code: 'The form should not be set to sizable or this will not work. You should also call the code each time the user moves the form. Dim lngX As Long Dim lngY As Long Dim lngReturn As Long Dim NewRect As RECT 'Get the screens Twips per pixel (form's scalemode must be Twips) lngX = Screen.TwipsPerPixelX lngY = Screen.TwipsPerPixelY 'Set cursor region to that of form With NewRect .Left = Me.Left / lngX .Top = Me.Top / lngY .Right = .Left + Me.Width / lngX .Bottom = .Top + Me.Height / lngY End With lngReturn = ClipCursor(NewRect)