?? clsfile.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 = "clsFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'File Properties
Private mFilename As String
Private mPath As String
Private mSize As Long
Private mDate As Date
Private mReadOnly As Boolean
Private mArchive As Boolean
Private mSystem As Boolean
Private mHidden As Boolean
Private mCompressed As Boolean
Private mCreated As Date
Private mLastAccessed As Date
Private mLastModified As Date
Private Enum Units
BYTES = 0
KB = 1
MB = 2
GB = 3
End Enum
Private Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" (ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
lpSecurityAttributes As SECURITY_ATTRIBUTES, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Private Declare Function OpenFile Lib "kernel32" _
(ByVal lpFileName As String, _
lpReOpenBuff As OFSTRUCT, _
ByVal wStyle As Long) As Long
Private Declare Function lclose Lib "kernel32" _
Alias "_lclose" _
(ByVal hFile As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" _
(ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" _
(ByVal hFile As Long, _
lpFileSizeHigh As Long) As Long
Private Declare Function GetFileAttributes Lib "kernel32" _
Alias "GetFileAttributesA" _
(ByVal lpFileName As String) As Long
Private Declare Function SetFileAttributes Lib "kernel32" Alias _
"SetFileAttributesA" _
(ByVal lpFileName As String, _
ByVal dwFileAttributes As Long) As Long
Private Declare Function GetFileTime Lib "kernel32" _
(ByVal hFile As Long, _
lpCreationTime As FILETIME, _
lpLastAccessTime As FILETIME, _
lpLastWriteTime As FILETIME) As Long
Private Declare Function SetFileTime Lib "kernel32" _
(ByVal hFile As Long, _
lpCreationTime As FILETIME, _
lpLastAccessTime As FILETIME, _
lpLastWriteTime As FILETIME) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" _
(lpSystemTime As SYSTEMTIME, _
lpFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, _
lpSystemTime As SYSTEMTIME) As Long
Private Declare Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long
Private Declare Function LockFile Lib "kernel32" _
(ByVal hFile As Long, _
ByVal dwFileOffsetLow As Long, _
ByVal dwFileOffsetHigh As Long, _
ByVal nNumberOfBytesToLockLow As Long, _
ByVal nNumberOfBytesToLockHigh As Long) As Long
Private Declare Function LockFileEx Lib "kernel32" _
(ByVal hFile As Long, _
ByVal dwFlags As Long, _
ByVal dwReserved As Long, _
ByVal nNumberOfBytesToLockLow As Long, _
ByVal nNumberOfBytesToLockHigh As Long, _
lpOverlapped As OVERLAPPED) As Long
Private Declare Function UnlockFile Lib "kernel32" _
(ByVal hFile As Long, _
ByVal dwFileOffsetLow As Long, _
ByVal dwFileOffsetHigh As Long, _
ByVal nNumberOfBytesToUnlockLow As Long, _
ByVal nNumberOfBytesToUnlockHigh As Long) As Long
Private Declare Function UnlockFileEx Lib "kernel32" _
(ByVal hFile As Long, _
ByVal dwReserved As Long, _
ByVal nNumberOfBytesToUnlockLow As Long, _
ByVal nNumberOfBytesToUnlockHigh As Long, _
lpOverlapped As OVERLAPPED) As Long
Private Declare Function MoveFile Lib "kernel32" _
Alias "MoveFileA" _
(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String) As Long
Private Declare Function CopyFile Lib "kernel32" _
Alias "CopyFileA" _
(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long
Private Declare Function DeleteFile Lib "kernel32" _
Alias "DeleteFileA" _
(ByVal lpFileName As String) As Long
Private Const OFS_MAXPATHNAME = 128
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_SIMPLEPROGRESS = &H100
'Data structures
Private Type OVERLAPPED
Internal As Long
InternalHigh As Long
offset As Long
OffsetHigh As Long
hEvent As Long
End Type
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME) As Byte
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
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 Const OF_CANCEL = &H800
Private Const OF_CREATE = &H1000
Private Const OF_DELETE = &H200
Private Const OF_EXIST = &H4000
Private Const OF_PARSE = &H100
Private Const OF_PROMPT = &H2000
Private Const OF_READ = &H0
Private Const OF_READWRITE = &H2
Private Const OF_REOPEN = &H8000
Private Const OF_SHARE_COMPAT = &H0
Private Const OF_SHARE_DENY_NONE = &H40
Private Const OF_SHARE_DENY_READ = &H30
Private Const OF_SHARE_DENY_WRITE = &H20
Private Const OF_SHARE_EXCLUSIVE = &H10
Private Const OF_VERIFY = &H400
Private Const OF_WRITE = &H1
Public Function Copy(NewFilename As String, Overwrite As Boolean) As Boolean
Copy = CopyFile(ByVal mFilename, ByVal NewFilename, Not Overwrite)
End Function
Public Property Let Created(ByVal vNewValue As Date)
mCreated = vNewValue
SetFileTimes
End Property
Public Function Delete(Optional AllowUndo As Boolean) As Boolean
Dim rc As Long
If AllowUndo Then
'Send the file to the recycle bin...
Delete = Recycle(True)
Else
'Permanently delete the file
Delete = DeleteFile(ByVal mFilename)
End If
End Function
Public Property Let LastAccessed(ByVal vNewValue As Date)
mLastAccessed = vNewValue
SetFileTimes
End Property
Public Property Let LastModified(ByVal vNewValue As Date)
mLastModified = vNewValue
SetFileTimes
End Property
Private Function GetFileTimes()
Dim rc As Long
Dim lpCreationTime As FILETIME
Dim lpLastAccessTime As FILETIME
Dim lpLastWriteTime As FILETIME
Dim hFile As Long
Dim lpBuff As OFSTRUCT
Dim lpsCT As SYSTEMTIME
Dim lpsLAT As SYSTEMTIME
Dim lpsLWT As SYSTEMTIME
'Get a handle to the file
hFile = OpenFile(ByVal mFilename, lpBuff, OF_READ)
If hFile <> 0 Then
'Get the file dates
rc = GetFileTime(hFile, _
lpCreationTime, _
lpLastAccessTime, _
lpLastWriteTime)
If rc <> 0 Then
'Convert the creation time to VB date/time format
rc = FileTimeToSystemTime(lpCreationTime, lpsCT)
If rc <> 0 Then
With lpsCT
mCreated = CStr(.wMonth) & "/" & _
CStr(.wDay) & "/" & _
CStr(.wYear) & " " & _
CStr(.wHour) & ":" & _
CStr(.wMinute) & ":" & _
CStr(.wSecond)
End With
End If
'Convert the last-access time to VB date/time format
rc = FileTimeToSystemTime(lpLastAccessTime, lpsLAT)
If rc <> 0 Then
With lpsLAT
mLastAccessed = CStr(.wMonth) & "/" & _
CStr(.wDay) & "/" & _
CStr(.wYear)
End With
End If
'Convert the last-write time to VB date/time format
rc = FileTimeToSystemTime(lpLastWriteTime, lpsLWT)
If rc <> 0 Then
With lpsLWT
mLastModified = CStr(.wMonth) & "/" & _
CStr(.wDay) & "/" & _
CStr(.wYear) & " " & _
CStr(.wHour) & ":" & _
CStr(.wMinute) & ":" & _
CStr(.wSecond)
End With
End If
End If
'Close the file
rc = lclose(hFile)
End If
End Function
Public Property Get LastAccessed() As Date
LastAccessed = mLastAccessed
End Property
Public Property Get LastModified() As Date
LastModified = mLastModified
End Property
Public Function Recycle(Silent As Boolean) As Boolean
Dim rc As Long
Dim FileOperation As SHFILEOPSTRUCT
On Error GoTo handler
'Send the file to the recycle bin
With FileOperation
.wFunc = FO_DELETE
.pFrom = mFilename & Chr$(0)
.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
If Not Silent Then
'Show the progress dialog
.fFlags = .fFlags + FOF_SIMPLEPROGRESS
End If
End With
'Do it
rc = SHFileOperation(FileOperation)
'Return the result
Recycle = (rc = 0)
'Bypass the error handler
Exit Function
handler:
'Return an error code
Recycle = False
End Function
Public Function Rename(NewFilename As String) As Boolean
Rename = MoveFile(ByVal mFilename, ByVal NewFilename)
End Function
Private Sub SetAttributes()
Dim rc As Long
Dim fa As Long
If mReadOnly Then fa = fa Or FILE_ATTRIBUTE_READONLY
If mArchive Then fa = fa Or FILE_ATTRIBUTE_ARCHIVE
If mSystem Then fa = fa Or FILE_ATTRIBUTE_SYSTEM
If mHidden Then fa = fa Or FILE_ATTRIBUTE_HIDDEN
If mCompressed Then fa = fa Or FILE_ATTRIBUTE_COMPRESSED
rc = SetFileAttributes(mFilename, fa)
End Sub
Private Function SetFileTimes()
Dim rc As Long
Dim lpCreationTime As FILETIME
Dim lpLastAccessTime As FILETIME
Dim lpLastWriteTime As FILETIME
Dim hFile As Long
Dim lpBuff As OFSTRUCT
Dim lpsCT As SYSTEMTIME
Dim lpsLAT As SYSTEMTIME
Dim lpsLWT As SYSTEMTIME
'Get a handle to the file
hFile = OpenFile(ByVal mFilename, lpBuff, OF_WRITE)
If hFile <> 0 Then
'Convert creation date/time
With lpsCT
.wMonth = Month(mCreated)
.wDay = Day(mCreated)
.wYear = Year(mCreated)
.wHour = Hour(mCreated)
.wMinute = Minute(mCreated)
.wSecond = Second(mCreated)
End With
rc = SystemTimeToFileTime(lpsCT, lpCreationTime)
'Convert creation date/time
With lpsLAT
.wMonth = Month(mLastAccessed)
.wDay = Day(mLastAccessed)
.wYear = Year(mLastAccessed)
End With
rc = SystemTimeToFileTime(lpsLAT, lpLastAccessTime)
'Convert creation date/time
With lpsLWT
.wMonth = Month(mLastModified)
.wDay = Day(mLastModified)
.wYear = Year(mLastModified)
.wHour = Hour(mLastModified)
.wMinute = Minute(mLastModified)
.wSecond = Second(mLastModified)
End With
rc = SystemTimeToFileTime(lpsLWT, lpLastWriteTime)
'Save the new file dates & times
rc = SetFileTime(hFile, _
lpCreationTime, _
lpLastAccessTime, _
lpLastWriteTime)
'Close the file
rc = lclose(hFile)
End If
End Function
Public Property Get ShortFilename() As String
Dim rc As String
Dim lpBuff As String
Dim cbBuff As Long
'Allocate a buffer
lpBuff = String$(255, Chr$(0))
cbBuff = Len(lpBuff)
'Call the API
rc = GetShortPathName(ByVal mFilename, ByVal lpBuff, cbBuff)
If rc > 0 Then
ShortFilename = Left$(lpBuff, cbBuff)
Else
ShortFilename = ""
End If
End Property
Public Property Get Filename() As String
Filename = mFilename
End Property
Public Property Let Filename(ByVal vNewValue As String)
Dim rc As Long
mFilename = vNewValue
'Get the file attributes
rc = GetFileAttributes(mFilename)
If rc <> 1 Then
mReadOnly = rc And FILE_ATTRIBUTE_READONLY
mArchive = rc And FILE_ATTRIBUTE_ARCHIVE
mSystem = rc And FILE_ATTRIBUTE_SYSTEM
mHidden = rc And FILE_ATTRIBUTE_HIDDEN
mCompressed = rc And FILE_ATTRIBUTE_COMPRESSED
End If
'Get the file dates & times
GetFileTimes
End Property
Public Property Get Path() As String
Path = mPath
End Property
Public Property Get ReadOnly() As Boolean
ReadOnly = mReadOnly
End Property
Public Property Let ReadOnly(ByVal vNewValue As Boolean)
mReadOnly = vNewValue
SetAttributes
End Property
Public Property Get Archive() As Boolean
Archive = mArchive
End Property
Public Property Let Archive(ByVal vNewValue As Boolean)
mArchive = vNewValue
SetAttributes
End Property
Public Property Get System() As Boolean
System = mSystem
End Property
Public Property Let System(ByVal vNewValue As Boolean)
mSystem = vNewValue
SetAttributes
End Property
Public Property Get Hidden() As Boolean
Hidden = mHidden
End Property
Public Property Let Hidden(ByVal vNewValue As Boolean)
mHidden = vNewValue
SetAttributes
End Property
Public Property Get Compressed() As Boolean
Compressed = mCompressed
End Property
Public Property Let Compressed(ByVal vNewValue As Boolean)
mCompressed = vNewValue
SetAttributes
End Property
Public Property Get FileSize() As Long
FileSize = FileLen(mFilename)
End Property
Public Property Get Created() As Date
Created = mCreated
End Property
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -