我的远程控制软件要对文件进行一些操作或者获取文件信息（比如修改属性，修改时间）等等，开始一直用模块来写，后来感觉麻烦，要调用好多次，就直接写了一个类模块，方便调用。
如要使用，版权随便···(俗话说做人要厚道，删除了版权就可以了，别再写上作者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
2008/10/5 | Tags:原创,VB,编程 | VB编程 | 查看评论(0)