Option Explicit

Function Complete_path(ByRef Path As String)
 If Right$(Path, 1) <> "\" Then Path = Path & "\"
End Function


'returns the deepest folder name of a path string
'if the path is a file path it returns the file name
Function Lastdir(Path As String) As String
Dim contador As Long

Lastdir = Path
If (Right$(Lastdir, 1) = "\") Then
  Lastdir = Left$(Lastdir, Len(Lastdir) - 1)
End If

contador = 0
contador = InStrRev(Lastdir, "\", Len(Lastdir), vbBinaryCompare)

If contador > 0 Then
    Lastdir = Right$(Lastdir, Len(Lastdir) - contador)
Else
    Lastdir = ""
End If
End Function

'returns the file extension
Function Extension(sName As String) As String
Dim Posicio As Integer
Posicio = InStrRev(sName, ".", Len(sName), vbBinaryCompare)
If Posicio > 0 Then
  Extension = Right$(sName, Len(sName) - (Posicio - 1))
Else
  Extension = ""
End If
End Function

'returns the file name without extension of a given file path or file name
Function Strip_extension(sRuta As String) As String
Strip_extension = Lastdir(sRuta)
Strip_extension = Left$(Strip_extension, Len(Strip_extension) - Len(Extension(Strip_extension)))
End Function


Public Function nextdir(Dirlist As DirListBox, ByVal sRoot As String, Optional sPath As String = "") As String
Dim lc As Long

Dim DirAnt As String 'directori anterior
Dim Ultim As Boolean 'indica si el directori es el ultim d'un subdirectori explorat
Dim Found As Boolean 'indica si s'ha trobat el nou directori de la llista
Dim Root As Boolean  'indica si es el directori arrel

If sPath <> "" Then
    Dirlist.Path = sPath
End If

If Len(sRoot) > 3 Then
    If Right(sRoot, 1) = "\" Then
        sRoot = Left(sRoot, Len(sRoot) - 1)
    End If
Else
    If Right(sRoot, 1) <> "\" Then
        sRoot = sRoot & "\"
    End If
End If


Ultim = False
Root = False
   
    If Not Dirlist.ListCount = 0 Then 'more folders inside
        Dirlist.Path = Dirlist.List(0)
    Else                           'no more folders inside
        Do
          DirAnt = Dirlist.Path
          If StrComp(sRoot, DirAnt, vbTextCompare) <> 0 Then
            Found = False
            Ultim = False
            'go back one level
            If Dirlist.List(-2) <> "" Then
              Dirlist.Path = Dirlist.List(-2)
              lc = 0
              'search for the next dir in the same level in alphab. order
              While lc < Dirlist.ListCount And Found = False
                If StrComp(Dirlist.List(lc), DirAnt, vbTextCompare) = 0 Then
                    'check if it was the last folder in this level
                    If Dirlist.ListCount > lc + 1 Then
                      Dirlist.Path = Dirlist.List(lc + 1)
                    Else
                      Ultim = True
                    End If
                    Found = True
                End If
                lc = lc + 1
              Wend
            End If
          Else
            Root = True 'is root folder
          End If
         
        Loop While Ultim = True And Root = False
    End If

nextdir = Dirlist.Path
End Function

Public Function prevdir(Dirlist As DirListBox, ByVal sRoot As String, Optional sPath As String = "") As String
Dim lc As Long

Dim DirAnt As String 'directori anterior
Dim Ultim As Boolean 'indica si el directori es el ultim d'un subdirectori explorat
Dim Found As Boolean 'indica si s'ha trobat el nou directori de la llista
Dim Root As Boolean  'indica si es el directori arrel
Dim Selectlast As Boolean 'flag to indicate select last folder untill the end

If sPath <> "" Then
    Dirlist.Path = sPath
End If

If Len(sRoot) > 3 Then
    If Right(sRoot, 1) = "\" Then
        sRoot = Left(sRoot, Len(sRoot) - 1)
    End If
Else
    If Right(sRoot, 1) <> "\" Then
        sRoot = sRoot & "\"
    End If
End If


Ultim = False
Root = False
Selectlast = False
   
   
    DirAnt = Dirlist.Path
    If StrComp(sRoot, DirAnt, vbTextCompare) <> 0 Then
      'go back one level
     If Dirlist.List(-2) <> "" Then
      Dirlist.Path = Dirlist.List(-2)
     
      'if there is more dirs than the one in this level
      If Dirlist.ListCount > 1 Then
        lc = Dirlist.ListCount - 1
        Found = False
        Ultim = False
        'search for the prev dir in the same level in alphab. order
        While lc >= 0 And Found = False
            If StrComp(Dirlist.List(lc), DirAnt, vbTextCompare) = 0 Then
            'check if it was the first folder in this level
                If lc <> 0 Then
                    Dirlist.Path = Dirlist.List(lc - 1)
                    'select last folder untill the end
                    Selectlast = True
                Else
                    Ultim = True
                End If
                    Found = True
            End If
            lc = lc - 1
        Wend
      Else
        'do nothing we are in previous folder
      End If
     Else
        Selectlast = True
     End If
    Else
    'select last folder untill the end
        Selectlast = True
    End If
   
    If Selectlast Then
        While (Dirlist.ListCount > 0)
            Dirlist.Path = Dirlist.List(Dirlist.ListCount - 1)
        Wend
    End If

prevdir = Dirlist.Path
End Function

Option Explicit

Implements Runnable

Public sPattern As String
Public sRoot As String
Public Canceled As Boolean

Private pInitdir As String
Private pFoward As Boolean

Private dirLb As DirListBox
Private fileLb As FileListBox
Private frm As frmBrowser

Public Pathchanged As Boolean
Public Newdir As String

Public Event Status(dir As String, ByRef Cancel As Boolean)
Public Event finished()

Public Cancel As Boolean


Public Function startSearch(Initdir As String, foward As Boolean, Optional filetypes As String = "")

            If filetypes <> "" Then
                sPattern = filetypes
            End If
           
            pInitdir = Initdir
            Complete_path pInitdir
           
            Complete_path sRoot
           
            pFoward = foward
           
            Pathchanged = False
            Canceled = False
           
            Cancel = False
           
            mStart.Start Me
   
End Function


Sub nextFolder()
Dim originalPath As String
Dim newPath As String
'Dim Cancel As Boolean


    originalPath = pInitdir
    dirLb.Path = originalPath
    fileLb.Pattern = sPattern
   
    Do
        If pFoward = True Then
            nextdir dirLb, sRoot
        Else
            prevdir dirLb, sRoot
        End If
       
        newPath = dirLb.Path
        Complete_path newPath
        fileLb.Path = newPath
        RaiseEvent Status(newPath, Cancel)
    Loop While fileLb.ListCount = 0 And newPath <> originalPath And Cancel = False
   
    If Cancel = False Then
        If newPath <> originalPath Then
            Pathchanged = True
        End If
   
        Newdir = newPath
    Else
        Canceled = True
    End If
   
    RaiseEvent finished
End Sub


Private Sub Class_Initialize()
    Set frm = New frmBrowser
    Set dirLb = frm.Dir1
    Set fileLb = frm.File1
    Load frm
End Sub

Private Sub Class_Terminate()
    Set dirLb = Nothing
    Set fileLb = Nothing
    Unload frm
    Set frm = Nothing
End Sub

Private Sub Runnable_Start()
    nextFolder
End Sub

Attribute VB_Name = "mFiles"
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Private Const MAX_PATH = 255

Public Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Public 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

Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800

Public Type fileType
  isDirectory As Boolean
  Path As String
  Name As String
  Alternate As String
  Attributes As Long
  CreationTime As FILETIME
  LastAccessTime As FILETIME
  LastWriteTime As FILETIME
  Size As Currency
End Type
Public files() As fileType

Public Sub rdir(Path As String, subPath As String)

  Dim i As Long
  Dim search As Long
  Dim ret As Long
  Dim dirName As String
  Dim subPathExt As String
  Dim file As WIN32_FIND_DATA

  If subPath = "" Then
    ReDim files(0)
  Else
    subPathExt = Mid(subPath, 2) & "\"
  End If

  search = FindFirstFile(Path & subPath & "\*.*", file)
  ret = search
  Do While ret > 0
    If file.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
      dirName = Left(file.cFileName, InStr(1, file.cFileName, Chr(0)) - 1)
      If dirName <> "." And dirName <> ".." Then
        i = UBound(files) + 1
        ReDim Preserve files(i)
        With files(i)
          .isDirectory = True
          .Attributes = file.dwFileAttributes
          .CreationTime = file.ftCreationTime
          .LastAccessTime = file.ftLastAccessTime
          .LastWriteTime = file.ftLastWriteTime
          .Size = file.nFileSizeHigh * (2 ^ 32) + file.nFileSizeLow
          .Path = subPathExt
          .Name = dirName
          .Alternate = Left(file.cAlternate, InStr(1, file.cAlternate, Chr(0)) - 1)
        End With
        rdir Path, subPath & "\" & dirName
      End If
    End If
    ret = FindNextFile(search, file)
  Loop

  search = FindFirstFile(Path & subPath & "\*.*", file)
  ret = search
  Do While ret > 0
    If Not file.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
      i = UBound(files) + 1
      ReDim Preserve files(i)
      With files(i)
        .isDirectory = False
        .Attributes = file.dwFileAttributes
        .CreationTime = file.ftCreationTime
        .LastAccessTime = file.ftLastAccessTime
        .LastWriteTime = file.ftLastWriteTime
        .Size = file.nFileSizeHigh * (2 ^ 32) + file.nFileSizeLow
        .Path = subPathExt
        .Name = Left(file.cFileName, InStr(1, file.cFileName, Chr(0)) - 1)
        .Alternate = Left(file.cAlternate, InStr(1, file.cAlternate, Chr(0)) - 1)
      End With
    End If
    ret = FindNextFile(search, file)
  Loop
 
End Sub

Public Function edir(Path As String) As Long

  Dim i As Long
  ReDim files(0)

  Dim file As WIN32_FIND_DATA
  Dim search As Long
  Dim ret As Long

  i = 0

  search = FindFirstFile(Path, file)
  ret = search
  Do While ret > 0
    If file.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
      i = i + 1
      ReDim Preserve files(i)
      With files(i)
        .isDirectory = True
        .Attributes = file.dwFileAttributes
        .CreationTime = file.ftCreationTime
        .LastAccessTime = file.ftLastAccessTime
        .LastWriteTime = file.ftLastWriteTime
        .Size = file.nFileSizeHigh * (2 ^ 32) + file.nFileSizeLow
        .Name = Left(file.cFileName, InStr(1, file.cFileName, Chr(0)) - 1)
        .Alternate = Left(file.cAlternate, InStr(1, file.cAlternate, Chr(0)) - 1)
      End With
    End If
    ret = FindNextFile(search, file)
  Loop

  search = FindFirstFile(Path, file)
  ret = search
  Do While ret > 0
    If Not file.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
      i = i + 1
      ReDim Preserve files(i)
      With files(i)
        .isDirectory = False
        .Attributes = file.dwFileAttributes
        .CreationTime = file.ftCreationTime
        .LastAccessTime = file.ftLastAccessTime
        .LastWriteTime = file.ftLastWriteTime
        .Size = file.nFileSizeHigh * (2 ^ 32) + file.nFileSizeLow
        .Name = Left(file.cFileName, InStr(1, file.cFileName, Chr(0)) - 1)
        .Alternate = Left(file.cAlternate, InStr(1, file.cAlternate, Chr(0)) - 1)
      End With
    End If
    ret = FindNextFile(search, file)
  Loop
 
  edir = i

End Function

musicExtensions ogg mp3 wma ac3 mp4 m4a

http://forums.fluxmedia.net/plugin-development/4467-park-distance-control-plugin.html

http://www.mp3car.com/vbulletin/rr-released-plugins/122393-rrpdc-roadrunner-park-distance-control-extension-plugin.html

http://www.mp3car.com/vbulletin/hardware-development/121995-custom-usb-parking-sensor-interface-formally-pdc-usb.html

http://www.solocarputer.com/phpbb2/viewtopic.php?t=15247&postdays=0&postorder=asc&start=0