| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 473 人关注过本帖, 1 人收藏
标题:filetime转化为具体时间
只看楼主 加入收藏
邵帅
Rank: 7Rank: 7Rank: 7
等 级:贵宾
威 望:20
帖 子:174
专家分:505
注 册:2012-8-27
结帖率:78.26%
收藏(1)
已结贴  问题点数:15 回复次数:2 
filetime转化为具体时间
对于一个类型为filetime的变量,转化为时间(XX年XX月XX日,XX时XX分XX秒)
求源码
搜索更多相关主题的帖子: 时间 
2012-09-28 09:11
bczgvip
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:66
帖 子:1310
专家分:5312
注 册:2009-2-26
收藏
得分:15 
可以的话,别谈变量只谈类型。
2012-09-28 14:14
wube
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:23
帖 子:1820
专家分:3681
注 册:2011-3-24
收藏
得分:0 
以前写的档案比对更新代码
你要的应该只是里面很小的一段
FileTimeToSystemTime部分

Class1:
程序代码:
'自動更新類
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

不要選我當版主
2012-10-03 14:28
快速回复:filetime转化为具体时间
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.066295 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved