Option Explicit

Private Const ERROR_SUCCESS As Long = 0
Private Const OF_SHARE_DENY_WRITE As Long = &H20
Private Const MAXDWORD As Long = &HFFFFFFFF
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE As Long = -1

'Flags for AVIFILEINFO dwFlags
Private Const AVIFILEINFO_HASINDEX As Long = &H10
Private Const AVIFILEINFO_MUSTUSEINDEX As Long = &H20
Private Const AVIFILEINFO_ISINTERLEAVED As Long = &H100
Private Const AVIFILEINFO_WASCAPTUREFILE As Long = &H10000
Private Const AVIFILEINFO_COPYRIGHTED As Long = &H20000

'Flags for AVIFILEINFO dwCaps
Private Const AVIFILECAPS_CANREAD As Long = &H1
Private Const AVIFILECAPS_CANWRITE As Long = &H2
Private Const AVIFILECAPS_ALLKEYFRAMES As Long = &H10
Private Const AVIFILECAPS_NOCOMPRESSION As Long = &H20

'for BROWSEINFO
Private Const BIF_RETURNONLYFSDIRS As Long = &H1

Private Type AVIFILEINFO
  dwMaxBytesPerSec As Long
  dwFlags As Long
  dwCaps As Long
  dwStreams As Long
  dwSuggestedBufferSize As Long
  dwWidth As Long
  dwHeight As Long
  dwScale As Long
  dwRate As Long
  dwLength As Long
  dwEditCount As Long
  szFileType As String * 64
End Type

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 * MAX_PATH
   cAlternate As String * 14
End Type

Private Type BROWSEINFO
   hOwner           As Long
   pidlRoot         As Long
   pszDisplayName   As String
   lpszTitle        As String
   ulFlags          As Long
   lpfn             As Long
   lParam           As Long
   iImage           As Long
End Type

'my type for passing file
'info to the search routines
Private Type FILE_PARAMS
   bRecurse As Boolean
   bList As Boolean
   fAttributes As Long
   sFileRoot As String
   sFileNameExt As String
   nFileCount As Long
   nFileSize As Double
End Type

Private Declare Function AVIFileOpen Lib "avifil32" _
   Alias "AVIFileOpenA" _
  (ppfile As Long, _
   ByVal szFile As String, _
   ByVal mode As Long, _
   pclsidHandler As Any) As Long

Private Declare Function AVIFileRelease Lib "avifil32" _
  (ByVal pfile As Long) As Long

Private Declare Function AVIGetFileInfo Lib "avifil32" _
   Alias "AVIFileInfoA" _
  (ByVal pfile As Long, _
   pfi As AVIFILEINFO, _
   ByVal lSize As Long) As Long
   
Private Declare Sub AVIFileInit Lib "avifil32" ()
Private Declare Sub AVIFileExit Lib "avifil32" ()
   
