Модераторы: Akina
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Возвратить Случайную папку 
:(
    Опции темы
DenageS
Дата 18.10.2006, 17:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 81
Регистрация: 29.9.2006

Репутация: нет
Всего: нет
Помогите как можно возвратить случайную папку (существующую) на любом из дисков компа.
PM MAIL ICQ   Вверх
Akina
Дата 18.10.2006, 18:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Советчик
****


Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 34
Всего: 454
Получить список всех папок (как обычно, рекурсивным поиском). Подсчитать количество. Сгенерить случайное число в полученном диапазоне целых. Выдать соотв. папку из списка.


--------------------
 О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.
PM MAIL WWW ICQ Jabber   Вверх
JUmPER
Дата 19.10.2006, 08:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 196
Регистрация: 22.8.2006

Репутация: 1
Всего: 3
а зачем это, если не секрет?
место локации трояна?
--------------------
Существует 10 типов людей: те, которые понимают двоичную систему, и те, которые ее не понимаютСуществует 10 типов людей: те, кто понимают троичную систему, те, кто ее не понимают и те, кто путает ее с двоичной
PM MAIL   Вверх
DenageS
Дата 19.10.2006, 17:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 81
Регистрация: 29.9.2006

Репутация: нет
Всего: нет
Цитата(Akina @ 18.10.2006,  18:14)
Получить список всех папок (как обычно, рекурсивным поиском). Подсчитать количество. Сгенерить случайное число в полученном диапазоне целых. Выдать соотв. папку из списка.

Можно пожалуйста поподробнее. "рекурсивным поиском"? Объясни.
До троянов мне далеко!
PM MAIL ICQ   Вверх
JUmPER
Дата 19.10.2006, 18:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 196
Регистрация: 22.8.2006

Репутация: 1
Всего: 3
получаем список дисков
для каждого диска:
   получаем список папок в корне
   для каждой папки из списка:
      получаем список папок в ней...
и т.д.

все папки в массив (например) и выбираем из него случайный элемент -- вот и случайная папка

PS: избегаем ссылок на верхние уровни (во избежание зацикливания)
--------------------
Существует 10 типов людей: те, которые понимают двоичную систему, и те, которые ее не понимаютСуществует 10 типов людей: те, кто понимают троичную систему, те, кто ее не понимают и те, кто путает ее с двоичной
PM MAIL   Вверх
DenageS
Дата 20.10.2006, 17:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 81
Регистрация: 29.9.2006

Репутация: нет
Всего: нет
А сами команды не найдутся? smile 
PM MAIL ICQ   Вверх
JUmPER
Дата 23.10.2006, 09:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 196
Регистрация: 22.8.2006

Репутация: 1
Всего: 3
держи код класса, который делает то, что тебе нужно
Код

' ==============================================
' Class CFolderProcessor
' codded by JUmPER
' ==============================================
Option Explicit

Private fso As New FileSystemObject
Private folders() As String
'

' конструктор класса
Public Sub init(Optional aRootPath As String = "")
    If (aRootPath = "") Then ' добавление всех папок со всех дисков (по умолчанию)
        Dim oDrives As Drives
        Dim cur_drive As Drive

        Set oDrives = fso.Drives
        For Each cur_drive In oDrives
            Call merge(folders, GetFolders(cur_drive.Path & "\"))
        Next
    Else ' добавление папок только внутри корневой
        folders = GetFolders(aRootPath)
    End If

    Randomize
End Sub

' случайная папка ;)
Public Function GetRandomFolder() As String
    Dim indx As Long

    indx = Round(rnd() * UBound(folders))

    GetRandomFolder = folders(indx)
End Function

' рекурсивная функция получения подпапок текущей папки (текущая тоже включается в результат)
Private Function GetFolders(aFolderPath As String) As String()
    Dim oFolder As folder
    Dim oFolders As folders
    Dim result() As String
    Dim cur_folder As folder
    Dim i As Long

    ' получение подпапок
    On Error GoTo L_ACCESS_DENIED
    Set oFolder = fso.GetFolder(aFolderPath)
    Set oFolders = oFolder.SubFolders
    ReDim result(oFolders.Count)
    On Error GoTo 0

    ' добавление текущих поддиректорий
    result(0) = aFolderPath
    i = 1
    For Each cur_folder In oFolders
        result(i) = cur_folder.Path
        i = i + 1
    Next

    ' рекурсивное добавление детей детей и т.д.
    For Each cur_folder In oFolders
        Call merge(result, GetFolders(cur_folder.Path))
    Next

    GetFolders = result

    Exit Function
L_ACCESS_DENIED: ' доступ к директории закрыт.
    Dim res() As String ' возвращаем пустой массив
    GetFolders = res
End Function

' добавление второго массива в первый
Private Sub merge(ByRef arr1, ByRef arr2)
    Dim i As Long
    Dim arr1_len As Long
    Dim arr2_len As Long

    If (isEmptyArray(arr2)) Then
        Exit Sub
    End If

    If (isEmptyArray(arr1)) Then
        arr1 = arr2
        Exit Sub
    Else
        arr1_len = UBound(arr1) + 1
    End If

    arr2_len = UBound(arr2) + 1

    ReDim Preserve arr1(arr1_len + arr2_len - 1)
    For i = 0 To arr2_len - 1
        If (IsObject(arr2(i))) Then
            Set arr1(i + arr1_len) = arr2(i)
        Else
            arr1(i + arr1_len) = arr2(i)
        End If
    Next
End Sub

' проверка массива на пустоту (во избежание исключительной ситуации при обращении к пустому массиву)
Private Function isEmptyArray(ByRef aArr) As Boolean
    On Error GoTo invalid

    Dim a As Integer
    a = UBound(aArr)
    isEmptyArray = (a < 0)
    Exit Function

invalid:
    isEmptyArray = True
End Function

пример использования:
Код

Private rnd As New CFolderProcessor

Private Sub Form_Click()
    Call MsgBox(rnd.GetRandomFolder)
End Sub

Private Sub Form_Load()
    Call rnd.init
End Sub


не забудь добавить к проекту Microsoft Scripting Runtime

Это сообщение отредактировал(а) JUmPER - 23.10.2006, 10:58
--------------------
Существует 10 типов людей: те, которые понимают двоичную систему, и те, которые ее не понимаютСуществует 10 типов людей: те, кто понимают троичную систему, те, кто ее не понимают и те, кто путает ее с двоичной
PM MAIL   Вверх
DenageS
Дата 23.10.2006, 10:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 81
Регистрация: 29.9.2006

Репутация: нет
Всего: нет
JUmPER, я вставляю этот код в модуль. На CFolderProcessor ругается "пределяемый пользователем тип не определен".
При попытке вызова msgbox GetRandomFolder, "нижний идекс вне диапазона" 
Я наверное что-то делаю не так? smile 
PM MAIL ICQ   Вверх
JUmPER
Дата 23.10.2006, 10:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 196
Регистрация: 22.8.2006

Репутация: 1
Всего: 3
создаёшь в проекте новый класс с именем CFolderProcessor smile 
и добавляешь в него код

Это сообщение отредактировал(а) JUmPER - 23.10.2006, 10:56
--------------------
Существует 10 типов людей: те, которые понимают двоичную систему, и те, которые ее не понимаютСуществует 10 типов людей: те, кто понимают троичную систему, те, кто ее не понимают и те, кто путает ее с двоичной
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "VB6"
Akina

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по VB обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • Используйте теги [code=vb][/code] для подсветки кода. Используйтe чекбокс "транслит" (возле кнопок кодов) если у Вас нет русских шрифтов.

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Akina.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | VB6 | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0504 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.