一个文件类的类模块_VB编程

我的远程控制软件要对文件进行一些操作或者获取文件信息（比如修改属性，修改时间）等等，开始一直用模块来写，后来感觉麻烦，要调用好多次，就直接写了一个类模块，方便调用。

如要使用，版权随便···(俗话说做人要厚道，删除了版权就可以了，别再写上作者XXX就好)

功能：获取文件（文件夹）的创建时间，最后修改时间，最后访问时间，文件的大小（可以获取超过2G的文件大小），文件（文件夹）的属性（只有隐藏，存档，只读，系统四个常用的属性，想要别的可以自己加，那几个常量都列出来了），修改文件的属性，克隆文件时间

代码如下：

'/-----------------------------------文件操作类模块-----------------------------------

'-----------------------------------作者：BlackFeather(L.S.T)-----------------------------

'-----------------------------------QQ:345382462-----------------------------------

Option Explicit

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 SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) 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 FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1

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

' 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
'

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime 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 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

Dim c_PathName As String
Dim c_FileSize As String
Dim c_Creation As String
Dim c_Modify As String
Dim c_Access As String
Dim c_Hide As Long
Dim c_System As Long
Dim c_ReadOnly As Long
Dim c_Archive As Long
Dim c_TarKind As Boolean

Public Property Get FileSize() As String '文件大小
FileSize = c_FileSize
End Property

Public Property Get FullPathName() As String

FullPathName = c_PathName

End Property

Public Property Get AttHide() As Boolean'隐藏属性 true为是
If c_Hide <> 0 Then
AttHide = True
Else
AttHide = False
End If
End Property

Public Property Let AttHide(ByVal NVal As Boolean) '设置隐藏属性
If c_PathName <> vbNullString Then

    If NVal = True Then

          SetFileAttributes c_PathName, FILE_ATTRIBUTE_HIDDEN + c_System + c_Archive + c_ReadOnly

       Else

          SetFileAttributes c_PathName, c_System + c_Archive + c_ReadOnly

    End If

    ReFresh

End If
End Property

Public Property Get AttSys() As Boolean'是否为系统属性
If c_System <> 0 Then
      AttSys = True
    Else
      AttSys = False
End If
End Property

Public Property Let AttSys(ByVal NVal As Boolean)
If c_PathName <> vbNullString Then

    If NVal = True Then

         SetFileAttributes c_PathName, FILE_ATTRIBUTE_SYSTEM + c_Archive + c_ReadOnly + c_Hide

      Else

         SetFileAttributes c_PathName, c_Archive + c_ReadOnly + c_Hide

    End If

    ReFresh

End If
End Property

Public Property Get AttReadOnly() As Boolean'是否为只读属性
If c_ReadOnly <> 0 Then
      AttReadOnly = True
   Else
      AttReadOnly = False
End If
End Property

Public Property Let AttReadOnly(ByVal NVal As Boolean)
If c_PathName <> vbNullString Then

    If NVal = True Then

            SetFileAttributes c_PathName, FILE_ATTRIBUTE_READONLY + c_Archive + c_Hide + c_System

        Else

            SetFileAttributes c_PathName, c_Archive + c_Hide + c_System

    End If

    ReFresh

End If
End Property

Public Property Get AttArchive() As Boolean'是否为存档属性
If c_Archive <> 0 Then
         AttArchive = True
    Else
         AttArchive = False
End If
End Property

Public Property Let AttArchive(ByVal NVal As Boolean)
If c_PathName <> vbNullString Then

   If NVal = True Then

           SetFileAttributes c_PathName, FILE_ATTRIBUTE_ARCHIVE + c_ReadOnly + c_Hide + c_System

       Else

           SetFileAttributes c_PathName, c_ReadOnly + c_Hide + c_System

   End If

   ReFresh

End If
End Property

Public Property Get CreationTime() As String '创建时间
CreationTime = c_Creation
End Property

Public Property Get ModifyTime() As String'最后修改时间
ModifyTime = c_Modify
End Property

Public Property Get AccessTime() As String'最后访问时间
AccessTime = c_Access
End Property

Public Property Get TarKinds() As Boolean '判断是文件还是文件夹 1是文件，0是文件夹
TarKinds = c_TarKind
End Property

Public Property Let FullPathName(ByVal NewVal As String)

If NewVal <> c_PathName Then

   c_PathName = NewVal

   ReFresh

End If

End Property

Public Function CloneTime(ByVal CloneFile As String) As Boolean'克隆文件时间

Dim CFile As WIN32_FIND_DATA
Dim TempFileTime As FILETIME
Dim hFile As Long
Dim hCfile As Long

hCfile = FindFirstFile(CloneFile, CFile)

hFile = CreateFile(c_PathName, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0)

If hCfile <> INVALID_HANDLE_VALUE And hFile <> INVALID_HANDLE_VALUE Then

      TempFileTime = CFile.ftCreationTime '修改创建时间

      SetFileTime hFile, TempFileTime, ByVal 0&, ByVal 0&


      TempFileTime = CFile.ftLastWriteTime '修改最后修改时间

      SetFileTime hFile, ByVal 0&, ByVal 0&, TempFileTime


      TempFileTime = CFile.ftLastAccessTime '修改最后访问时间

      SetFileTime hFile, ByVal 0&, TempFileTime, ByVal 0&

      ReFresh

End If

CloseHandle hFile

FindClose hCfile

End Function

Private Sub ReFresh()

If c_PathName = vbNullString Then Exit Sub

Dim WFD As WIN32_FIND_DATA
Dim hWfd As Long
Dim SysTime As SYSTEMTIME

