Developer - Tricks and Tips 4

Developer Home
Tricks and Tips
Page 1
Page 2
Page 3
Page 4
Submissions
Developer Links
Graphic Art Links

Developers

PAGE 4 - Click on 'Tricks and Tips' to return to the index page.

Creating a directory structure
Here's a way that you can create a directory structure even if the underlying directories do not exits. This is really two functions in one, DirExists returns true is a directory exists and MakeDir creates a directory if it does not exist.

Put the following code in the load event in a code module.

Public Function DirExists(ByVal strPath As String) As Boolean

DirExists = (Dir(strPath, vbDirectory)) <> "")

End Function

Public Sub MakeDir(strPath As String)
Dim Start As Integer
Dim DirLen As Integer

If Len(strPath) > 4 Then
    Start = 4
Else
    Exit Sub
End If

'add \ To strpath if it does not exist
If Right(strPath, 1) <> "\" Then
    strPath = strPath + "\"
End If

'create directory(s) as needed
While Not DirExists(strPath)
    DirLen = InStr(Start, strPath, "\")

    If Not DirExists(Left(strPath, DirLen)) Then
      MkDir Left(strPath, DirLen - 1)
    End If

    Start = DirLen + 1
Wend

End Sub

You can call this code from your application using the syntax;

MakeDirectory "C:\Program Files\New One\New Two\"

Note the above call will create both the 'New One' and 'New Two' directories.

January 1, 1999
By Russell May.

Tricks and Tips Index                  Top of Page

A group of Bit Manipulation Functions
These functions are designed to assist in bitwise manipluations of Long values, they could easily be amended to do the same for Integer values. An error is generated if a bit is set that is outside the range 0 - 31.

Add the following declarations and function to a BAS module in a VB project:

Option Explicit

'*************************************************************
'Purpose: Sets a bit in a long value
' BitSet(X, 12) returns X with bit 12 set
'Parameter: Number as Long
'Parameter: Bit as Integer (Range 0 to 31)
'*************************************************************
Public Function BitSet(ByVal Number As Long, ByVal Bit As Integer) As Long

If Bit < 0 Or Bit > 31 Then
    Err.Raise vbObjectError + 1, "BitSet Function", "Invalid Bit parameter. Not in range [0 - 31]"
End If

If Bit = 31 Then
    BitSet = &H80000000 Or Number
Else
    BitSet = (2 ^ Bit) Or Number
End If

End Function

'*************************************************************
'Purpose: Clears a bit in a long value
' BitClear(X, 12) returns X with bit 12 cleared
'Parameter: Number as Long
'Parameter: Bit as Integer (Range 0 to 31)
'*************************************************************
Public Function BitClear(ByVal Number As Long, ByVal Bit As Integer) As Long

If Bit < 0 Or Bit > 31 Then
    Err.Raise vbObjectError + 1, "BitSet Function", "Invalid Bit parameter. Not in range [0 - 31]"
End If

If Bit = 31 Then
    BitClear = &H7FFFFFFF And Number
Else
    BitClear = ((2 ^ Bit) Xor &HFFFFFFFF) And Number
End If

End Function

'*************************************************************
'Purpose: Returns true if a bit in a long value is set
' BitSet(X, 12) returns true if bit 12 is set
'Parameter: Number as Long
'Parameter: Bit as Integer (Range 0 to 31)
'*************************************************************
Public Function BitIsSet(ByVal Number As Long, ByVal Bit As Integer) As Boolean

If Bit < 0 Or Bit > 31 Then
    Err.Raise vbObjectError + 1, "BitSet Function", "Invalid Bit parameter. Not in range [0 - 31]"
End If

If Bit = 31 Then
    BitIsSet = (Number And &H80000000)
Else
    BitIsSet = (Number And (2 ^ Bit))
End If

End Function

You can call this code from your application using the syntax;

     X = BitSet(1, 2)

The above would set X to the value 5 i.e. bit 0 and bit 2 set.

     X = BitClear(5, 2)

The above would set X to the value 1 i.e. bit 0 set and bit 2 clear.

     BitIsSet(5, 2)

The above would return True since bir 2 is set in the value 5.

January 1, 1999
By Russell May.

Tricks and Tips Index                  Top of Page

Determining the Start Mode is Windows in
Create a new form and add a command button to it. Then copy and paste this code into general declarations sections of the form. Press F5 to run the sample. The constant SM_CLEANBOOT returns values of 0 (normal), 1 and 2.

Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Const SM_CLEANBOOT = 67

Private Sub Command1_Click()

Select Case GetSystemMetrics(SM_CLEANBOOT)
    Case 1: Msgbox "Safe Mode."
    Case 2: Msgbox "Safe Mode with Network support."
    Case Else: Msgbox "Windows is running normally."
End Select

End Sub

january 1, 1999
by Russell May.

Tricks and Tips Index                  Top of Page

How to hide the Start Menu Bar
The Start Menu bar in Windows 2000, NT, 95 or 98 is actually a window and can be manipulated using windows API calls. Create a new form and on it place two command buttons. Set the caption of these two buttons to be "Hide" and "Show" respectively. Then paste the code below into the General Declarations section of the form. The press F5 to run it.

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
    ByVal nCmdShow As Long) As Long

Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1

