windows-server-2003/admin/activec/designer/setup/samples/fileviewerextension/ppgdirstats.pag

VERSION 5.00
Begin VB.PropertyPage ppgDirStats 
   Caption         =   "FileViewer"
   ClientHeight    =   4425
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5895
   PaletteMode     =   0  'Halftone
   ScaleHeight     =   4425
   ScaleWidth      =   5895
   Begin VB.Label lblField 
      Height          =   255
      Index           =   0
      Left            =   60
      TabIndex        =   11
      Top             =   240
      Width           =   2055
   End
   Begin VB.Label lblValue 
      Height          =   255
      Index           =   0
      Left            =   2325
      TabIndex        =   10
      Top             =   240
      Width           =   3375
   End
   Begin VB.Label lblField 
      Height          =   255
      Index           =   1
      Left            =   60
      TabIndex        =   9
      Top             =   960
      Width           =   2055
   End
   Begin VB.Label lblValue 
      Height          =   255
      Index           =   1
      Left            =   2340
      TabIndex        =   8
      Top             =   960
      Width           =   3375
   End
   Begin VB.Label lblField 
      Height          =   255
      Index           =   2
      Left            =   60
      TabIndex        =   7
      Top             =   1560
      Width           =   2055
   End
   Begin VB.Label lblValue 
      Height          =   255
      Index           =   2
      Left            =   2340
      TabIndex        =   6
      Top             =   1560
      Width           =   3375
   End
   Begin VB.Label lblField 
      Height          =   255
      Index           =   3
      Left            =   60
      TabIndex        =   5
      Top             =   2280
      Width           =   2115
   End
   Begin VB.Label lblValue 
      Height          =   255
      Index           =   3
      Left            =   2340
      TabIndex        =   4
      Top             =   2280
      Width           =   3375
   End
   Begin VB.Label lblField 
      Height          =   255
      Index           =   4
      Left            =   60
      TabIndex        =   3
      Top             =   3120
      Width           =   2055
   End
   Begin VB.Label lblValue 
      Height          =   255
      Index           =   4
      Left            =   2340
      TabIndex        =   2
      Top             =   3120
      Width           =   3375
   End
   Begin VB.Label lblField 
      Height          =   255
      Index           =   5
      Left            =   60
      TabIndex        =   1
      Top             =   3840
      Width           =   2055
   End
   Begin VB.Label lblValue 
      Height          =   255
      Index           =   5
      Left            =   2340
      TabIndex        =   0
      Top             =   3840
      Width           =   3375
   End
End
Attribute VB_Name = "ppgDirStats"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'  ===========================================================================
' |    THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF      |
' |    ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO    |
' |    THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A         |
' |    PARTICULAR PURPOSE.                                                    |
' |    Copyright (c) 1998-1999  Microsoft Corporation                         |
'  ===========================================================================

' =============================================================================
' File:         ppgDirStats.pag
' Project:      FileViewerExtensionProj
' Type:         Property Page
' =============================================================================

Option Explicit
Implements IMMCPropertyPage

' When the property page is part of a multiple selection this variable holds the
' path of the particular folder for which the instance of the property page is being
' displayed.
Private m_FolderPath As String

' MMC API DLL function declarations

Private Declare Function MMCPropertyHelp Lib "mssnapr.dll" (ByVal HelpTopic As String) As Long

' =============================================================================
' Method:       IMMCPropertyPage_Initialize
' Type:         Interface method
' Description:  Called when the property page is created to pass the last
'               parameter from MMCPropertySheet.AddPage to the property page
' Parameters:   Data          The final parameter from MMCPropertySheet.AddPage
' Output:       None
' Notes:        Store the parameter as the folder path to be used in the
'               PropertyPage_SelectionChanged() event.
'               Unlike a UserControl property page, SelectedControls(0) will
'               contain the MMCDataObject passed to
'               ExtensionSnapIn_CreatePropertyPages so that the property page
'               can access the data exported from the extended snap-in
'               (FileExplorer in this case).
' =============================================================================
'
Private Sub IMMCPropertyPage_Initialize(ByVal Data As Variant, _
                                        ByVal PropertySheet As SnapInLib.MMCPropertySheet)

    On Error GoTo ErrTrap_IMMCPropertyPage_Initialize

    Dim FldrName As String
    Dim fs As New Scripting.FileSystemObject
    Dim Fldr As Scripting.Folder
    Dim FolderSize As Double
    Dim Fraction As Double

    m_FolderPath = Data

    ' Get a Folder object from the FileSystemObject for the folder and fill the
    ' property page fields with its data. The snap-in put the folder path into
    ' PropertyPage.Tag

    Set Fldr = fs.GetFolder(m_FolderPath)

    lblField(0).Caption = "Folder:"
    lblValue(0).Caption = Fldr.Path
    
    lblField(1).Caption = "Type:"
    lblValue(1).Caption = Fldr.Type

    lblField(2).Caption = "Size:"
    lblValue(2).Caption = Format(Fldr.Size, "#,##0 bytes")

    lblField(3).Caption = "Parent:"
    lblValue(3).Caption = Fldr.ParentFolder.Path

    lblField(4).Caption = "% of Parent Folder Size:"
    FolderSize = Fldr.Size
    Fraction = FolderSize / Fldr.ParentFolder.Size
    If Fraction < 0.01 Then
        lblValue(4).Caption = "< 1%"
    Else
        lblValue(4).Caption = Format(Fraction, "Percent")
    End If

    lblField(5).Caption = "% of Space on Disk:"
    Fraction = FolderSize / Fldr.Drive.TotalSize
    If Fraction < 0.01 Then
        lblValue(5).Caption = "< 1%"
    Else
        lblValue(5).Caption = Format(Fraction, "Percent")
    End If

    Exit Sub