hWfd = FindFirstFile(c_PathName, WFD)

If hWfd <> INVALID_HANDLE_VALUE Then

       If WFD.nFileSizeHigh <> 0 Then

               c_FileSize = FormatFileSize(LongAsULong2Double(WFD.nFileSizeHigh))

            Else

               c_FileSize = FormatFileSize(LongAsULong2Double(WFD.nFileSizeLow))

       End If
   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''获取创建时间，最后修改时间，最后访问时间
       c_Creation = FileTimeToSysTime(WFD.ftCreationTime)
       c_Modify = FileTimeToSysTime(WFD.ftLastWriteTime)
       c_Access = FileTimeToSysTime(WFD.ftLastAccessTime)

   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''判断是文件还是文件夹
       If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then

            c_TarKind = False

         Else

            c_TarKind = True

       End If

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''属性判断

'文件是否为系统文件
    If (WFD.dwFileAttributes And FILE_ATTRIBUTE_HIDDEN) = FILE_ATTRIBUTE_HIDDEN Then

c_Hide = FILE_ATTRIBUTE_HIDDEN

Else

c_Hide = 0

End If

'文件是否为系统文件
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_SYSTEM) = FILE_ATTRIBUTE_SYSTEM Then

c_System = FILE_ATTRIBUTE_SYSTEM

Else

c_System = 0

End If

'文件是否为只读文件
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_READONLY) = FILE_ATTRIBUTE_READONLY Then

c_ReadOnly = FILE_ATTRIBUTE_READONLY

Else

c_ReadOnly = 0

End If

'文件是否为存档文件
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_ARCHIVE) = FILE_ATTRIBUTE_ARCHIVE Then

c_Archive = FILE_ATTRIBUTE_ARCHIVE

Else

c_Archive = 0

    End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   Else

     Debug.Print "find file error"

End If

FindClose hWfd

End Sub

Private Function FormatFileSize(ByVal Size As Double) As String
   Dim sRet As String
   Const KB& = 1024
   Const MB& = KB * KB
   ' Return size of file in kilobytes.
   If Size < KB Then
      sRet = Format(Size, "#,##0") & " bytes"
   Else
      Select Case Size / KB
         Case Is < 10
            sRet = Format(Size / KB, "0.00") & "KB"
         Case Is < 100
            sRet = Format(Size / KB, "0.0") & "KB"
         Case Is < 1000
            sRet = Format(Size / KB, "0") & "KB"
         Case Is < 10000
            sRet = Format(Size / MB, "0.00") & "MB"
         Case Is < 100000
            sRet = Format(Size / MB, "0.0") & "MB"
         Case Is < 1000000
            sRet = Format(Size / MB, "0") & "MB"
         Case Is < 1000000000
            sRet = Format(Size / MB / KB, "0.00") & "GB"
      End Select
      sRet = sRet & " (" & Format(Size, "#,##0") & " bytes)"
   End If
   FormatFileSize = sRet
End Function

Private Function LongAsULong2Double(ByVal Value As Long) As Double

Dim tmpByte(3) As Byte
Dim dblValue As Double

On Error GoTo ErrHandle

If Value < 0 Then
'若为负数，则强制转换为无符号型
Call CopyMemory(tmpByte(0), Value, 4)
dblValue = tmpByte(3) * 256# ^ 3# + _
tmpByte(2) * 256# ^ 2# + _
tmpByte(1) * 256# + _
tmpByte(0)
Else
'正整数直接返回
dblValue = Value
End If

LongAsULong2Double = dblValue

Exit Function

ErrHandle:
'错误时返回-1，表示调用失败
LongAsULong2Double = -1

End Function

Private Function FileTimeToSysTime(FileT As FILETIME) As String
Dim TempTime As FILETIME
Dim TempTime2 As SYSTEMTIME

FileTimeToLocalFileTime FileT, TempTime

FileTimeToSystemTime TempTime, TempTime2

FileTimeToSysTime = TempTime2.wYear & "-" & TempTime2.wMonth & "-" & TempTime2.wDay & _
" " & TempTime2.wHour & ":" & TempTime2.wMinute & ":" & TempTime2.wSecond

End Function

代码使用：
Dim CFI As New CFileInfo '定义
CFI.FullPathName = "c:\boot.ini"'输入文件或文件夹路径
Debug.Print "创建时间为" & CFI.CreationTime
Debug.Print "最后访问时间为" & CFI.AccessTime
Debug.Print "最后修改时间为" & CFI.ModifyTime
Debug.Print "存档属性" & CFI.AttArchive
Debug.Print "只读属性" & CFI.AttReadOnly
Debug.Print "隐藏属性" & CFI.AttHide
Debug.Print "系统属性" & CFI.AttSys
Debug.Print "文件大小" & CFI.FileSize '要是文件夹这里为0
Debug.Print "是文件 " & CFI.TarKinds
CFI.CloneTime "c:\windows\win.ini" '把boot.ini的的时间克隆成c:\windows\win.ini的时间
CFI.AttHide = False 去掉boot.ini的隐藏属性
CFI.AttReadOnly = True '加上只读的属性

debug输出：
创建时间为2008-4-24 23:28:58
最后访问时间为2008-8-19 0:0:0
最后修改时间为2008-7-4 16:2:12
存档属性True
只读属性True
隐藏属性True
系统属性True
文件大小251 bytes
是文件 True

BlackFeather'S Blog我的技术小博 -- C/C++,Python,Golang

一个文件类的类模块

评论列表:

发表评论:取消回复