dcsimg
Results 1 to 8 of 8

Thread: How to Show File Details in Label or textbox

  1. #1

    Thread Starter
    Lively Member
    Join Date
    Aug 2016
    Posts
    101

    How to Show File Details in Label or textbox

    Hi dears
    I have an explorer in my project, i want to see selected file's details (file property) like (Name, Size, Format, ...etc.)
    how can i code for it
    -----------------------------------------------
    my code for file format is : Label1.Caption = UCase(Right(File1.Path + "\" + File1.FileName, 3)) It is ok but for other details
    i need your helps

  2. #2
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    5,627

    Re: How to Show File Details in Label or textbox

    Mahmood,

    Which details are you after? You've got to already have the name to get anything else, so it seems a bit silly to be asking for that one.

    Regarding Size, either Len or Lof should do the job for you. If you also want size-on-disk, that might be a bit trickier.

    Regarding some of the other properties, here are a few functions for you. And maybe they'll serve as a guide for you to get other information as well:

    Code:
    
    Option Explicit
    '
    Private Const MAX_PATH = 260
    '
    Private Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
    End Type
    Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
    End Type
    Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ' &h01 bit = read only
        ' &h02 bit = hidden
        ' &h04 bit = system
        ' &h10 bit = folder
        ' &h20 bit = archive
        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
    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 VS_FIXEDFILEINFO
        dwSignature As Long
        dwStrucVersionl As Integer     '  e.g. = &h0000 = 0
        dwStrucVersionh As Integer     '  e.g. = &h0042 = .42
        dwFileVersionMSl As Integer    '  e.g. = &h0003 = 3
        dwFileVersionMSh As Integer    '  e.g. = &h0075 = .75
        dwFileVersionLSl As Integer    '  e.g. = &h0000 = 0
        dwFileVersionLSh As Integer    '  e.g. = &h0031 = .31
        dwProductVersionMSl As Integer '  e.g. = &h0003 = 3
        dwProductVersionMSh As Integer '  e.g. = &h0010 = .1
        dwProductVersionLSl As Integer '  e.g. = &h0000 = 0
        dwProductVersionLSh As Integer '  e.g. = &h0031 = .31
        dwFileFlagsMask As Long        '  = &h3F for version "0.42"
        dwFileFlags As Long            '  e.g. VFF_DEBUG Or VFF_PRERELEASE
        dwFileOS As Long               '  e.g. VOS_DOS_WINDOWS16
        dwFileType As Long             '  e.g. VFT_DRIVER
        dwFileSubtype As Long          '  e.g. VFT2_DRV_KEYBOARD
        dwFileDateMS As Long           '  e.g. 0
        dwFileDateLS As Long           '  e.g. 0
    End Type
    '
    Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
    Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
    Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
    Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
    Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal Length As Long)
    '
    Private Const GENERIC_READ As Long = &H80000000
    Private Const GENERIC_WRITE As Long = &H40000000
    Private Const OPEN_EXISTING As Long = &H3
    Private Const FILE_SHARE_READ As Long = &H1
    Private Const FILE_SHARE_WRITE As Long = &H2
    '
    
    Public Function FileVersion(sFileSpec As String) As String
        Dim rc As Long
        Dim lDummy As Long
        Dim sBuffer() As Byte
        Dim lBufferLen As Long
        Dim lVerPointer As Long
        Dim udtVerBuffer As VS_FIXEDFILEINFO
        Dim lVerbufferLen As Long
        '
        lBufferLen = GetFileVersionInfoSize(sFileSpec, lDummy)
        If lBufferLen < 1 Then Exit Function
        '
        ReDim sBuffer(lBufferLen)
        rc = GetFileVersionInfo(sFileSpec, 0&, lBufferLen, sBuffer(0))
        rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
        CopyMemory udtVerBuffer, lVerPointer, LenB(udtVerBuffer)
        '
        FileVersion = Format$(udtVerBuffer.dwFileVersionMSh) & "." & Format$(udtVerBuffer.dwFileVersionMSl) & "." & Format$(udtVerBuffer.dwFileVersionLSh) & "." & Format$(udtVerBuffer.dwFileVersionLSl)
    End Function
    
    Public Function ProductVersion(sFileSpec As String) As String
        Dim rc As Long
        Dim lDummy As Long
        Dim sBuffer() As Byte
        Dim lBufferLen As Long
        Dim lVerPointer As Long
        Dim udtVerBuffer As VS_FIXEDFILEINFO
        Dim lVerbufferLen As Long
        '
        lBufferLen = GetFileVersionInfoSize(sFileSpec, lDummy)
        If lBufferLen < 1 Then Exit Function
        '
        ReDim sBuffer(lBufferLen)
        rc = GetFileVersionInfo(sFileSpec, 0&, lBufferLen, sBuffer(0))
        rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
        CopyMemory udtVerBuffer, lVerPointer, LenB(udtVerBuffer)
        '
        ProductVersion = Format$(udtVerBuffer.dwProductVersionMSh) & "." & Format$(udtVerBuffer.dwProductVersionMSl) & "." & Format$(udtVerBuffer.dwProductVersionLSh) & "." & Format$(udtVerBuffer.dwProductVersionLSl)
    End Function
    
    Public Function GetFileTimes(sFileSpec As String, bConvertToLocalTime As Boolean, dtCreationDate As Date, dtAccessDate As Date, dtModifiedDate As Date) As Boolean
        ' Returns TRUE on success, FALSE on fail.
        ' dtCreationDate, dtAccessDate, &  dtModifiedDate are returned if successful.
        Dim file_handle As Long
        Dim creation_filetime As FILETIME
        Dim access_filetime As FILETIME
        Dim modified_filetime As FILETIME
        Dim file_time As FILETIME
        Dim sa As SECURITY_ATTRIBUTES
        '
        ' Open the file.
        file_handle = CreateFile(sFileSpec, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, sa, OPEN_EXISTING, 0&, 0&)
        If file_handle = 0 Then Exit Function
        '
        ' Get the times.
        If GetFileTime(file_handle, creation_filetime, access_filetime, modified_filetime) = 0 Then
            CloseHandle file_handle
            Exit Function
        End If
        '
        ' Close the file.
        If CloseHandle(file_handle) = 0 Then Exit Function
        '
        ' See if we should convert to the local file system time.
        If bConvertToLocalTime Then
            ' Convert to local file system time.
            FileTimeToLocalFileTime creation_filetime, file_time
            creation_filetime = file_time
            '
            FileTimeToLocalFileTime access_filetime, file_time
            access_filetime = file_time
            '
            FileTimeToLocalFileTime modified_filetime, file_time
            modified_filetime = file_time
        End If
        '
        ' Convert into dates.
        dtCreationDate = FileTimeToDate(creation_filetime)
        dtAccessDate = FileTimeToDate(access_filetime)
        dtModifiedDate = FileTimeToDate(modified_filetime)
        '
        GetFileTimes = True ' We succeeded.
    End Function
    
    Public Function FileSize(sFileSpec As String) As Long
        ' This will not work correctly for files over 2 gig.
        ' Also, if the file doesn't exist, it returns zero.
        Dim wfd As WIN32_FIND_DATA
        Dim h As Long
        Const INVALID_HANDLE_VALUE = -1
        '
        h = FindFirstFile(sFileSpec, wfd)
        If h = INVALID_HANDLE_VALUE Then Exit Function
        '
        FileSize = wfd.nFileSizeLow
    End Function
    
    Public Function FileCreatedDate(sFileSpec As String) As Date
        ' If the file doesn't exist, it returns zero (12/30/1899 midnight).
        Dim wfd As WIN32_FIND_DATA
        Dim h As Long
        Const INVALID_HANDLE_VALUE = -1
        '
        h = FindFirstFile(sFileSpec, wfd)
        If h = INVALID_HANDLE_VALUE Then Exit Function
        '
        FileCreatedDate = dFileTimeToDouble(wfd.ftCreationTime, True)
    End Function
    
    Public Function FileModifiedDate(sFileSpec As String) As Date
        ' If the file doesn't exist, it returns zero (12/30/1899 midnight).
        Dim wfd As WIN32_FIND_DATA
        Dim h As Long
        Const INVALID_HANDLE_VALUE = -1
        '
        h = FindFirstFile(sFileSpec, wfd)
        If h = INVALID_HANDLE_VALUE Then Exit Function
        '
        FileModifiedDate = dFileTimeToDouble(wfd.ftLastWriteTime, True)
    End Function
    
    Public Function FileAccessedDate(sFileSpec As String) As Date
        ' If the file doesn't exist, it returns zero (12/30/1899 midnight).
        Dim wfd As WIN32_FIND_DATA
        Dim h As Long
        Const INVALID_HANDLE_VALUE = -1
        '
        h = FindFirstFile(sFileSpec, wfd)
        If h = INVALID_HANDLE_VALUE Then Exit Function
        '
        FileAccessedDate = dFileTimeToDouble(wfd.ftLastAccessTime, True)
    End Function
    
    Private Function dFileTimeToDouble(ftUTC As FILETIME, Optional Localize As Boolean = False) As Double
       Dim FT As FILETIME
       Dim st As SYSTEMTIME
       Dim d As Double
       Dim t As Double
       ' Convert to local filetime, if necessary.
       If Localize Then
          FileTimeToLocalFileTime ftUTC, FT
       Else
          FT = ftUTC
       End If
       ' Convert to system time structure.
       FileTimeToSystemTime FT, st
       ' Convert to VB-style date (double).
       dFileTimeToDouble = DateSerial(st.wYear, st.wMonth, st.wDay) + TimeSerial(st.wHour, st.wMinute, st.wSecond)
    End Function
    
    Private Function FileTimeToDate(FT As FILETIME) As Date
        Dim stLocal As SYSTEMTIME
        Const ZERO_DATE As Date = 0!
        '
        If (FT.dwHighDateTime <> 0) And (FT.dwLowDateTime <> 0) Then
            FileTimeToSystemTime FT, stLocal
            FileTimeToDate = DateSerial(stLocal.wYear, stLocal.wMonth, stLocal.wDay) + TimeSerial(stLocal.wHour, stLocal.wMinute, stLocal.wSecond)
        Else
            FileTimeToDate = ZERO_DATE
        End If
    End Function
    
    Enjoy,
    Elroy
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  3. #3

    Thread Starter
    Lively Member
    Join Date
    Aug 2016
    Posts
    101

    Re: How to Show File Details in Label or textbox

    Quote Originally Posted by Elroy View Post
    Mahmood,

    Which details are you after? You've got to already have the name to get anything else, so it seems a bit silly to be asking for that one.

    Regarding Size, either Len or Lof should do the job for you. If you also want size-on-disk, that might be a bit trickier.

    Regarding some of the other properties, here are a few functions for you. And maybe they'll serve as a guide for you to get other information as well:

    Code:
    
    Option Explicit
    '
    Private Const MAX_PATH = 260
    '
    Private Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
    End Type
    Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
    End Type
    Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ' &h01 bit = read only
        ' &h02 bit = hidden
        ' &h04 bit = system
        ' &h10 bit = folder
        ' &h20 bit = archive
        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
    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 VS_FIXEDFILEINFO
        dwSignature As Long
        dwStrucVersionl As Integer     '  e.g. = &h0000 = 0
        dwStrucVersionh As Integer     '  e.g. = &h0042 = .42
        dwFileVersionMSl As Integer    '  e.g. = &h0003 = 3
        dwFileVersionMSh As Integer    '  e.g. = &h0075 = .75
        dwFileVersionLSl As Integer    '  e.g. = &h0000 = 0
        dwFileVersionLSh As Integer    '  e.g. = &h0031 = .31
        dwProductVersionMSl As Integer '  e.g. = &h0003 = 3
        dwProductVersionMSh As Integer '  e.g. = &h0010 = .1
        dwProductVersionLSl As Integer '  e.g. = &h0000 = 0
        dwProductVersionLSh As Integer '  e.g. = &h0031 = .31
        dwFileFlagsMask As Long        '  = &h3F for version "0.42"
        dwFileFlags As Long            '  e.g. VFF_DEBUG Or VFF_PRERELEASE
        dwFileOS As Long               '  e.g. VOS_DOS_WINDOWS16
        dwFileType As Long             '  e.g. VFT_DRIVER
        dwFileSubtype As Long          '  e.g. VFT2_DRV_KEYBOARD
        dwFileDateMS As Long           '  e.g. 0
        dwFileDateLS As Long           '  e.g. 0
    End Type
    '
    Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
    Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
    Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
    Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
    Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal Length As Long)
    '
    Private Const GENERIC_READ As Long = &H80000000
    Private Const GENERIC_WRITE As Long = &H40000000
    Private Const OPEN_EXISTING As Long = &H3
    Private Const FILE_SHARE_READ As Long = &H1
    Private Const FILE_SHARE_WRITE As Long = &H2
    '
    
    Public Function FileVersion(sFileSpec As String) As String
        Dim rc As Long
        Dim lDummy As Long
        Dim sBuffer() As Byte
        Dim lBufferLen As Long
        Dim lVerPointer As Long
        Dim udtVerBuffer As VS_FIXEDFILEINFO
        Dim lVerbufferLen As Long
        '
        lBufferLen = GetFileVersionInfoSize(sFileSpec, lDummy)
        If lBufferLen < 1 Then Exit Function
        '
        ReDim sBuffer(lBufferLen)
        rc = GetFileVersionInfo(sFileSpec, 0&, lBufferLen, sBuffer(0))
        rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
        CopyMemory udtVerBuffer, lVerPointer, LenB(udtVerBuffer)
        '
        FileVersion = Format$(udtVerBuffer.dwFileVersionMSh) & "." & Format$(udtVerBuffer.dwFileVersionMSl) & "." & Format$(udtVerBuffer.dwFileVersionLSh) & "." & Format$(udtVerBuffer.dwFileVersionLSl)
    End Function
    
    Public Function ProductVersion(sFileSpec As String) As String
        Dim rc As Long
        Dim lDummy As Long
        Dim sBuffer() As Byte
        Dim lBufferLen As Long
        Dim lVerPointer As Long
        Dim udtVerBuffer As VS_FIXEDFILEINFO
        Dim lVerbufferLen As Long
        '
        lBufferLen = GetFileVersionInfoSize(sFileSpec, lDummy)
        If lBufferLen < 1 Then Exit Function
        '
        ReDim sBuffer(lBufferLen)
        rc = GetFileVersionInfo(sFileSpec, 0&, lBufferLen, sBuffer(0))
        rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
        CopyMemory udtVerBuffer, lVerPointer, LenB(udtVerBuffer)
        '
        ProductVersion = Format$(udtVerBuffer.dwProductVersionMSh) & "." & Format$(udtVerBuffer.dwProductVersionMSl) & "." & Format$(udtVerBuffer.dwProductVersionLSh) & "." & Format$(udtVerBuffer.dwProductVersionLSl)
    End Function
    
    Public Function GetFileTimes(sFileSpec As String, bConvertToLocalTime As Boolean, dtCreationDate As Date, dtAccessDate As Date, dtModifiedDate As Date) As Boolean
        ' Returns TRUE on success, FALSE on fail.
        ' dtCreationDate, dtAccessDate, &  dtModifiedDate are returned if successful.
        Dim file_handle As Long
        Dim creation_filetime As FILETIME
        Dim access_filetime As FILETIME
        Dim modified_filetime As FILETIME
        Dim file_time As FILETIME
        Dim sa As SECURITY_ATTRIBUTES
        '
        ' Open the file.
        file_handle = CreateFile(sFileSpec, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, sa, OPEN_EXISTING, 0&, 0&)
        If file_handle = 0 Then Exit Function
        '
        ' Get the times.
        If GetFileTime(file_handle, creation_filetime, access_filetime, modified_filetime) = 0 Then
            CloseHandle file_handle
            Exit Function
        End If
        '
        ' Close the file.
        If CloseHandle(file_handle) = 0 Then Exit Function
        '
        ' See if we should convert to the local file system time.
        If bConvertToLocalTime Then
            ' Convert to local file system time.
            FileTimeToLocalFileTime creation_filetime, file_time
            creation_filetime = file_time
            '
            FileTimeToLocalFileTime access_filetime, file_time
            access_filetime = file_time
            '
            FileTimeToLocalFileTime modified_filetime, file_time
            modified_filetime = file_time
        End If
        '
        ' Convert into dates.
        dtCreationDate = FileTimeToDate(creation_filetime)
        dtAccessDate = FileTimeToDate(access_filetime)
        dtModifiedDate = FileTimeToDate(modified_filetime)
        '
        GetFileTimes = True ' We succeeded.
    End Function
    
    Public Function FileSize(sFileSpec As String) As Long
        ' This will not work correctly for files over 2 gig.
        ' Also, if the file doesn't exist, it returns zero.
        Dim wfd As WIN32_FIND_DATA
        Dim h As Long
        Const INVALID_HANDLE_VALUE = -1
        '
        h = FindFirstFile(sFileSpec, wfd)
        If h = INVALID_HANDLE_VALUE Then Exit Function
        '
        FileSize = wfd.nFileSizeLow
    End Function
    
    Public Function FileCreatedDate(sFileSpec As String) As Date
        ' If the file doesn't exist, it returns zero (12/30/1899 midnight).
        Dim wfd As WIN32_FIND_DATA
        Dim h As Long
        Const INVALID_HANDLE_VALUE = -1
        '
        h = FindFirstFile(sFileSpec, wfd)
        If h = INVALID_HANDLE_VALUE Then Exit Function
        '
        FileCreatedDate = dFileTimeToDouble(wfd.ftCreationTime, True)
    End Function
    
    Public Function FileModifiedDate(sFileSpec As String) As Date
        ' If the file doesn't exist, it returns zero (12/30/1899 midnight).
        Dim wfd As WIN32_FIND_DATA
        Dim h As Long
        Const INVALID_HANDLE_VALUE = -1
        '
        h = FindFirstFile(sFileSpec, wfd)
        If h = INVALID_HANDLE_VALUE Then Exit Function
        '
        FileModifiedDate = dFileTimeToDouble(wfd.ftLastWriteTime, True)
    End Function
    
    Public Function FileAccessedDate(sFileSpec As String) As Date
        ' If the file doesn't exist, it returns zero (12/30/1899 midnight).
        Dim wfd As WIN32_FIND_DATA
        Dim h As Long
        Const INVALID_HANDLE_VALUE = -1
        '
        h = FindFirstFile(sFileSpec, wfd)
        If h = INVALID_HANDLE_VALUE Then Exit Function
        '
        FileAccessedDate = dFileTimeToDouble(wfd.ftLastAccessTime, True)
    End Function
    
    Private Function dFileTimeToDouble(ftUTC As FILETIME, Optional Localize As Boolean = False) As Double
       Dim FT As FILETIME
       Dim st As SYSTEMTIME
       Dim d As Double
       Dim t As Double
       ' Convert to local filetime, if necessary.
       If Localize Then
          FileTimeToLocalFileTime ftUTC, FT
       Else
          FT = ftUTC
       End If
       ' Convert to system time structure.
       FileTimeToSystemTime FT, st
       ' Convert to VB-style date (double).
       dFileTimeToDouble = DateSerial(st.wYear, st.wMonth, st.wDay) + TimeSerial(st.wHour, st.wMinute, st.wSecond)
    End Function
    
    Private Function FileTimeToDate(FT As FILETIME) As Date
        Dim stLocal As SYSTEMTIME
        Const ZERO_DATE As Date = 0!
        '
        If (FT.dwHighDateTime <> 0) And (FT.dwLowDateTime <> 0) Then
            FileTimeToSystemTime FT, stLocal
            FileTimeToDate = DateSerial(stLocal.wYear, stLocal.wMonth, stLocal.wDay) + TimeSerial(stLocal.wHour, stLocal.wMinute, stLocal.wSecond)
        Else
            FileTimeToDate = ZERO_DATE
        End If
    End Function
    
    Enjoy,
    Elroy
    Thank you I knew the name but I write them for better understanding of my question.
    Have you a Simpler Example? It is So big for me to understand and use. I'm so bad in programming
    However Thank you for your nice code!
    Last edited by Mahmood Khaleel Pira; Feb 16th, 2017 at 04:17 PM.

  4. #4
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,262

    Re: How to Show File Details in Label or textbox

    Geez Elroy. If you're going to get that complex you might as well show a FULL display...



    Actually I take that back, as doing this is less complex :P

    [VB6, Vista+] List all file properties, locale/unit formatted, by modern PROPERTYKEY


    Edit: If you just want to look up individual properties,
    Code:
    Public Declare Function PSGetPropertyKeyFromName Lib "propsys.dll" (ByVal pszName As Long, ppropkey As PROPERTYKEY) As Long
    Public Declare Function PSFormatPropertyValue Lib "propsys.dll" (ByVal pps As Long, ByVal ppd As Long, ByVal pdff As PROPDESC_FORMAT_FLAGS, ppszDisplay As Long) As Long
    Public Declare Function SHGetPropertyStoreFromParsingName Lib "shell32" (ByVal pszPath As Long, pbc As Any, ByVal Flags As GETPROPERTYSTOREFLAGS, riid As UUID, ppv As Any) As Long
    Public Declare Function PSGetPropertyDescription Lib "propsys.dll" (PropKey As PROPERTYKEY, riid As UUID, ppv As Any) As Long
    Public Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
    Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal PV As Long) ' Frees memory allocated by the shell
    
    Public Function GetPropertyDisplayString(szFile As String, szProp As String) As String
    'Gets the string value of the given canonical property; e.g. System.Company, System.Rating, etc
    'This would be the value displayed in Explorer if you added the column in details view
    Dim pkProp As PROPERTYKEY
    Dim pps As IPropertyStore
    Dim lpsz As Long
    Dim ppd As IPropertyDescription
    
    PSGetPropertyKeyFromName StrPtr(szProp), pkProp
    SHGetPropertyStoreFromParsingName StrPtr(szFile), ByVal 0&, GPS_DEFAULT Or GPS_BESTEFFORT Or GPS_OPENSLOWITEM, IID_IPropertyStore, pps
    PSGetPropertyDescription pkProp, IID_IPropertyDescription, ppd
    PSFormatPropertyValue ObjPtr(pps), ObjPtr(ppd), PDFF_DEFAULT, lpsz
    SysReAllocString VarPtr(GetPropertyDisplayString), lpsz
    CoTaskMemFree lpsz
    
    
    End Function
    (with oleexp.tlb/mIID.bas present)
    You use that function with the property name, e.g. szSize = GetPropertyDisplayString("C:\myfile.jpg", "System.Size") and it would return "100 KB" or whatever the size was, already formatted like Explorer. See: [VB6, Vista+] A compact function to retrieve any property by name, locally formatted

  5. #5

    Thread Starter
    Lively Member
    Join Date
    Aug 2016
    Posts
    101

    Re: How to Show File Details in Label or textbox

    Quote Originally Posted by fafalone View Post
    Geez Elroy. If you're going to get that complex you might as well show a FULL display...



    Actually I take that back, as doing this is less complex :P

    [VB6, Vista+] List all file properties, locale/unit formatted, by modern PROPERTYKEY


    Edit: If you just want to look up individual properties,
    Code:
    Public Declare Function PSGetPropertyKeyFromName Lib "propsys.dll" (ByVal pszName As Long, ppropkey As PROPERTYKEY) As Long
    Public Declare Function PSFormatPropertyValue Lib "propsys.dll" (ByVal pps As Long, ByVal ppd As Long, ByVal pdff As PROPDESC_FORMAT_FLAGS, ppszDisplay As Long) As Long
    Public Declare Function SHGetPropertyStoreFromParsingName Lib "shell32" (ByVal pszPath As Long, pbc As Any, ByVal Flags As GETPROPERTYSTOREFLAGS, riid As UUID, ppv As Any) As Long
    Public Declare Function PSGetPropertyDescription Lib "propsys.dll" (PropKey As PROPERTYKEY, riid As UUID, ppv As Any) As Long
    Public Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
    Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal PV As Long) ' Frees memory allocated by the shell
    
    Public Function GetPropertyDisplayString(szFile As String, szProp As String) As String
    'Gets the string value of the given canonical property; e.g. System.Company, System.Rating, etc
    'This would be the value displayed in Explorer if you added the column in details view
    Dim pkProp As PROPERTYKEY
    Dim pps As IPropertyStore
    Dim lpsz As Long
    Dim ppd As IPropertyDescription
    
    PSGetPropertyKeyFromName StrPtr(szProp), pkProp
    SHGetPropertyStoreFromParsingName StrPtr(szFile), ByVal 0&, GPS_DEFAULT Or GPS_BESTEFFORT Or GPS_OPENSLOWITEM, IID_IPropertyStore, pps
    PSGetPropertyDescription pkProp, IID_IPropertyDescription, ppd
    PSFormatPropertyValue ObjPtr(pps), ObjPtr(ppd), PDFF_DEFAULT, lpsz
    SysReAllocString VarPtr(GetPropertyDisplayString), lpsz
    CoTaskMemFree lpsz
    
    
    End Function
    (with oleexp.tlb/mIID.bas present)
    You use that function with the property name, e.g. szSize = GetPropertyDisplayString("C:\myfile.jpg", "System.Size") and it would return "100 KB" or whatever the size was, already formatted like Explorer. See: [VB6, Vista+] A compact function to retrieve any property by name, locally formatted

    Thank You dear fafalone it looks helpful

  6. #6
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    5,627

    Re: How to Show File Details in Label or textbox

    Hi fafalone,

    Yeah, I just pulled out what I had in my main application. I use those functions above to decide whether or not to update certain SxS OCX files that are packed into my executable.

    Thanks for providing a link to your more fleshed-out version of procedures that provide file properties.

    Best Regards,
    Elroy
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  7. #7
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,329

    Re: How to Show File Details in Label or textbox

    Here's another one which pulls out all the extended Props it can find,
    (working without API-Declares or TypeLibs):

    Code:
    Option Explicit
    
    Private Sub Form_Load()
      Debug.Print GetExtProps("c:\temp", "test.png")
    End Sub
    
    Public Function GetExtProps(Folder, File)
      Dim FF, FI, i, j, EP()
      Set FF = CreateObject("Shell.Application").NameSpace(Folder)
      For i = 0 To 8191
        If Len(FF.GetDetailsOf(FF, i)) = 0 Then ReDim EP(0 To i - 1): Exit For
      Next
      Set FI = FF.ParseName(File)
      For i = 0 To UBound(EP)
        EP(j) = Replace(Replace(Replace(FF.GetDetailsOf(FI, i), _
                ChrW(8206), ""), ChrW(8234), ""), ChrW(8236), "")
        If Len(EP(j)) Then EP(j) = FF.GetDetailsOf(FF, i) & ": " & EP(j): j = j + 1
      Next
      ReDim Preserve EP(j - 1)
      GetExtProps = Join(EP, vbCrLf)
    End Function
    Olaf

  8. #8
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,262

    Re: How to Show File Details in Label or textbox

    As the 2nd project in my post mentions, there's an even better way for individual properties;

    My typelib (oleexp) comes with a module called mPKEY.bas, it's got PROPERTYKEY's for all of the properties (there's hundreds), so you don't need to worry about figuring out technical names like System.Whatever, you can just browse through the list. ... if you use mPKEY:
    Code:
    Public Function GetPropertyKeyDisplayString(szFile As String, pkProp As PROPERTYKEY) As String
    Dim pps As IPropertyStore
    Dim lpsz As Long
    Dim ppd As IPropertyDescription
    
    SHGetPropertyStoreFromParsingName StrPtr(szFile), ByVal 0&, GPS_DEFAULT Or GPS_BESTEFFORT Or GPS_OPENSLOWITEM, IID_IPropertyStore, pps
    PSGetPropertyDescription pkProp, IID_IPropertyDescription, ppd
    PSFormatPropertyValue ObjPtr(pps), ObjPtr(ppd), PDFF_DEFAULT, lpsz
    SysReAllocString VarPtr(GetPropertyKeyDisplayString), lpsz
    CoTaskMemFree lpsz
    End Function
    Depending on what control you're displaying that in and how you're setting it, you probably want to strip out ChrW$(&H200E) and ChrW$(&H200F); they're formatting characters that will show as ? in non-unicode controls.

    If you're getting a fair number of properties from a large number of files, performance comes into play, and you might want to only open the property store once per file, here's a function I use to keep it to one call per file, that also removes those unneeded format characters (leave them in if you're supporting Unicode Right-To-Left languages):

    Code:
    Public Function GetPropertyKeyDisplayStringSet(szFile As String, pkProp() As PROPERTYKEY) As String()
    'Gets the string value of the given canonical property; e.g. System.Company, System.Rating, etc
    'This would be the value displayed in Explorer if you added the column in details view
    Dim pps As IPropertyStore
    Dim lpsz As Long
    Dim ppd As IPropertyDescription
    Dim arOut() As String
    Dim i As Long
    Dim sz As String
    
    ReDim arOut(UBound(pkProp))
    
    SHGetPropertyStoreFromParsingName StrPtr(szFile), ByVal 0&, GPS_DEFAULT Or GPS_BESTEFFORT Or GPS_OPENSLOWITEM, IID_IPropertyStore, pps
    For i = 0 To UBound(pkProp)
        PSGetPropertyDescription pkProp(i), IID_IPropertyDescription, ppd
        PSFormatPropertyValue ObjPtr(pps), ObjPtr(ppd), PDFF_DEFAULT, lpsz
        SysReAllocString VarPtr(sz), lpsz
        arOut(i) = Replace$(sz, ChrW$(&H200E), "")
        arOut(i) = Replace$(arOut(i), ChrW$(&H200F), "")
        CoTaskMemFree lpsz
    Next i
    GetPropertyKeyDisplayStringSet = arOut
    End Function
    Called like:
    Code:
    Dim pkys() As PROPERTYKEY
    ReDim pkys(3)
    Dim fProps() As String
    pkys(0) = PKEY_FileName
    pkys(1) = PKEY_DateModified
    pkys(2) = PKEY_Image_HorizontalSize
    pkys(3) = PKEY_Image_VerticalSize
    fProps = GetPropertyKeyDisplayStringSet("C:\temp2\64.png", pkys)
    txtName.Text = fProps(0)
    txtModified.Text = fProps(1)
    txtWidth.Text = fProps(2)
    txtHeight.Text = fProps(3)

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width