cfileinfo.cls

数据库属性,页面的设置

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CFileInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' *********************************************************************
'  Copyright (C)1995-99 Karl E. Peterson, All Rights Reserved
'
' *********************************************************************
'  Warning: This computer program is protected by copyright law and
'  international treaties. Unauthorized reproduction or distribution
'  of this program, or any portion of it, may result in severe civil
'  and criminal penalties, and will be prosecuted to the maximum
'  extent possible under the law.
' *********************************************************************
Option Explicit
'
' API declarations
'
Private Declare Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, lpFilePart As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal nBufferLength As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare Function GetCompressedFileSize Lib "kernel32" Alias "GetCompressedFileSizeA" (ByVal lpFileName As String, lpFileSizeHigh As Long) As Long
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As Any, lpLastAccessTime As Any, lpLastWriteTime As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'
' API constants.
'
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
'
' File attribute constants.
'
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
'
' SHGetFileInfo constants.
'
Private Const SHGFI_ICON = &H100                         '  get icon
Private Const SHGFI_DISPLAYNAME = &H200                  '  get display name
Private Const SHGFI_TYPENAME = &H400                     '  get type name
Private Const SHGFI_ATTRIBUTES = &H800                   '  get attributes
Private Const SHGFI_ICONLOCATION = &H1000                '  get icon location
Private Const SHGFI_EXETYPE = &H2000                     '  return exe type
Private Const SHGFI_SYSICONINDEX = &H4000                '  get system icon index
Private Const SHGFI_LINKOVERLAY = &H8000                 '  put a link overlay on icon
Private Const SHGFI_SELECTED = &H10000                   '  show icon in selected state
Private Const SHGFI_LARGEICON = &H0                      '  get large icon
Private Const SHGFI_SMALLICON = &H1                      '  get small icon
Private Const SHGFI_OPENICON = &H2                       '  get open icon
Private Const SHGFI_SHELLICONSIZE = &H4                  '  get shell size icon
Private Const SHGFI_PIDL = &H8                           '  pszPath is a pidl
Private Const SHGFI_USEFILEATTRIBUTES = &H10             '  use passed dwFileAttribute
'
' CreateFile constants
'
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
'
' API structures.
'
Private Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

Private Type SYSTEMTIME
   wYear As Integer
   wMonth As Integer
   wDayOfWeek As Integer
   wDay As Integer
   wHour As Integer
   wMinute As Integer
   wSecond As Integer
   wMilliseconds As Integer
End Type

Private Type SHFILEINFO
   hIcon As Long                       '  out: icon
   iIcon As Long                       '  out: icon index
   dwAttributes As Long                '  out: SFGAO_ flags
   szDisplayName As String * MAX_PATH  '  out: display name (or path)
   szTypeName As String * 80           '  out: type name
End Type
'
' Member variables.
'
Private m_PathName As String
Private m_Name As String
Private m_Path As String
Private m_Extension As String
Private m_DisplayName As String
Private m_TypeName As String
Private m_hIcon As Long
Private m_PathNameShort As String
Private m_NameShort As String
Private m_PathShort As String
Private m_FileExists As Boolean
Private m_PathExists As Boolean
Private m_FileSize As Long
Private m_FileSizeHigh As Long
Private m_CompFileSize As Long
Private m_CompFileSizeHigh As Long
Private m_Attributes As Long
Private m_tmCreation As Double
Private m_tmAccess As Double
Private m_tmWrite As Double
'
' Enumerated constants
'
Private Enum FileTimes
   ftCreationTime = 0
   ftLastAccessTime = 1
   ftLastWriteTime = 2
End Enum

' ********************************************
'  Initialize and Terminate
' ********************************************
Private Sub Class_Initialize()
   '
   ' All member variables can be left to defaults.
   '
End Sub

Private Sub Class_Terminate()
   '
   ' Just need to clear the icon copy to be
   ' completely tidy.
   '
   If m_hIcon Then
      Call DestroyIcon(m_hIcon)
   End If
End Sub

' ********************************************
'  Public Properties
' ********************************************
Public Property Let FullPathName(ByVal NewVal As String)
   Dim Buffer As String
   Dim nFilePart As Long
   Dim nRet As Long
   '
   ' Retrieve fully qualified path/name specs.
   '
   Buffer = Space(MAX_PATH)
   nRet = GetFullPathName(NewVal, Len(Buffer), Buffer, nFilePart)
   If nRet Then
      m_PathName = Left(Buffer, nRet)
      Refresh
   End If
End Property

Public Property Get FullPathName() As String
   ' Returns fully-qualified path/name spec.
   FullPathName = m_PathName
End Property

Public Property Get FileName() As String
   ' Returns filename only.
   FileName = m_Name
End Property

Public Property Get FilePath() As String
   ' Returns fully-qualified pathname only.
   FilePath = m_Path
End Property

