Source code of Windows XP (NT5)
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

313 lines
11 KiB

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