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