Структура папок... как сделать?

[Dex]

Мне нужно получить полную структуру папок и занести это в ListBox.Я пытался написать код для создание стуктуры папок через DirListBox и FileListBox c помощью циклов но ничего не выходит, я запутываюсь. И начиная понимать как это сложно " чуть ли не вешуюсь" Помогите!!!Help!!!

[GSerg]

Рекурсия спасёт отца русской демократии?

[GM]

Вот так:

Код: Выделить всё

'На форме List1
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 FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Const MAX_PATH = 260
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
Function StripNulls(OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = OriginalStr
End Function

Function EnumDirs(path As String, Optional level As Long = 0)
Dim sName As String, sSpace As String
Dim hSearch  As Long, bIsDirectory As Boolean
Dim Cont As Integer
On Error GoTo exitfromhere


If Right(path, 1) <> "\" Then path = path & "\"
sSpace = String(level, ".")
    Dim WFD As WIN32_FIND_DATA
   
    Cont = True
    hSearch = FindFirstFile(path & "*", WFD)
If hSearch <> -1 Then
        Do While Cont
        sName = StripNulls(WFD.cFileName)
       
If sName <> "." And sName <> ".." Then
bIsDirectory = (GetAttr(path & sName) And vbDirectory) = vbDirectory
List1.AddItem (sSpace & IIf(bIsDirectory, "[" & sName & "]", sName))
If bIsDirectory Then EnumDirs path & sName, level + 1
End If
     
Cont = FindNextFile(hSearch, WFD)
       
        Loop
End If
        Cont = FindClose(hSearch)



exitfromhere:


End Function


[Dex]

Мне нужно не много не это в етой функции папки пишутся типа так:
..[windows], и файла добавляются, а мне нужно токо папки и типа такого плана:
С:\
C:\Windows
C:\Windows\System
...

[XairOn]

Тебе нужно получить дерево каталогов?

[Dex]

Ну типа да!?

[GM]

Ну типа да!?

Так бы и сразу сказал, а то сначала пришлось разделение и уровни делать.
А вообще-то нужно было всего-то несколько строчек изменить.

Код: Выделить всё

'На форме List1
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Const FILE_ATTRIBUTE_DIRECTORY = &H10

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 FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Const MAX_PATH = 260
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
Function StripNulls(OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = OriginalStr
End Function

Function EnumDirs(path As String)
Dim sName As String, sSpace As String
Dim hSearch  As Long, bIsDirectory As Boolean
Dim Cont As Integer
On Error GoTo exitfromhere
If Right(path, 1) <> "" Then path = path & ""
    Dim WFD As WIN32_FIND_DATA
    Cont = True
    hSearch = FindFirstFile(path & "*", WFD)
If hSearch <> -1 Then
        Do While Cont
       sName = StripNulls(WFD.cFileName)
       
If sName <> "." And sName <> ".." Then
If GetFileAttributes(path & sName) And FILE_ATTRIBUTE_DIRECTORY Then
List1.AddItem (path & sName)
EnumDirs path & sName
End If
End If
Cont = FindNextFile(hSearch, WFD)
       
        Loop
End If
        Cont = FindClose(hSearch)
exitfromhere:
End Function


З.Ы. Вот наконец-то и я научился делать рекурсии

[Dex]

GM вооще классно спасибо.А я сегодня пытался сделать сам через
Private Declare Function SHBrowseForFolder Lib "Shell32" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
ну и там ещё функцию писал, смог реализовать появление окошка а вот в ListBox занести хрен...

[Dex]

А как узнать существуют ли в указанной папки с указанным расширением и опять запихнуть ети файлы в ListBox

[XairOn]

А как узнать существуют ли в указанной папки с указанным расширением и опять запихнуть ети файлы в ListBox

Если FSO подойдет, то могу пример скинуть.

[Dex]

XairOn спасибо я всё смог реализовать cам.Я сделал проще, не через FSO, а с помощью FileListBox (не надо думать что я не умею пользоваться FSO)

[GM]

Через FileListBox - медленно, особенно если много файлов, но для простых случаев подойдет.

[Dex]

А как реализовать очистку корзины?

[xolod]

Код: Выделить всё

Const SHERB_NOCONFIRMATION = &H1
Const SHERB_NOPROGRESSUI = &H2
Const SHERB_NOSOUND = &H4
Private Type ULARGE_INTEGER
  LowPart As Long
  HighPart As Long
End Type
Private Type SHQUERYRBINFO
  cbSize As Long
  i64Size As ULARGE_INTEGER
  i64NumItems As ULARGE_INTEGER
End Type
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hwnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Private Declare Function SHUpdateRecycleBinIcon Lib "shell32.dll" () As Long
Private Declare Function SHQueryRecycleBin Lib "shell32.dll" Alias "SHQueryRecycleBinA" (ByVal pszRootPath As String, pSHQueryRBInfo As SHQUERYRBINFO) As Long
Private Sub Form_Load()
    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim RBinInfo As SHQUERYRBINFO, Msg As VbMsgBoxResult
    RBinInfo.cbSize = Len(RBinInfo)
    SHQueryRecycleBin vbNullString, RBinInfo
    If (RBinInfo.i64Size.LowPart And &H80000000) = &H80000000 Or RBinInfo.i64Size.HighPart > 0 Then
        Msg = MsgBox("Your Recycle Bin consumes over 2 gigabytes right now!" + vbCrLf + "Do you want to empty it?", vbYesNo + vbQuestion)
    Else
        Msg = MsgBox("Your Recycle Bin consumes" + Str$(RBinInfo.i64Size.LowPart) + " bytes right now." + vbCrLf + "Do you want to empty it?", vbYesNo + vbQuestion)
    End If
    If Msg = vbYes Then
        SHEmptyRecycleBin Me.hwnd, vbNullString, 0
        SHUpdateRecycleBinIcon
    End If
End Sub


[Dex]

xolod спасибо отлично работает!

[Dex]

Как в ListBox реализовать веделение элементов?

[A.A.Z.]

List1.Selected(Index) = True
Для выделения нескольких эл-тов необходимо MultiSelect = True

[Dex]

А как удалить в ListBox'е выделенные элементы?

[A.A.Z.]

Ну...

Код: Выделить всё

Dim I&
For I = 0 To List1.ListCount - 1
If List1.Selected(I) = True Then List1.RemoveItem I
Next

Например, так

[tyomitch]

AAZ, у тебя будет выход за последний элемент, потому что ListCount вычисляется только один раз - в начале цикла. Лучше так:

Код: Выделить всё

Dim I&
For I = List1.ListCount - 1 To 0 Step -1
    If List1.Selected(I) = True Then List1.RemoveItem I
Next

[A.A.Z.]

Да, точно, ты прав

[Dex]

А как узнать путь системной папки?

[XairOn]

А как узнать путь системной папки?

Вот так:

Код: Выделить всё

Environ("windir")

[Dex]

Дапустим у меня есть два файла:
C:\WINDOWS\Рабочий стол\File.fle
C:\WINDOWS\Рабочий стол\~File.fle
Подключаю FSO и обьявляю
Dim fso As New FileSystemObject
Далее пишу
fso.DeleteFile "C:\WINDOWS\Рабочий стол\File.fle"
fso.DeleteFile "C:\WINDOWS\Рабочий стол\~File.fle"
Так вот файл: File.fle удаляется, а вот: ~File.fle не удаляется и выдаёт ошибку.
Почему и что мне делать чтоб удалить етот файл?

[A.A.Z.]

~File.fle, наверное, имеет какие-нибудь аттрибуты - скрытый / только чтение...
Попробуй

Код: Выделить всё

FSO.DeleteFile "C:\Windows\Рабочий стол\~File.fle", True

[Dex]

Что File.fle, что ~File.fle имеют атрибуты архивные.Но строчка всё

Код: Выделить всё

FSO.DeleteFile "C:\Windows\Рабочий стол\~File.fle", True

всё равно не помогает. Мозет каким другим способом мозно удалить?

[A.A.Z.]

А не через прогу файл удаляется? Может, он просто занят другой прогой?

[Dex]

Не... Мозет дело вот в етом ~?

[A.A.Z.]

Да вряд ли... А он просто не удаляет или ошибку какую пишет?
Попробуй

Код: Выделить всё

Kill "C:\Windows\Рабочий стол\~File.fle"

[Dex]

А Kill вооще ничего не удаляет. Fake!!!