• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 237
  • Last Modified:

Dir files to list box

I dont want to use Dir control.
I want to, given a pathname, push a command button that would fill a list box with the contents of that pathnames directory's only.  If the command is pushed again
the list box must be emptied and re-updated with the
then current directory names in that pathname.

Thanks Experts.





0
vern12
Asked:
vern12
  • 3
  • 3
1 Solution
 
dirtdartCommented:
Public Const MAX_PATH = 260

Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

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

Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Dim hFile As Long
Dim ret As Long
Dim wfd As WIN32_FIND_DATA
Dim sPath As String

If List1.ListCount > 0 Then List1.Clear 'Clear the list of any contents

sPath = Text1.Text 'Find the requested directory
If Right(sPath, 1) <> "\" Then sPath = sPath & "\*.*" 'Append it for pattern matching
   
hFile = FindFirstFile(sPath, wfd) 'Get the handle to the first matching file

If hFile <> 0 Then List1.AddItem wfd.cFileName 'If the handle is 0 then an error occurred

ret = 1

Do While ret <> 0 'When ret = 0 then there are no more matching filenames

ret = FindNextFile(hFile, wfd) 'Find the next matching file
If ret <> 0 Then List1.AddItem wfd.cFileName 'Add it to the list

Loop

End Sub

0
 
yowkeeCommented:
There is simpler way:

---
Private Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Const LB_DIR = &H18D
Private Const DDL_READWRITE = &H0
Private Const DDL_SYSTEM = &H4
Private Const DDL_ARCHIVE = &H20

Private Sub Command1_Click()
    FillList "C:\windows"     ' Fill listbox List1 with files in
                              ' C:\windows    
End Sub

Private Sub FillList(ByVal pstrDir As String)
    Dim sCurrPath As String
    sCurrPath = CurDir
    ChDir pstrDir        ' Change to the required directory
    List1.Clear
    SendMessageStr List1.hwnd, LB_DIR, _
                DDL_ARCHIVE Or DDL_READWRITE Or DDL_SYSTEM, _
                "*.*"
    ChDir sCurrPath      ' Change back to save directory
End Sub
0
 
vern12Author Commented:
Dirtdart, I could not get your example to work
no errors, just an empty list box.
 
Yowkee, Your example works, except I see no directorys only
files in the list box, I want only the directory and folder
names to appear in the box, if you have this solution
please post an answer.
0
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
yowkeeCommented:
vern12,

  If you only want directory under required path being show out, pass 'DDL_DIRECTORY Or DDL_EXCLUSIVE' to replace 'DDL_ARCHIVE Or DDL_READWRITE Or DDL_SYSTEM' at 3rd parameter of SendMessageStr.

---
Private Const DDL_DIRECTORY = &H10
Private Const DDL_EXCLUSIVE = &H8000
:
:   ' All as above
:
' change this line
    SendMessageStr List1.hwnd, LB_DIR, _
                DDL_DIRECTORY Or DDL_EXCLUSIVE, _
                "*"
:
:
-----

Regards.
 
0
 
vern12Author Commented:
The directory names look like [examp~1]
how can i get the full dir name: example , without []
0
 
yowkeeCommented:
vern12,

  The '[]' is added by sendmessage method by default. If you sure don't want the '[]' to be displayed, I would provide another example which do the same thing but with more codes. Here's the example with APIs FindFirstFile and FindNextFile:

--- ' I put following code in a BAS module
Public Const MAX_PATH = 260
 
'GetDriveType return values
Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_FIXED = 3
Public Const DRIVE_REMOTE = 4
Public Const DRIVE_CDROM = 5
Public Const DRIVE_RAMDISK = 6
Public Const LB_ADDSTRING = &H180

Type FILETIME
 dwLowDateTime As Long
 dwHighDateTime As Long
End Type

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 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

Public Declare Function FindClose _
  Lib "kernel32" (ByVal hFindFile As Long) As Long
 
Declare Function SendMessageStr Lib "user32" _
 Alias "SendMessageA" _
 (ByVal hwnd As Long, ByVal wMsg As Long, _
  ByVal wParam As Long, ByVal lParam As String) As Long
 
Public Function TrimNull(startstr As String) As String

  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 Chr$(0), so return the string
  TrimNull = startstr
 
End Function


Public Sub FillListWithFolders(lstView As ListBox, ByVal pstrPath As String)
 
    Dim WFD As WIN32_FIND_DATA
    Dim hFile As Long
   
    Dim sFile As String
     
    Dim i As Integer
    Dim r As Long
    Dim found As Integer
 
    'find the first file matching the parameter \*.*
    If Right$(pstrPath, 1) = "\" Then
        hFile = FindFirstFile(pstrPath & "*.*" & Chr$(0), WFD)
    Else
        hFile = FindFirstFile(pstrPath & "\*.*" & Chr$(0), WFD)
    End If

    If hFile - 1 Then
        sFile = TrimNull(WFD.cFileName)
        WFD.dwFileAttributes = vbDirectory

        While FindNextFile(hFile, WFD)
            sFile = TrimNull(WFD.cFileName)
            'ignore the 2 standard root entries
            If (sFile <> ".") And (sFile <> "..") Then
                 If (WFD.dwFileAttributes And vbDirectory) Then
                  SendMessageStr lstView.hwnd, LB_ADDSTRING, 0, _
                                 WFD.cFileName
                 End If
            End If
        Wend
    End If
 
    r = FindClose(hFile)
     
End Sub

--------- ' Code in Form module, which has one button and listbox

Private Sub Command1_Click()
    FillListWithFolders List1, "C:\windows"
End Sub

--------

Regards.
0
 
vern12Author Commented:
yeppee.
Thanks yowkee
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now