' Error Handler for this method
ErrTrap_IMMCPropertyPage_Initialize:
    DisplayError "IMMCPropertyPage_Initialize"

End Sub

' =============================================================================
' Method:       IMMCPropertyPage_Help
' Type:         Interface method
' Description:  Called when the user clicks the Help button on a property sheet
'
' Parameters:   None
' Output:       None
' Notes:        Calls the MMC API function MMCPropertyHelp() to display a topic
'               from FileExlporer's merged help file.
' =============================================================================
'
Private Sub IMMCPropertyPage_Help()
    MMCPropertyHelp "VBSnapInsSamples.chm::VBSnapInsSamples/VBSnapInsSamples_35.htm"
End Sub

' =============================================================================
' Method:       IMMCPropertyPage_GetDialogUnitSize
' Type:         Interface method
' Description:  Called when the property page is about to be created to allow
'               the page to specify its size in dialog units.
'
' Parameters:   None
' Output:       None
' Notes:        Returns the recommended height and width values for a snap-in
'               property page.
' =============================================================================
'
Private Sub IMMCPropertyPage_GetDialogUnitSize(Height As Variant, Width As Variant)
    Height = 218
    Width = 252
End Sub

' =============================================================================
' Method:       IMMCPropertyPage_QueryCancel
' Type:         Interface method
' Description:  Called when the user cancels the property sheet or wizard by
'               pressing Esc, clicking the Cancel button, or clicking the 'X'
'               button in the upper right corner.
'
' Parameters:   Allow - set to False to prevent the sheet or wizard from closing.
' Output:       None
' Notes:        None
' =============================================================================
'
Private Sub IMMCPropertyPage_QueryCancel(Allow As Boolean)

End Sub

' =============================================================================
' Method:       IMMCPropertyPage_Cancel
' Type:         Interface method
' Description:  Called when a property sheet or wizard is closed because the
'               user clicked the Cancel button.
'
' Parameters:   None
' Output:       None
' Notes:        None
' =============================================================================
'
Private Sub IMMCPropertyPage_Cancel()

End Sub

' =============================================================================
' Method:       IMMCPropertyPage_Close
' Type:         Interface method
' Description:  Called when a property sheet or wizard is closed because the
'               user clicked the 'X' button in the upper right corner.
'
' Parameters:   None
' Output:       None
' Notes:        None
' =============================================================================
'
Private Sub IMMCPropertyPage_Close()

End Sub

' =============================================================================
' Method:       DisplayError
' Type:         Subroutine
' Description:  A method to format and display a runtime error
' Parameters:   szLocation      A string identifying the source location
'                               (i.e. method name) where the error occurred
' Output:       None
' Notes:        The error will be displayed in a messagebox formatted as the
'               following sample:
'
'     Method:        SomeMethodName
'     Source:        MMCListSubItems
'     Error:         2527h  (9511)
'     Description:   There is already an item in the collection that has the specified key
'
' =============================================================================
'
Private Sub DisplayError(szLocation As String)
    
    MsgBox "Method:" & vbTab & vbTab & szLocation & vbCrLf _
           & "Source:" & vbTab & vbTab & Err.Source & vbCrLf _
           & "Error:" & vbTab & vbTab & Hex(Err.Number) & "h   (" & CStr(Err.Number) & ")" & vbCrLf _
           & "Description:" & vbTab & Err.Description, _
           vbCritical, "FileViewerExtension Runtime Error"
End Sub