home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / ch_code / ch13 / drives / drives.frm (.txt) next >
Encoding:
Visual Basic Form  |  1996-04-26  |  8.9 KB  |  267 lines

  1. VERSION 5.00
  2. Begin VB.Form FrivesForm 
  3.    Caption         =   "Drives and Directories"
  4.    ClientHeight    =   4185
  5.    ClientLeft      =   60
  6.    ClientTop       =   330
  7.    ClientWidth     =   7965
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   4185
  10.    ScaleWidth      =   7965
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.CommandButton Command1 
  13.       Caption         =   "E X I T"
  14.       BeginProperty Font 
  15.          Name            =   "Verdana"
  16.          Size            =   9.75
  17.          Charset         =   0
  18.          Weight          =   700
  19.          Underline       =   0   'False
  20.          Italic          =   0   'False
  21.          Strikethrough   =   0   'False
  22.       EndProperty
  23.       Height          =   495
  24.       Left            =   6255
  25.       TabIndex        =   10
  26.       Top             =   3585
  27.       Width           =   1515
  28.    End
  29.    Begin VB.DriveListBox Drive1 
  30.       BeginProperty Font 
  31.          Name            =   "Verdana"
  32.          Size            =   9
  33.          Charset         =   0
  34.          Weight          =   400
  35.          Underline       =   0   'False
  36.          Italic          =   0   'False
  37.          Strikethrough   =   0   'False
  38.       EndProperty
  39.       Height          =   330
  40.       Left            =   255
  41.       TabIndex        =   9
  42.       Top             =   420
  43.       Width           =   2715
  44.    End
  45.    Begin VB.Frame Frame1 
  46.       Caption         =   "Drive and Directories Information"
  47.       BeginProperty Font 
  48.          Name            =   "Verdana"
  49.          Size            =   9.75
  50.          Charset         =   0
  51.          Weight          =   400
  52.          Underline       =   0   'False
  53.          Italic          =   0   'False
  54.          Strikethrough   =   0   'False
  55.       EndProperty
  56.       Height          =   2415
  57.       Left            =   180
  58.       TabIndex        =   0
  59.       Top             =   990
  60.       Width           =   7620
  61.       Begin VB.Label Label8 
  62.          BeginProperty Font 
  63.             Name            =   "Verdana"
  64.             Size            =   9
  65.             Charset         =   0
  66.             Weight          =   400
  67.             Underline       =   0   'False
  68.             Italic          =   0   'False
  69.             Strikethrough   =   0   'False
  70.          EndProperty
  71.          Height          =   255
  72.          Left            =   2325
  73.          TabIndex        =   8
  74.          Top             =   1800
  75.          Width           =   3060
  76.       End
  77.       Begin VB.Label Label7 
  78.          BeginProperty Font 
  79.             Name            =   "Verdana"
  80.             Size            =   9
  81.             Charset         =   0
  82.             Weight          =   400
  83.             Underline       =   0   'False
  84.             Italic          =   0   'False
  85.             Strikethrough   =   0   'False
  86.          EndProperty
  87.          Height          =   525
  88.          Left            =   2325
  89.          TabIndex        =   7
  90.          Top             =   1320
  91.          Width           =   5070
  92.       End
  93.       Begin VB.Label Label6 
  94.          BeginProperty Font 
  95.             Name            =   "Verdana"
  96.             Size            =   9
  97.             Charset         =   0
  98.             Weight          =   400
  99.             Underline       =   0   'False
  100.             Italic          =   0   'False
  101.             Strikethrough   =   0   'False
  102.          EndProperty
  103.          Height          =   255
  104.          Left            =   2325
  105.          TabIndex        =   6
  106.          Top             =   840
  107.          Width           =   3060
  108.       End
  109.       Begin VB.Label Label5 
  110.          BeginProperty Font 
  111.             Name            =   "Verdana"
  112.             Size            =   9
  113.             Charset         =   0
  114.             Weight          =   400
  115.             Underline       =   0   'False
  116.             Italic          =   0   'False
  117.             Strikethrough   =   0   'False
  118.          EndProperty
  119.          Height          =   255
  120.          Left            =   2325
  121.          TabIndex        =   5
  122.          Top             =   360
  123.          Width           =   3060
  124.       End
  125.       Begin VB.Label Label4 
  126.          Caption         =   "Windows Directory"
  127.          BeginProperty Font 
  128.             Name            =   "Verdana"
  129.             Size            =   9
  130.             Charset         =   0
  131.             Weight          =   400
  132.             Underline       =   0   'False
  133.             Italic          =   0   'False
  134.             Strikethrough   =   0   'False
  135.          EndProperty
  136.          Height          =   255
  137.          Left            =   120
  138.          TabIndex        =   4
  139.          Top             =   1800
  140.          Width           =   1920
  141.       End
  142.       Begin VB.Label Label3 
  143.          Caption         =   "Current Directory:"
  144.          BeginProperty Font 
  145.             Name            =   "Verdana"
  146.             Size            =   9
  147.             Charset         =   0
  148.             Weight          =   400
  149.             Underline       =   0   'False
  150.             Italic          =   0   'False
  151.             Strikethrough   =   0   'False
  152.          EndProperty
  153.          Height          =   255
  154.          Left            =   120
  155.          TabIndex        =   3
  156.          Top             =   1320
  157.          Width           =   1770
  158.       End
  159.       Begin VB.Label Label2 
  160.          Caption         =   "Free Disk Space:"
  161.          BeginProperty Font 
  162.             Name            =   "Verdana"
  163.             Size            =   9
  164.             Charset         =   0
  165.             Weight          =   400
  166.             Underline       =   0   'False
  167.             Italic          =   0   'False
  168.             Strikethrough   =   0   'False
  169.          EndProperty
  170.          Height          =   255
  171.          Left            =   120
  172.          TabIndex        =   2
  173.          Top             =   840
  174.          Width           =   1725
  175.       End
  176.       Begin VB.Label Label1 
  177.          Caption         =   "Drive Type:"
  178.          BeginProperty Font 
  179.             Name            =   "Verdana"
  180.             Size            =   9
  181.             Charset         =   0
  182.             Weight          =   400
  183.             Underline       =   0   'False
  184.             Italic          =   0   'False
  185.             Strikethrough   =   0   'False
  186.          EndProperty
  187.          Height          =   255
  188.          Left            =   120
  189.          TabIndex        =   1
  190.          Top             =   360
  191.          Width           =   1350
  192.       End
  193.    End
  194. Attribute VB_Name = "FrivesForm"
  195. Attribute VB_GlobalNameSpace = False
  196. Attribute VB_Creatable = False
  197. Attribute VB_PredeclaredId = True
  198. Attribute VB_Exposed = False
  199. '  ******************************
  200. '  ******************************
  201. '  ** MASTERING VB6            **
  202. '  ** by Evangelos Petroutos   **
  203. '  ** SYBEX, 1998              **
  204. '  ******************************
  205. '  ******************************
  206. Option Explicit
  207. Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
  208.         (ByVal nDrive As String) As Long
  209. Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" _
  210.     (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, _
  211.     lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, _
  212.     lpTtoalNumberOfClusters As Long) As Long
  213. Private Declare Function GetCurrentDirectory Lib "kernel32" Alias "GetCurrentDirectoryA" _
  214.     (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
  215. Private Declare Function GetWindowsDirectory Lib "kernel32" _
  216.     Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  217. Const DRIVE_CDROM = 5
  218. Const DRIVE_FIXED = 3
  219. Const DRIVE_RAMDISK = 6
  220. Const DRIVE_REMOTE = 4
  221. Const DRIVE_REMOVABLE = 2
  222. Private Sub Command1_Click()
  223.     End
  224. End Sub
  225. Private Sub Drive1_Change()
  226. Dim driveType As Long
  227. Dim freeSpace As Long, Sectors As Long
  228. Dim Bytes As Long
  229. Dim freeClusters As Long, totalClusters As Long
  230. Dim retValue As Long
  231. Dim buffer As String * 255
  232. Dim DName As String
  233.     Screen.MousePointer = vbHourglass
  234.     DoEvents
  235.     DName = Left(Drive1.Drive, 2) & "\"
  236.     driveType = GetDriveType(DName)
  237.     Select Case driveType
  238.         Case 0
  239.             Label5.Caption = "UNDETERMINED"
  240.         Case DRIVE_REMOVABLE
  241.             Label5.Caption = "REMOVABLE"
  242.         Case DRIVE_FIXED
  243.             Label5.Caption = "FIXED"
  244.         Case DRIVE_REMOTE
  245.             Label5.Caption = "REMOTE"
  246.         Case DRIVE_CDROM
  247.             Label5.Caption = "CDROM"
  248.         Case DRIVE_RAMDISK
  249.             Label5.Caption = "RAMDISK"
  250.     End Select
  251.     'Get free space
  252.     retValue = GetDiskFreeSpace(DName, Sectors, Bytes, freeClusters, totalClusters)
  253.     Label6.Caption = Sectors * Bytes * freeClusters
  254.     'Get current directory
  255.     retValue = GetCurrentDirectory(255, buffer)
  256.     Label7.Caption = buffer
  257.     'Get windows directory
  258.     retValue = GetWindowsDirectory(buffer, 255)
  259.     Label8.Caption = buffer
  260.     Screen.MousePointer = vbDefault
  261.     DoEvents
  262.     Debug.Print App.Path
  263. End Sub
  264. Private Sub Form_Load()
  265.     Drive1_Change
  266. End Sub
  267.