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