'Projeye eklenmesi gerekenler
' Drive List Box (DriveNAME)
' Dir List Box (dirNAME)
' File List Box (fileFILENAMES)
' 8 label:
' lbDVNAME, lbLBNAME, lbDVTYPE, lbTDSKSPC, lbDSKFRSPC, lbCRNTDR, lbWINDR,
' lbPRGCRNTDR
' 1 modül
 
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
 
'formun adını frmDRIVES olarak düzenleyin
 
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