Public Property Get FileExtension() As String
   ' Returns the file's extension only.
   FileExtension = m_Extension
End Property

Public Property Get ShortPathName() As String
   ' Returns fully-qualified *short* path/name spec.
   ShortPathName = m_PathNameShort
End Property

Public Property Get ShortName() As String
   ' Returns *short* filename only.
   ShortName = m_NameShort
End Property

Public Property Get ShortPath() As String
   ' Returns *short* fully-qualified pathname only.
   ShortPath = m_PathShort
End Property

Public Property Get DisplayName() As String
   ' Returns the "display" name for the file, not necessarily
   ' proper-cased, but as Explorer shows it.
   DisplayName = m_DisplayName
End Property

Public Property Get TypeName() As String
   ' Returns the string that describes the file's type.
   TypeName = m_TypeName
End Property

Public Property Get FileExists() As Boolean
   ' Returns whether file exists.
   FileExists = m_FileExists
End Property

Public Property Get PathExists() As Boolean
   ' Returns whether path exists.
   PathExists = m_PathExists
End Property

Public Property Get FileSize() As Long
   ' Return size of file.
   FileSize = m_FileSize
End Property

Public Property Get FileSizeHigh() As Long
   ' Returns high dword of filesize to support files > 2Gb.
   FileSizeHigh = m_FileSizeHigh
End Property

Public Property Get CompressedFileSize() As Long
   ' Return actual size of file.
   CompressedFileSize = m_CompFileSize
End Property

Public Property Get CompressedFileSizeHigh() As Long
   ' Returns high dword of actual filesize to support files > 2Gb.
   CompressedFileSizeHigh = m_CompFileSizeHigh
End Property

Public Property Let CreationTime(ByVal NewVal As Double)
   ' Try setting new timestamp.
   If SetTime(NewVal, ftCreationTime) Then
      Me.Refresh
   End If
End Property

Public Property Get CreationTime() As Double
   ' Returns date/time of file creation.
   CreationTime = m_tmCreation
End Property

Public Property Let LastAccessTime(ByVal NewVal As Double)
   ' Try setting new timestamp.
   If SetTime(NewVal, ftLastAccessTime) Then
      Me.Refresh
   End If
End Property

Public Property Get LastAccessTime() As Double
   ' Returns date/time of last access.
   LastAccessTime = m_tmAccess
End Property

Public Property Let ModifyTime(ByVal NewVal As Double)
   ' Try setting new timestamp.
   If SetTime(NewVal, ftLastWriteTime) Then
      Me.Refresh
   End If
End Property

Public Property Get ModifyTime() As Double
   ' Returns date/time of last write.
   ModifyTime = m_tmWrite
End Property

Public Property Get Attributes() As Long
   ' Returns entire set of attribute flags.
   Attributes = m_Attributes
End Property

Public Property Let attrReadOnly(ByVal NewVal As Boolean)
   Dim NewAttr As Long
   ' Calculate new attribute value.
   If NewVal Then
      NewAttr = m_Attributes Or FILE_ATTRIBUTE_READONLY
   Else
      NewAttr = m_Attributes And Not FILE_ATTRIBUTE_READONLY
   End If
   ' Attempt to set new attribute if not set already.
   If NewAttr <> m_Attributes Then
      If SetAttr(NewAttr) Then
         Me.Refresh
      End If
   End If
End Property

Public Property Get attrReadOnly() As Boolean
   ' Returns whether file has ReadOnly attribute.
   attrReadOnly = (m_Attributes And FILE_ATTRIBUTE_READONLY)
End Property

Public Property Let attrHidden(ByVal NewVal As Boolean)
   Dim NewAttr As Long
   ' Calculate new attribute value.
   If NewVal Then
      NewAttr = m_Attributes Or FILE_ATTRIBUTE_HIDDEN
   Else
      NewAttr = m_Attributes And Not FILE_ATTRIBUTE_HIDDEN
   End If
   ' Attempt to set new attribute if not set already.
   If NewAttr <> m_Attributes Then
      If SetAttr(NewAttr) Then
         Me.Refresh
      End If
   End If
End Property

Public Property Get attrHidden() As Boolean
   ' Returns whether file has Hidden attribute.
   attrHidden = (m_Attributes And FILE_ATTRIBUTE_HIDDEN)
End Property

Public Property Let attrSystem(ByVal NewVal As Boolean)
   Dim NewAttr As Long
   ' Calculate new attribute value.
   If NewVal Then
      NewAttr = m_Attributes Or FILE_ATTRIBUTE_SYSTEM
   Else
      NewAttr = m_Attributes And Not FILE_ATTRIBUTE_SYSTEM
   End If
   ' Attempt to set new attribute if not set already.
   If NewAttr <> m_Attributes Then
      If SetAttr(NewAttr) Then
         Me.Refresh
      End If
   End If
End Property