Private Declare Function FindClose Lib "kernel32" _
  (ByVal hFindFile 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 FindNextFile Lib "kernel32" _
   Alias "FindNextFileA" _
  (ByVal hFindFile As Long, _
   lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function SHBrowseForFolder Lib "shell32" _
   Alias "SHBrowseForFolderA" _
  (lpBrowseInfo As BROWSEINFO) As Long
  
Private Declare Function SHGetPathFromIDList Lib "shell32" _
   Alias "SHGetPathFromIDListA" _
  (ByVal pidl As Long, _
   ByVal pszPath As String) As Long

Private Declare Sub CoTaskMemFree Lib "ole32" _
  (ByVal pv As Long)


Private Function Browse() As String

  'show the Browse for Folders Dialog
   Dim pidl As Long
   Dim BI As BROWSEINFO
   Dim sPath As String
   Dim pos As Integer
  
  'Fill BROWSEINFO structure data
   With BI
      .hOwner = Me.hWnd
      .pidlRoot = 0&
      .lpszTitle = "Select a folder containing AVI files."
      .ulFlags = BIF_RETURNONLYFSDIRS
   End With
  
  'show dialog returning pidl to selected item
   pidl = SHBrowseForFolder(BI)
 
  'if pidl is valid, parse & return the user's selection
   sPath = Space$(MAX_PATH)
    
   If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then
   
     'SHGetPathFromIDList returns the absolute
     'path to the selected item. No path is
     'returned for virtual folders.
      pos = InStr(sPath, Chr$(0))
      If pos Then Browse = Left(sPath, pos - 1)
      
     'free the pidl
      Call CoTaskMemFree(pidl)
   
   End If

End Function


Private Function GetAVIFileInfo(sAVIFile As String) As AVIFILEINFO

  'if a valid file, return the
  'AVIFILEINFO structure
   Dim hAvi As Long
   Dim AFI As AVIFILEINFO

   AVIFileInit

   If AVIFileOpen(hAvi, _
                  sAVIFile, _
                  OF_SHARE_DENY_WRITE, _
                  ByVal 0&) = ERROR_SUCCESS Then
      
      If AVIGetFileInfo(hAvi, AFI, Len(AFI)) = ERROR_SUCCESS Then
      
         GetAVIFileInfo = AFI 
         Call AVIFileRelease(hAvi)
      
      Else 'error occurred
      End If
   
   Else 'error occurred
   End If

   AVIFileExit

End Function

Private Function GetFileSizeStr(fsize As Long) As String

  'return the file size passed as a formatted string
   GetFileSizeStr = Format$((fsize), "###,###,###")   '& " kb"
  
End Function

Private Sub Command1_Click()

   Dim sPath As String
   
  'get the user's selection
   sPath = Browse()
   
  'add the fully qualified path to
  'the chosen folder to Text1
   If Len(sPath) > 0 Then
      Text1.Text = QualifyPath(sPath)
   End If
   
  'check if the selected folder
  'contains AVI files. If it does,
  'enable the Get Info button.
   Command2.Enabled = FileExists(Text1.Text & "*.avi")
   
End Sub


Public Function FileExists(sSource As String) As Boolean

   Dim WFD As WIN32_FIND_DATA
   Dim hFile As Long
   
   hFile = FindFirstFile(sSource, WFD)
   FileExists = hFile <> INVALID_HANDLE_VALUE
   
   Call FindClose(hFile)
   
End Function


Private Sub Command2_Click()

   Dim FP As FILE_PARAMS
   
  'populate the file params UDT and
  'call the file search routine  

   If Len(Text1.Text) > 0 Then
      
      With FP
         .sFileRoot = Text1.Text  'path to files
         .sFileNameExt = "*.avi"  'the AVI extension
      End With
   
      Call GoodGetFilesInfo(FP)
   
   End If

End Sub


Public Function TrimNull(startstr As String) As String

  'strip any trailing null from the string passed
   Dim pos As Integer
   
   pos = InStr(startstr, Chr$(0))
   
   If pos Then
      TrimNull = Left$(startstr, pos - 1)
      Exit Function
   End If
  
  'if this far there was no null,
  'so return the original string
   TrimNull = startstr
  
End Function


Private Function GoodGetFilesInfo(FP As FILE_PARAMS) As Long

  'local working variables
   Dim WFD As WIN32_FIND_DATA
   Dim AVI As AVIFILEINFO
   Dim itmX As ListItem
   Dim hFile As Long
   Dim sPath As String
   Dim sRoot As String
   Dim sTmp As String
   
  'set up working vars, used below
   sRoot = QualifyPath(FP.sFileRoot)
   sPath = sRoot & FP.sFileNameExt
   
  'get handle to first file matching the filespec
   hFile = FindFirstFile(sPath, WFD)
   
   If hFile <> INVALID_HANDLE_VALUE Then

      Do
            
        'the file name
         sTmp = TrimNull(WFD.cFileName)
         
        'get the file info
         AVI = GetAVIFileInfo(sRoot & sTmp)
         
        'add to the listview
         Set itmX = ListView1.ListItems.Add(, , sTmp)
         itmX.SubItems(1) = GetFileSizeStr((WFD.nFileSizeHigh * (MAXDWORD + 1)) + WFD.nFileSizeLow)
         itmX.SubItems(2) = AVI.dwHeight
         itmX.SubItems(3) = AVI.dwWidth
         itmX.SubItems(4) = AVI.dwRate \ AVI.dwScale
         itmX.SubItems(5) = IIf(AVI.dwFlags And AVIFILEINFO_ISINTERLEAVED, "Yes", "No")
         itmX.SubItems(6) = IIf(AVI.dwFlags And AVIFILEINFO_COPYRIGHTED, "Yes", "No")
            
      Loop While FindNextFile(hFile, WFD)
      
      hFile = FindClose(hFile)
   
   End If
   
End Function


Private Function QualifyPath(sPath As String) As String

  'return a fully-qualified path
   If Right$(sPath, 1) <> "\" Then
      QualifyPath = sPath & "\"
   Else
      QualifyPath = sPath
   End If
      
End Function


Private Sub Form_DblClick()

  'for debugging - shows the area obscured
  'by the picture box border. This toggles
  'between a borderstyle of 0 and 1.
   Picture1.BorderStyle = Abs(Picture1.BorderStyle = 0)
   
End Sub


Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

  'toggle the sort order based on the column clicked
   ListView1.SortKey = ColumnHeader.Index - 1
   ListView1.SortOrder = Abs(ListView1.SortOrder = 0)
   ListView1.Sorted = True
   
End Sub


Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)

   If Len(Item.Text) <> 0 Then
   
     'adjust the animation control
     'and size the pixbox to accommodate
     'the animation size. In the expression
     'below, 4 is added to each dimension
     'of the pixbox to accommodate the space
     'taken by the pixbox border.
      With Animation1
      
         .Close
         .Left = 0
         .Top = 0
         
         .AutoPlay = True
         .Open Text1.Text & Item.Text
         
          With Picture1
            .Width = CLng((Item.SubItems(3) + 4) * Screen.TwipsPerPixelX)
            .Height = CLng((Item.SubItems(2) + 4) * Screen.TwipsPerPixelY)
          End With
      
      End With
   
   End If
End Sub