filetime转化为具体时间
对于一个类型为filetime的变量,转化为时间(XX年XX月XX日,XX时XX分XX秒)求源码
程序代码:
'自動更新類
Option Explicit
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) 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 Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Const MaxLFNPath = 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_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
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 * MaxLFNPath
cShortFileName 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
Dim WFD As WIN32_FIND_DATA
Dim bgndir$, curpath$, schpattern$, aa$, fname$, progdisk$
Dim hItem&, hFile&, rtn&, i%, j%, k%, tfiles&, tfsize#, stopyn As Boolean
Dim X1&, buff$
Public Enum Answer
Whether = 0
Yes
No
End Enum
Private Type FileStruct
FullFileStation As String
Filename As String
FilePath As String
FileSize As Long
FilesStatus As WIN32_FIND_DATA
FCreationTime As String
FLastAccessTime As String
FLastWriteTime As String
End Type
Private Type ServerFileList
S_FileList() As FileStruct
S_EXE_Ver As String
S_EXE_Name As String
S_FL_Count As Integer
End Type
Private Type LocalFileList
L_FileList() As FileStruct
L_EXE_Ver As String
L_EXE_Name As String
L_FL_Count As Integer
End Type
Private Type UpDataFileList
U_FileList() As FileStruct
U_EXE_Ver As String
U_EXE_Name As String
U_FL_Count As Integer
End Type
Private Type CompareFile_INFO
LocalPath As String
FileFilter As String
ServerPath As String
L_FileINFO As LocalFileList
S_FileINFO As ServerFileList
U_FileINFO As UpDataFileList
UserAnswer As Answer
End Type
Private CompFile() As CompareFile_INFO
Private Error_Explain As String
'Class事件--------------------------------------------------------------
Public Event DataBack(vData As String, vData1() As String) '更新資料
Public Event Updata(vData As Answer) '是否更新
Public Event SearchFileData(vData As String) '搜尋過程
Public Property Let UpAllData(ByVal vData As Answer)
CompFile(0).UserAnswer = vData
If CompFile(0).UserAnswer = Yes Then
Call DownLoadFiles
End If
End Property
Private Sub Class_Initialize()
ReDim CompFile(0): Error_Explain = ""
End Sub
Private Sub Class_Terminate()
Erase CompFile: Error_Explain = ""
End Sub
Public Property Let TargetPath(ByVal vData As String)
CompFile(0).ServerPath = vData
End Property
Public Property Get TargetPath() As String
TargetPath = CompFile(0).ServerPath
End Property
Public Property Let Filter(ByVal vData As String)
CompFile(0).FileFilter = vData
End Property
Public Property Let LocalPath(ByVal vData As String)
CompFile(0).LocalPath = vData
End Property
Public Property Get LocalPath() As String
LocalPath = CompFile(0).LocalPath
End Property
Public Function StartCopmare() As Boolean
StartCopmare = SearchFile
End Function
Public Function StartUpdata() As Boolean
StartUpdata = SearchFile
End Function
Private Function SearchFile() As Boolean
Dim s As String, i As Integer
Dim L_Ver As String, S_Ver As String, L_Temp() As String, S_Temp() As String, U_Temp() As String
Dim CompResult As Boolean
CompResult = False
With CompFile(0)
For i = 0 To 1
If .FileFilter = "" Then .FileFilter = "*.*"
If i = 0 Then s = Trim(.LocalPath)
If i = 1 Then s = Trim(.ServerPath)
bgndir = s '開始搜的文件夾
If (InStr(bgndir, ":") = 0) And (Len(bgndir) = 1) Then bgndir = bgndir & ":"
If Right(bgndir, 1) <> "\" Then bgndir = bgndir & "\"
schpattern = Trim(.FileFilter) '模糊搜索條件,例如 *.* 或 *.mp3 或 sc*.*
Call SearchDirs(bgndir, i)
Next i
SearchFile = True
.L_FileINFO.L_EXE_Name = UCase(Trim(App.EXEName) & App.Major & "." & App.Minor & "." & App.Revision & ".0" & ".exe")
.S_FileINFO.S_EXE_Name = UCase(Trim(.S_FileINFO.S_EXE_Name))
.L_FileINFO.L_EXE_Ver = Mid$(.L_FileINFO.L_EXE_Name, InStrRev(.L_FileINFO.L_EXE_Name, "V") + 1, InStrRev(.L_FileINFO.L_EXE_Name, "V") - Len(".EXE") - 1)
.S_FileINFO.S_EXE_Ver = Mid$(.S_FileINFO.S_EXE_Name, InStrRev(.S_FileINFO.S_EXE_Name, "V") + 1, InStrRev(.S_FileINFO.S_EXE_Name, "V") - Len(".EXE") - 1)
If .L_FileINFO.L_EXE_Name = .S_FileINFO.S_EXE_Name Or .L_FileINFO.L_EXE_Ver = .S_FileINFO.S_EXE_Ver Then
RaiseEvent SearchFileData("OK")
Else
If .L_FileINFO.L_EXE_Ver <> .S_FileINFO.S_EXE_Ver Then
If (InStr(.L_FileINFO.L_EXE_Ver, ".") <> 0) And (InStr(.S_FileINFO.S_EXE_Ver, ".") <> 0) Then
L_Temp = Split(.L_FileINFO.L_EXE_Ver, "."): S_Temp = Split(.S_FileINFO.S_EXE_Ver, ".")
If UBound(L_Temp) = UBound(S_Temp) Then
For i = 0 To UBound(L_Temp)
If Val(L_Temp(i)) = Val(S_Temp(i)) Then
CompResult = False
ElseIf Val(L_Temp(i)) < Val(S_Temp(i)) Then
CompResult = True
Exit For
End If
Next i
End If
If CompResult = True Then
Call All_DataCompare
RaiseEvent Updata(Whether)
Else
RaiseEvent DataBack("本地端程式版本較新,故不更新。", U_Temp())
End If
End If
End If
End If
End With
' If tfiles > 0 Then
' MsgBox "搜索完成,共查找到" & str(tfiles) & " 個文件" & vbCrLf & Chr(10) & "總佔空間: " & Format(str(tfsize), "#,###") & " Bytes"
' Else
' MsgBox "搜索完成,未找到符合的文件"
' End If
End Function
Private Sub SearchDirs(curpath, i As Integer)
Dim dirs%, dircount%, dirbuf$()
On Error Resume Next
RaiseEvent SearchFileData("正在查找 " & curpath)
DoEvents
hItem = FindFirstFile(curpath & "*", WFD)
If hItem <> INVALID_HANDLE_VALUE Then
Do
DoEvents
If stopyn Then Exit Do
If (WFD.dwFileAttributes And vbDirectory) And Asc(WFD.cFileName) <> 46 Then
If (dirs Mod 10) = 0 Then ReDim Preserve dirbuf(dirs + 10)
dirs = dirs + 1
dirbuf(dirs) = Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
End If
Loop While FindNextFile(hItem, WFD)
Call FindClose(hItem)
Call mohusearch(curpath, i)
End If
For dircount = 1 To dirs
DoEvents
If stopyn Then Exit For
SearchDirs curpath & dirbuf$(dircount) & "\", i
Next dircount
End Sub
Private Sub mohusearch(curpath, index As Integer)
Dim TempString As String
On Error Resume Next
hFile = FindFirstFile(curpath & schpattern, WFD)
If hFile <> INVALID_HANDLE_VALUE Then
Do
DoEvents
If stopyn Then Exit Do
aa = Trim(Trim(curpath) & Trim(WFD.cFileName))
If (WFD.dwFileAttributes And vbDirectory) Or Asc(WFD.cFileName) = 46 Then
Else
k = InStr(aa, Chr(0))
If k > 0 Then
fname = Mid(aa, 1, k - 1)
aa = Trim(fname) ' & "," & Format(str(FileLen(fname)), "####") & " Bytes"
tfiles = tfiles + 1
tfsize = tfsize + FileLen(fname)
TempString = ""
If index = 0 Then
With CompFile(0).L_FileINFO
ReDim Preserve .L_FileList(.L_FL_Count)
.L_FileList(.L_FL_Count).FullFileStation = aa
Call UpFilesStatus(.L_FileList(.L_FL_Count))
TempString = .L_FileList(.L_FL_Count).FullFileStation
.L_FileList(.L_FL_Count).Filename = Mid$(TempString, InStrRev(TempString, "\") + 1)
.L_FileList(.L_FL_Count).FileSize = FileLen(TempString)
.L_FileList(.L_FL_Count).FilePath = Mid$(TempString, 1, InStrRev(TempString, "\"))
If Right$(UCase(Trim(TempString)), 4) = UCase$(".EXE") Then
.L_EXE_Name = Trim(Mid$(TempString, InStrRev(TempString, "\") + 1))
End If
.L_FL_Count = .L_FL_Count + 1
End With
ElseIf index = 1 Then
With CompFile(0).S_FileINFO
ReDim Preserve .S_FileList(.S_FL_Count)
.S_FileList(.S_FL_Count).FullFileStation = aa
Call UpFilesStatus(.S_FileList(.S_FL_Count))
TempString = .S_FileList(.S_FL_Count).FullFileStation
.S_FileList(.S_FL_Count).Filename = Mid$(TempString, InStrRev(TempString, "\") + 1)
.S_FileList(.S_FL_Count).FileSize = FileLen(TempString)
.S_FileList(.S_FL_Count).FilePath = Mid$(TempString, 1, InStrRev(TempString, "\"))
If Right$(UCase(Trim(TempString)), 4) = UCase$(".EXE") Then
.S_EXE_Name = Trim(Mid$(TempString, InStrRev(TempString, "\") + 1))
End If
.S_FL_Count = .S_FL_Count + 1
End With
End If
TempString = ""
End If
End If
Loop While FindNextFile(hFile, WFD)
Call FindClose(hFile)
End If
End Sub
Private Function Findfile(xstrfilename) As WIN32_FIND_DATA
Dim Win32Data As WIN32_FIND_DATA
Dim plngFirstFileHwnd As Long
Dim plngRtn As Long
plngFirstFileHwnd = FindFirstFile(xstrfilename, Win32Data)
If plngFirstFileHwnd = 0 Then
Findfile.cFileName = "Error"
Else
Findfile = Win32Data
End If
plngRtn = FindClose(plngFirstFileHwnd)
End Function
Private Sub UpFilesStatus(FilesStuct As FileStruct)
Dim ftime As SYSTEMTIME
Dim tfilename As String
Dim filedata As WIN32_FIND_DATA
With FilesStuct
tfilename = .FullFileStation
filedata = Findfile(tfilename)
.FilesStatus.cFileName = WFD.cFileName
'
If filedata.nFileSizeHigh = 0 Then
.FilesStatus.nFileSizeHigh = filedata.nFileSizeLow ' & " Bytes"
Else
.FilesStatus.nFileSizeLow = filedata.nFileSizeHigh ' & "Bytes"
End If
'
Call FileTimeToSystemTime(filedata.ftCreationTime, ftime)
.FilesStatus.ftCreationTime = WFD.ftCreationTime
.FCreationTime = ftime.wDay & "/" & ftime.wMonth & "/" & ftime.wYear & " " & ftime.wHour & ":" & ftime.wMinute & ":" & ftime.wSecond
Call FileTimeToSystemTime(filedata.ftLastWriteTime, ftime)
.FilesStatus.ftLastWriteTime = WFD.ftLastWriteTime
.FLastWriteTime = ftime.wDay & "/" & ftime.wMonth & "/" & ftime.wYear & " " & ftime.wHour & ":" & ftime.wMinute & ":" & ftime.wSecond
Call FileTimeToSystemTime(filedata.ftLastAccessTime, ftime)
.FilesStatus.ftLastAccessTime = WFD.ftLastAccessTime
.FLastAccessTime = ftime.wDay & "/" & ftime.wMonth & "/" & ftime.wYear
'以下保留(暫無用處)
If (filedata.dwFileAttributes And FILE_ATTRIBUTE_HIDDEN) = FILE_ATTRIBUTE_HIDDEN Then
.FilesStatus.dwFileAttributes = FILE_ATTRIBUTE_HIDDEN
Else
.FilesStatus.dwFileAttributes = 0
End If
If (filedata.dwFileAttributes And FILE_ATTRIBUTE_SYSTEM) = FILE_ATTRIBUTE_SYSTEM Then
.FilesStatus.dwFileAttributes = FILE_ATTRIBUTE_SYSTEM
Else
.FilesStatus.dwFileAttributes = 0
End If
If (filedata.dwFileAttributes And FILE_ATTRIBUTE_READONLY) = FILE_ATTRIBUTE_READONLY Then
.FilesStatus.dwFileAttributes = FILE_ATTRIBUTE_READONLY
Else
.FilesStatus.dwFileAttributes = 0
End If
If (filedata.dwFileAttributes And FILE_ATTRIBUTE_ARCHIVE) = FILE_ATTRIBUTE_ARCHIVE Then
.FilesStatus.dwFileAttributes = FILE_ATTRIBUTE_ARCHIVE
Else
.FilesStatus.dwFileAttributes = 0
End If
If (filedata.dwFileAttributes And FILE_ATTRIBUTE_TEMPORARY) = FILE_ATTRIBUTE_TEMPORARY Then
.FilesStatus.dwFileAttributes = FILE_ATTRIBUTE_TEMPORARY
Else
.FilesStatus.dwFileAttributes = 0
End If
If (filedata.dwFileAttributes And FILE_ATTRIBUTE_NORMAL) = FILE_ATTRIBUTE_NORMAL Then
.FilesStatus.dwFileAttributes = FILE_ATTRIBUTE_NORMAL
Else
.FilesStatus.dwFileAttributes = 0
End If
If (filedata.dwFileAttributes And FILE_ATTRIBUTE_COMPRESSED) = FILE_ATTRIBUTE_COMPRESSED Then
.FilesStatus.dwFileAttributes = FILE_ATTRIBUTE_COMPRESSED
Else
.FilesStatus.dwFileAttributes = 0
End If
End With
End Sub
Private Sub All_DataCompare()
Dim i As Integer, j As Integer
Dim S_Temp As String, L_Temp As String
With CompFile(0)
For i = 0 To UBound(.S_FileINFO.S_FileList)
S_Temp = .S_FileINFO.S_FileList(i).Filename
For j = 0 To UBound(.L_FileINFO.L_FileList)
L_Temp = .L_FileINFO.L_FileList(j).Filename
If (S_Temp = L_Temp) Or ((S_Temp <> L_Temp) And (Right(S_Temp, 4) = Right(L_Temp, 4)) And (Right(UCase(Trim(S_Temp)), 4) = ".EXE")) Then
If .S_FileINFO.S_FileList(i).FileSize <> .L_FileINFO.L_FileList(j).FileSize Then
ReDim Preserve .U_FileINFO.U_FileList(.U_FileINFO.U_FL_Count)
If Right$(UCase$(Trim$(.S_FileINFO.S_EXE_Name)), 3) = "EXE" Then
.U_FileINFO.U_EXE_Name = .S_FileINFO.S_EXE_Name
.U_FileINFO.U_EXE_Ver = .S_FileINFO.S_EXE_Ver
End If
With .U_FileINFO.U_FileList(.U_FileINFO.U_FL_Count)
.Filename = S_Temp
.FilePath = CompFile(0).S_FileINFO.S_FileList(i).FilePath & "," & CompFile(0).L_FileINFO.L_FileList(j).FilePath
.FileSize = CompFile(0).S_FileINFO.S_FileList(i).FileSize
.FLastAccessTime = CompFile(0).S_FileINFO.S_FileList(i).FLastAccessTime
.FCreationTime = CompFile(0).S_FileINFO.S_FileList(i).FCreationTime
.FLastWriteTime = CompFile(0).S_FileINFO.S_FileList(i).FLastWriteTime
End With
.U_FileINFO.U_FL_Count = .U_FileINFO.U_FL_Count + 1
Else
L_Temp = ""
End If
Exit For
End If
Next j
S_Temp = "": L_Temp = ""
Next i
End With
End Sub
Private Sub DownLoadFiles()
Dim i As Integer
Dim SName As String, SPath As String, LPath As String
With CompFile(0)
For i = 0 To .U_FileINFO.U_FL_Count - 1
SName = .U_FileINFO.U_FileList(i).Filename
SPath = Trim(Mid$(.U_FileINFO.U_FileList(i).FilePath, 1, InStr(.U_FileINFO.U_FileList(i).FilePath, ",") - 1))
LPath = Trim(Mid$(.U_FileINFO.U_FileList(i).FilePath, InStrRev(.U_FileINFO.U_FileList(i).FilePath, ",") + 1))
FileCopy SPath & SName, LPath & SName
SName = "": SPath = "": LPath = ""
Next i
End With
End Sub