Private Sub Command1_Click()
Dim Ret As Long
Dim ClassName As String
Dim StartWindow As Long

ClassName = Space(256)
ClassName = "Shell_TrayWnd"
StartWindow = FindWindow(ClassName, vbNullString)

'Hide the start menu bar
Ret = ShowWindow(StartWindow, SW_HIDE)
MsgBox "The Start Menu is now hidden"|

End Sub

Private Sub Command2_Click()
Dim Ret As Long
Dim ClassName As String
Dim StartWindow As Long

ClassName = Space(256)
ClassName = "Shell_TrayWnd"
StartWindow = FindWindow(ClassName, vbNullString)

'Display the start menu bar as normal
Ret = ShowWindow(StartWindow, SW_SHOWNORMAL)
MsgBox "The Start Menu is now visible"

End Sub

January 1, 1999
By Russell May.

Tricks and Tips Index                  Top of Page

How to get the current user name
The routine listed below will return the current user name. Create a new code module and paste the code below into the code window.

Private Declare Function GetUserNameAPI Lib "advapi32.dll" _
    Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long

Public Function GetUserName() As String
Dim sBuffer As String
Dim lSize As Long

'Space for dll parameters
sBuffer = Space$(255)
lSize = Len(sBuffer)

Call GetUserNameAPI(sBuffer, lSize)

If lSize > 0 Then
    'Remove spaces
    GetUserName = Left$(sBuffer, lSize)
Else
    'Return empty if no user is found
    GetUserName = vbNullString
End If

End Function

To test the code add a button to a form and paste the code below into the forms code window.

Private Sub Command1_Click()

MsgBox GetUserName()

End Sub

January 2, 1999
by Russell May.

Tricks and Tips Index                  Top of Page

How to hide the mouse cursor
You can use the API function Showcursor to control the visibility of the mouse cursor. To use this tip, paste this declaration into a module. The Parameter lShow should be set to True (non-zero) to display the cursor, False to hide it.

Public Declare Function ShowCursor& Lib "user32" (ByVal lShow As Long)

To test the code create a new Visual Basic project and paste the code above into a new code module. Create a form with a command button on it and paste the code below into the forms code window.

Private Sub Command1_Click()
Statis lngMouseOn As Long

lngMouseOn = 1 - lngMouseOn
ShowCursor lngMouseOn

End Sub

January 2, 1999
by Russell May.

Tricks and Tips Index                  Top of Page

Delete a file to the Recycle Bin
The Recycle Bin is great for stopping files for permanently being deleted off your hard disk. To use this inside your VB code, create a module and paste the code below into the General Declarations section.

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
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_SLIENT = &H4

Private Sub DeleteFileToRecycleBin(ByVal Filename As String)
Dim op As SHFILEOPSTRUCT
Dim Ret As Long

With op
    .wFunc = FO_DELETE
    .pFrom = Filename
    .fFlags = FOF_ALLOWUNDO
End With

Ret = SHFileOperation(op)

End Sub

To delete a file, just call the DeleteFileToRecycleBin procedure with the filename as a parameter, e.g. Call DeleteFileToRecycleBin("C:\temp\filetodelete.tmp")

January 2, 1999
by Russell May.

Tricks and Tips Index                  Top of Page

If you have any queries email:
developer@may-computing.com