by Ali Farooq (2 Submissions)
Category: Windows System Services
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 15th June 2006
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Important code for getting Drive Name, Drive label, Drive Type, Free Disk Space, Total Disk Spcae, Window Directory,Current Directory and
API Declarations
' one Drive List Box (DriveNAME)
' one Dir List Box (dirNAME)
' one File List Box (fileFILENAMES)
' 8 label with the following names
' lbDVNAME, lbLBNAME, lbDVTYPE, lbTDSKSPC, lbDSKFRSPC, lbCRNTDR, lbWINDR,
' lbPRGCRNTDR
' add 1 module
' if u have done all above work successfully then feel relax and just paste the
' following code.
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public 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
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
VBcoders
Private Sub dirNAME_Change()
fileFILENAMES.Path = dirNAME.Path
End Sub
Private Sub DriveNAME_Change()
On Error GoTo FindError
dirNAME.Path = DriveNAME.Drive
Call DisplayDriveNAME
Call DisplaydriveLABEL
Call DisplayDriveTYPE
Call DisplayTotalDiskSPACE
Call DisplayDiskFreeSPACE
Call DisplayWindowDIRECTORY
Call DisplayCurrentDIR
Call DisplayProgramCurrentDIR
Exit Sub
FindError:
MsgBox Err.Description, vbOKOnly + vbCritical, "Error Found"
Call DisplayDriveNAME
Call DisplaydriveLABEL
Call DisplayDriveTYPE
Call DisplayTotalDiskSPACE
Call DisplayDiskFreeSPACE
Call DisplayWindowDIRECTORY
Call DisplayCurrentDIR
Call DisplayProgramCurrentDIR
End Sub
Private Sub FileNAME_Click()
lbFLNAME.Caption = UCase(Left(FileName.FileName, (InStr(1, FileName.FileName, "."))))
lbFLEXT.Caption = UCase(Right(FileName.FileName, 3))
Call DisplayCurrentDirectory
End Sub
Private Sub Form_Load()
frmDRIVES.Height = 5220
frmDRIVES.Width = 7665
frmDRIVES.Left = 2325
frmDRIVES.Caption = "works on drives by Created By Ali Farooq"
Call DisplayDriveNAME
Call DisplaydriveLABEL
Call DisplayDriveTYPE
Call DisplayTotalDiskSPACE
Call DisplayDiskFreeSPACE
Call DisplayWindowDIRECTORY
Call DisplayCurrentDIR
Call DisplayProgramCurrentDIR
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If ((frmDRIVES.Height > 5220) Or (frmDRIVES.Width > 7665)) Then
frmDRIVES.Height = 5220
frmDRIVES.Width = 7665
frmDRIVES.Left = 2325
ElseIf ((frmDRIVES.Height < 5220) Or (frmDRIVES.Width < 7665)) Then
frmDRIVES.Height = 5220
frmDRIVES.Width = 7665
frmDRIVES.Left = 2325
End If
End Sub
Sub DisplayDriveNAME()
lbDVNAME.Caption = UCase(Left(DriveNAME.Drive, 2))
End Sub
Sub DisplaydriveLABEL()
lbLBNAME.Caption = Mid(DriveNAME.Drive, 4, 13)
If lbLBNAME.Caption = "" Then
lbLBNAME.Caption = "No Label Defined"
End If
End Sub
Sub DisplayDriveTYPE()
Dim Dname, GDT As String
Dname = Left(DriveNAME.Drive, 2) & "\"
GDT = GetDriveType(Dname)
If GDT = 0 Then
lbDVTYPE.Caption = "Unable To Determine The Drive Type"
ElseIf GDT = 1 Then
lbDVTYPE.Caption = "There is no root Directory"
ElseIf GDT = 2 Then 'DRIVE_REMOVABLE
lbDVTYPE.Caption = "Removable Disk(Like Floppy, Flash Disk)"
ElseIf GDT = 3 Then 'DRIVE_FIXED
lbDVTYPE.Caption = "Fixed Drive (Like C:, D:, E: etc)"
ElseIf GDT = 4 Then 'DRIVE_REMOTE
lbDVTYPE.Caption = "Drive Remote (NetWork Drive)"
ElseIf GDT = 5 Then 'DRIVE_CDROM
lbDVTYPE.Caption = "CDROM Drive"
ElseIf GDT = 6 Then 'DRIVE_RAMDISK
lbDVTYPE.Caption = "Drive is a RAM drive"
End If
End Sub
Sub DisplayTotalDiskSPACE()
On Error Resume Next
Dim Dname As String
Dim GTDFS As Long
Dim Sectors As Long, Bytes As Long, FreeClusters As Long, TotalClusters As Long
Dname = Left(DriveNAME.Drive, 2) & "\"
GTDFS = GetDiskFreeSpace(Dname, Sectors, Bytes, FreeClusters, TotalClusters)
lbTDSKSPC.Caption = Sectors * Bytes * TotalClusters
End Sub
Sub DisplayDiskFreeSPACE()
On Error Resume Next
Dim Dname As String
Dim GDFS As Long
Dim Sectors As Long, Bytes As Long, FreeClusters As Long, TotalClusters As Long
Dname = Left(DriveNAME.Drive, 2) & "\"
GDFS = GetDiskFreeSpace(Dname, Sectors, Bytes, FreeClusters, TotalClusters)
lbDSKFRSPC.Caption = Sectors * Bytes * FreeClusters
End Sub
Sub DisplayWindowDIRECTORY()
Dim Dname, GWD As String
Dim Buffers As String * 255
Dname = Left(DriveNAME.Drive, 2) & "\"
GWD = GetWindowsDirectory(Buffers, 255)
lbWINDR.Caption = Buffers
End Sub
Sub DisplayCurrentDIR()
lbCRNTDR.Caption = Left(UCase(DriveNAME.Drive), 2) + "\"
End Sub
Sub DisplayProgramCurrentDIR()
lbPRGCRNTDR.Caption = App.Path
End Sub
Sub DisplayCurrentDirectory()
lbCRNTDR.Caption = dirNAME.Path + "\" + FileName.FileName
End Sub
No comments have been posted about Important code for getting Drive Name, Drive label, Drive Type, Free Disk Space, Total Disk Spcae, . Why not be the first to post a comment about Important code for getting Drive Name, Drive label, Drive Type, Free Disk Space, Total Disk Spcae, .
