Solved

Dir files to list box

Posted on 1998-06-21
7
225 Views
Last Modified: 2009-07-29
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
Comment
Question by:vern12
  • 3
  • 3
7 Comments
 
LVL 5

Expert Comment

by:dirtdart
ID: 1463878
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
 
LVL 4

Expert Comment

by:yowkee
ID: 1463879
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
 

Author Comment

by:vern12
ID: 1463880
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: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 4

Accepted Solution

by:
yowkee earned 50 total points
ID: 1463881
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
 

Author Comment

by:vern12
ID: 1463882
The directory names look like [examp~1]
how can i get the full dir name: example , without []
0
 
LVL 4

Expert Comment

by:yowkee
ID: 1463883
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
 

Author Comment

by:vern12
ID: 1463884
yeppee.
Thanks yowkee
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

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

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

790 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question