Visual Basic Codes
Page 2

We provide this collection of visual basic codes to offer our hand to the Visual Basic community and provide you with codes to enhance your applications and to have fun with. As we come across new codes, we will add them to the collection. Without your support however, this collection can not grow. Please send your Visual Basic Codes to alpha_productions@hotmail.com and proper credit will be given.

Contents

Launching an Application by Extension
Detect a Soundcard
Checking the Existence of a File
Return Drive Space on a Drive

[Mainpage] | [Submit a Code]

Launching an Application by Extension
Submitted by: Alpha Productions

'Description: Lauches an application based on file extension

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" Alias "GetDesktopWindow" () As Long

Function StartDoc (DocName As String) as long
  Dim Scr_hDC as long
  Scr_hDC = GetDesktopWindow ()
  'change "Open" to "Explore" to bring up file explorer
  StartDoc = ShellExecute (Scr_hDC, "Open", DocName, "", "C:\", 1)
End Function

'Place the following code in under a command button or in a menu, etc...
Dim Return As Long
Return = StartDoc("C:\windows\arcade.bmp")

[Contents] | [Mainpage] | [Submit a Code]

Checking the Existence of a File
Submitted by: Alpha Productions

'Description: Detects if a file exists.

Function FileExists (filename As String) As Integer
  On Error Resume Next

  x% = Len(Dir$(filename))
  If Err Or x% = 0 Then FileExists = False Else FileExists = True
End Function

[Contents] | [Mainpage] | [Submit a Code]

Detect a Soundcard
Submitted by: Alpha Productions

'Description: Determine if a computer has a sound card

Declare Function waveOutGetNumDevs Lib "MMSYSTEM" () As Integer

Function DetectSoundCard() as Boolean
  Dim Return
  Return = waveOutGetNumDevs()
  If Return > 0 Then
     DetectSoundCard = True
  Else
    DetectSoundCard = False
  End If
End Function

[Contents] | [Mainpage] | [Submit a Code]

Returning Free Space on a Drive
Submitted by: Alpha Productions

'Description: Returns drive free space
'Place the following code in a Form_Load()

Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" ( ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long

Private Sub Form_Load()
  Dim free_Space As Long
  ChDrive "C:"
  Dim numSectorsPerCluster As Long
  Dim numBytesPerSector As Long
  Dim numFreeClusters As Long
  Dim numTotalClusters As Long
  Dim Success As Boolean

  Success = GetDiskFreeSpace("C:\", numSectorsPerCluster, numBytesPerSector, numFreeClusters,       numTotalClusters)
  free_Space = numSectorsPerCluster * numBytesPerSector * numFreeClusters
  Label1.Caption = "The total free space on Drive C: = " & format(Str$(free_Space/1024),"###,### ") & " KB"
End Sub

[Contents] | [Mainpage] | [Submit a Code]

Home | Links | Link to Us | Contact Us

Copyright^© 2001 Alpha Productions. All rights reserved.
Page designed by Your Name.