home *** CD-ROM | disk | FTP | other *** search
- VERSION 5.00
- Begin VB.Form FrivesForm
- Caption = "Drives and Directories"
- ClientHeight = 4185
- ClientLeft = 60
- ClientTop = 330
- ClientWidth = 7965
- LinkTopic = "Form1"
- ScaleHeight = 4185
- ScaleWidth = 7965
- StartUpPosition = 3 'Windows Default
- Begin VB.CommandButton Command1
- Caption = "E X I T"
- BeginProperty Font
- Name = "Verdana"
- Size = 9.75
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 495
- Left = 6255
- TabIndex = 10
- Top = 3585
- Width = 1515
- End
- Begin VB.DriveListBox Drive1
- BeginProperty Font
- Name = "Verdana"
- Size = 9
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 330
- Left = 255
- TabIndex = 9
- Top = 420
- Width = 2715
- End
- Begin VB.Frame Frame1
- Caption = "Drive and Directories Information"
- BeginProperty Font
- Name = "Verdana"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 2415
- Left = 180
- TabIndex = 0
- Top = 990
- Width = 7620
- Begin VB.Label Label8
- BeginProperty Font
- Name = "Verdana"
- Size = 9
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 2325
- TabIndex = 8
- Top = 1800
- Width = 3060
- End
- Begin VB.Label Label7
- BeginProperty Font
- Name = "Verdana"
- Size = 9
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 525
- Left = 2325
- TabIndex = 7
- Top = 1320
- Width = 5070
- End
- Begin VB.Label Label6
- BeginProperty Font
- Name = "Verdana"
- Size = 9
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 2325
- TabIndex = 6
- Top = 840
- Width = 3060
- End
- Begin VB.Label Label5
- BeginProperty Font
- Name = "Verdana"
- Size = 9
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 2325
- TabIndex = 5
- Top = 360
- Width = 3060
- End
- Begin VB.Label Label4
- Caption = "Windows Directory"
- BeginProperty Font
- Name = "Verdana"
- Size = 9
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 120
- TabIndex = 4
- Top = 1800
- Width = 1920
- End
- Begin VB.Label Label3
- Caption = "Current Directory:"
- BeginProperty Font
- Name = "Verdana"
- Size = 9
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 120
- TabIndex = 3
- Top = 1320
- Width = 1770
- End
- Begin VB.Label Label2
- Caption = "Free Disk Space:"
- BeginProperty Font
- Name = "Verdana"
- Size = 9
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 120
- TabIndex = 2
- Top = 840
- Width = 1725
- End
- Begin VB.Label Label1
- Caption = "Drive Type:"
- BeginProperty Font
- Name = "Verdana"
- Size = 9
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 120
- TabIndex = 1
- Top = 360
- Width = 1350
- End
- End
- Attribute VB_Name = "FrivesForm"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- ' ******************************
- ' ******************************
- ' ** MASTERING VB6 **
- ' ** by Evangelos Petroutos **
- ' ** SYBEX, 1998 **
- ' ******************************
- ' ******************************
- 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()
- End
- End Sub
- Private Sub Drive1_Change()
- Dim driveType As Long
- Dim freeSpace As Long, Sectors As Long
- Dim Bytes As Long
- Dim freeClusters As Long, totalClusters As Long
- Dim retValue As Long
- Dim buffer As String * 255
- Dim DName As String
- Screen.MousePointer = vbHourglass
- DoEvents
- DName = Left(Drive1.Drive, 2) & "\"
- driveType = GetDriveType(DName)
- Select Case driveType
- Case 0
- Label5.Caption = "UNDETERMINED"
- 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(DName, 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
- Screen.MousePointer = vbDefault
- DoEvents
- Debug.Print App.Path
- End Sub
- Private Sub Form_Load()
- Drive1_Change
- End Sub
-