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