home *** CD-ROM | disk | FTP | other *** search
- VERSION 5.00
- Begin VB.Form Form1
- Caption = "Drives and Directories"
- ClientHeight = 3600
- ClientLeft = 60
- ClientTop = 330
- ClientWidth = 6030
- LinkTopic = "Form1"
- ScaleHeight = 3600
- ScaleWidth = 6030
- StartUpPosition = 3 'Windows Default
- Begin VB.Frame Frame1
- Caption = "Drive and Directories Information"
- Height = 2415
- Left = 120
- TabIndex = 1
- Top = 120
- Width = 5655
- Begin VB.Label Label8
- Height = 255
- Left = 1800
- TabIndex = 9
- Top = 1800
- Width = 2895
- End
- Begin VB.Label Label7
- Height = 255
- Left = 1800
- TabIndex = 8
- Top = 1320
- Width = 2895
- End
- Begin VB.Label Label6
- Height = 255
- Left = 1800
- TabIndex = 7
- Top = 840
- Width = 2775
- End
- Begin VB.Label Label5
- Height = 255
- Left = 1800
- TabIndex = 6
- Top = 360
- Width = 3015
- End
- Begin VB.Label Label4
- Caption = "Windows Directory:"
- Height = 255
- Left = 120
- TabIndex = 5
- Top = 1800
- Width = 1695
- End
- Begin VB.Label Label3
- Caption = "Current Directory:"
- Height = 255
- Left = 120
- TabIndex = 4
- Top = 1320
- Width = 1455
- End
- Begin VB.Label Label2
- Caption = "Free Disk Space:"
- Height = 255
- Left = 120
- TabIndex = 3
- Top = 840
- Width = 1335
- End
- Begin VB.Label Label1
- Caption = "C Drive Type:"
- Height = 255
- Left = 120
- TabIndex = 2
- Top = 360
- Width = 1215
- End
- End
- Begin VB.CommandButton Command1
- Caption = "Get Drive and Directories Info"
- Height = 495
- Left = 1440
- TabIndex = 0
- Top = 2880
- Width = 2415
- End
- Attribute VB_Name = "Form1"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- Option Explicit
- Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
- (ByVal nDrive As String) As Long
- Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" _
- (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, _
- lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, _
- lpTtoalNumberOfClusters As Long) As Long
- Private Declare Function GetCurrentDirectory Lib "kernel32" Alias "GetCurrentDirectoryA" _
- (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
- Private Declare Function GetWindowsDirectory Lib "kernel32" _
- Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
- Const DRIVE_CDROM = 5
- Const DRIVE_FIXED = 3
- Const DRIVE_RAMDISK = 6
- Const DRIVE_REMOTE = 4
- Const DRIVE_REMOVABLE = 2
- Private Sub Command1_Click()
- Dim driveType As Long
- Dim freeSpace As Long
- Dim Sectors As Long
- Dim Bytes As Long
- Dim freeClusters As Long
- Dim totalClusters As Long
- Dim retValue As Long
- Dim buffer As String * 255
- 'Get drive type for c:
- driveType = GetDriveType("c:\")
- Select Case driveType
- Case 0
- Label5.Caption = "UNDETERMINED"
-
- Case 1
- Label5.Caption = "NO ROOT"
-
- Case DRIVE_REMOVABLE
- Label5.Caption = "REMOVABLE"
-
- Case DRIVE_FIXED
- Label5.Caption = "FIXED"
-
- Case DRIVE_REMOTE
- Label5.Caption = "REMOTE"
-
- Case DRIVE_CDROM
- Label5.Caption = "CDROM"
-
- Case DRIVE_RAMDISK
- Label5.Caption = "RAMDISK"
-
- End Select
- 'Get free space
- retValue = GetDiskFreeSpace("c:\", Sectors, Bytes, freeClusters, totalClusters)
- Label6.Caption = Sectors * Bytes * freeClusters
- 'Get current directory
- retValue = GetCurrentDirectory(255, buffer)
- Label7.Caption = buffer
- 'Get windows directory
- retValue = GetWindowsDirectory(buffer, 255)
- Label8.Caption = buffer
- End Sub
-