cfindfile.cls

大型商业学分统计系统原代码说明 1.如果在向导设置班级数为8时,此数值为班级总数

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cFindFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'-------------------------------------------------------
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
'-------------------------------------------------------
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 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 FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
'-------------------------------------------------------
Private mlngFile As Long
Private mstrDateFormat As String
Private mstrUnknownDateText As String
Private mwfdFindData As WIN32_FIND_DATA
'-------------------------------------------------------
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'========================================================
Public Property Let DateFormat(strDateFormat As String)
    mstrDateFormat = strDateFormat
End Property
'========================================================
'========================================================
Public Property Let UnknownDateText(strUnknownDateText As String)
    mstrUnknownDateText = strUnknownDateText
End Property
'========================================================
'========================================================
Public Property Get FileAttributes() As Long
    If mlngFile Then FileAttributes = mwfdFindData.dwFileAttributes
End Property
'========================================================
'========================================================
Public Property Get IsCompressed() As Boolean
    If mlngFile Then IsCompressed = mwfdFindData.dwFileAttributes _
            And FILE_ATTRIBUTE_COMPRESSED
End Property
'========================================================
'========================================================
Public Property Get NormalAttribute() As Long
    NormalAttribute = FILE_ATTRIBUTE_NORMAL
End Property
'========================================================
'========================================================
Public Function Find(strFile As String, _
            Optional blnShowError As Boolean) As String
    If mlngFile Then
        If blnShowError Then
            If MsgBox("Cancel the current search?", vbYesNo Or _
                    vbQuestion) = vbNo Then Exit Function
        End If
        EndFind
    End If
    mlngFile = FindFirstFile(strFile, mwfdFindData)
    If mlngFile = INVALID_HANDLE_VALUE Then
        mlngFile = 0
        If blnShowError Then
            MsgBox strFile & "counld not be found!", vbExclamation
        Else
            'Err.Raise vbObjectError + 5000, "clsFindFile_Find", _
             strFile & "counld not be found!"
        End If
        Exit Function
    End If
    Find = Left(mwfdFindData.cFileName, _
            InStr(mwfdFindData.cFileName, Chr(0)) - 1)
End Function
'========================================================
'========================================================
Public Function FindNext() As String
    If mlngFile = 0 Then Exit Function
    mwfdFindData.cFileName = Space(MAX_PATH)
    If FindNextFile(mlngFile, mwfdFindData) Then
        FindNext = Left(mwfdFindData.cFileName, _
                InStr(mwfdFindData.cFileName, Chr(0)) - 1)
    Else
        EndFind
    End If
End Function
'========================================================
'========================================================
Private Sub EndFind()
    FindClose mlngFile
    mlngFile = 0
End Sub
'========================================================
'========================================================
Public Function GetShortName() As String
    Dim strShortFileName As String
    If mlngFile = 0 Then Exit Function
    strShortFileName = Left(mwfdFindData.cFileName, _
            InStr(mwfdFindData.cAlternate, Chr(0)) - 1)
    If Len(strShortFileName) = 0 Then
        strShortFileName = Left(mwfdFindData.cFileName, _
                InStr(mwfdFindData.cFileName, Chr(0)) - 1)
    End If
    GetShortName = strShortFileName
End Function
'========================================================
'========================================================
Public Function GetCreationDate(Optional datDate As Date, _
            Optional datTime As Date) As String
    If mlngFile = 0 Then Exit Function
    If mwfdFindData.ftCreationTime.dwHighDateTime = 0 Then
        GetCreationDate = mstrUnknownDateText
    End If
    With GetSystemTime(mwfdFindData.ftCreationTime)
        datDate = DateSerial(.wYear, .wMonth, .wDay)
        datTime = TimeSerial(.wHour, .wMinute, .wSecond)
        GetCreationDate = Format(datDate + datTime, mstrDateFormat)
    End With
End Function
'========================================================
'========================================================
Public Function GetLastAccessDate(Optional datDate As Date, _
            Optional datTime As Date) As String
    If mlngFile = 0 Then Exit Function
    If mwfdFindData.ftLastAccessTime.dwHighDateTime = 0 Then
        GetLastAccessDate = mstrUnknownDateText
        Exit Function
    End If
    With GetSystemTime(mwfdFindData.ftLastAccessTime)
        datDate = DateSerial(.wYear, .wMonth, .wDay)
        datTime = TimeSerial(.wHour, .wMinute, .wSecond)
        GetLastAccessDate = Format(datDate + datTime, mstrDateFormat)
    End With
End Function
'========================================================
'========================================================
Public Function GetLastWriteDate(Optional datDate As Date, _
            Optional datTime As Date) As String
    If mlngFile = 0 Then Exit Function
    If mwfdFindData.ftLastWriteTime.dwHighDateTime = 0 Then
        GetLastWriteDate = mstrUnknownDateText
        Exit Function
    End If
    With GetSystemTime(mwfdFindData.ftLastWriteTime)
        datDate = DateSerial(.wYear, .wMonth, .wDay)
        datTime = TimeSerial(.wHour, .wMinute, .wSecond)
        GetLastWriteDate = Format(datDate + datTime, mstrDateFormat)
    End With
End Function
'========================================================
'========================================================
Private Function GetSystemTime(ftmFileTime As FILETIME) As SYSTEMTIME
    Dim ftmLocalTime As FILETIME
    Dim stmSystemTime As SYSTEMTIME
    FileTimeToLocalFileTime ftmFileTime, ftmLocalTime
    FileTimeToSystemTime ftmLocalTime, stmSystemTime
    GetSystemTime = stmSystemTime
End Function
'========================================================
'========================================================
Private Sub Class_Initialize()
    mstrUnknownDateText = "Unknown"
    mstrDateFormat = "m/d/yy h:nn:ss AM/PM"
End Sub
Private Sub Class_Terminate()
    If mlngFile Then EndFind
End Sub
'========================================================