• Home
 · 
• Windows System Services
 · 
• Important code for getting Drive Name, Drive label, Drive Type, Free Disk Space, Total Disk Spcae,

Important code for getting Drive Name, Drive label, Drive Type, Free Disk Space, Total Disk Spcae,

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



Rate Important code for getting Drive Name, Drive label, Drive Type, Free Disk Space, Total Disk Spcae,

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

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