VBNet - Форум - Выношу на суд.

Вопрос: Выношу на суд. Добавлено: 01.03.09 09:40

Автор вопроса: Smith | Web-сайт: Не хочу ломать голову, если её уже сломал кто-то другой. | ICQ: ненавижу

Прога получает командной строкой ListBox куда нужно отвечать, начальный путь поиска и ещё один пустой параметр обозначающий, что поиск нужно вести с DoEvent'ами.

Экзешник после упэикса получается 4,5кБ.

Option Explicit

Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Private FSO As New FileSystemObject
Private Slow As Boolean
Private hWnd As Long

Private Sub Main()
    Dim StartLn As Long
    Dim Start() As String

    Start = Split(Command, "/")
    StartLn = UBound(Start)
    If StartLn > 0 Then
        If IsNumeric(Start(0)) Then
            ChDir "\"
            Call SetPriorityClass(GetCurrentProcess, 256)
            hWnd = CLng(Start(0))
            Slow = StartLn = 2
            FindEmpty Start(1)
            SendMessage hWnd, 384, 0, "/" 'это сигнал об окончании работы
        End If
    End If
    End
End Sub

Private Sub FindEmpty(ByRef Path As String)
    Dim Size As Single
    Dim Fold As Object
    Dim Item As Object

On Error Resume Next
    Set Fold = FSO.GetFolder(Path)
    Size = Fold.Size
    If Err.Number > 0 Then Size = 1
    If Size > 0 Then
        If Slow Then DoEvents
        For Each Item In Fold.SubFolders
            FindEmpty (Path & "\" & Item.Name)
        Next
    Else
        SendMessage hWnd, 384, 0, Path
    End If
End Sub

Господа, есть соображения, что можно сделать, чтоб улучшить характеристики?
Ответить

Ответы Всего ответов: 61

Номер ответа: 1 Автор ответа: Smith ICQ: adamis@list.ru Вопросов: 153 Ответов: 3632	Профиль \| \| #1	Добавлено: 01.03.09 10:04
	Даже в таком виде меньше не становится, без приоритета может стать медленнее Option Explicit Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long Private FSO As New FileSystemObject Private Slow As Boolean Private hWnd As Long Private Sub Main() Dim Start() As String Start = Split(Command, "/" ChDir "\" hWnd = CLng(Start(0)) Slow = UBound(Start) = 2 FindEmpty Start(1) SendMessage hWnd, 384, 0, "/" End Sub Private Sub FindEmpty(ByRef Path As String) Dim Size As Single Dim Fold As Object Dim Item As Object On Error Resume Next Set Fold = FSO.GetFolder(Path) Size = Fold.Size If Err.Number > 0 Then Size = 1 If Size > 0 Then If Slow Then DoEvents For Each Item In Fold.SubFolders FindEmpty (Path & "\" & Item.Name) Next Else SendMessage hWnd, 384, 0, Path End If End Sub Ответить

Номер ответа: 2 Автор ответа: Smith ICQ: adamis@list.ru Вопросов: 153 Ответов: 3632	Профиль \| \| #2	Добавлено: 01.03.09 15:05
	Код вроде упростил, но размер экзешника остался прежним Option Explicit Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long Private Declare Function GetCurrentProcess Lib "kernel32" () As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long Private hWnd As Long Private mFSO As Object Private Ar() As String Private Slow As Boolean Private Sub Main() On Error Resume Next ChDir "\" Ar = Split(Command, "/") Set mFSO = CreateObject("Scripting.FileSystemObject") Call SetPriorityClass(GetCurrentProcess, 256) Slow = UBound(Ar) = 2 hWnd = CLng(Ar(0)) FindEmpty Ar(1) SendMessage hWnd, 384, 0, "/" End Sub Private Sub FindEmpty(ByRef Path As String) Dim Fold As Object Dim Item As Object On Error Resume Next Set Fold = mFSO.GetFolder(Path) If Fold.Size > 0 Or Err.Number > 0 Then If Slow Then DoEvents For Each Item In Fold.SubFolders FindEmpty (Path & "\" & Item.Name) Next Else: SendMessage hWnd, 384, 0, Path End If End Sub Ответить

Номер ответа: 3 Автор ответа: Artyom Разработчик Вопросов: 130 Ответов: 6602	Профиль \| \| #3	Добавлено: 01.03.09 21:44
	Можно, так сказать, в двух словах, что данное делает? А то не совсем понятно... Ответить

Номер ответа: 4 Автор ответа: Smith ICQ: adamis@list.ru Вопросов: 153 Ответов: 3632	Профиль \| \| #4	Добавлено: 01.03.09 22:57
	Steel Brand это на VB6, тебе интересно? Прога получает командной строкой ListBox куда нужно отвечать, начальный путь поиска и ещё один пустой параметр обозначающий, что поиск нужно вести с DoEvent'ами. Экзешник после упэикса получается 4,5кБ. Его я сую в ресурс основной проги, прога ищет пустые папки. Ответить

Номер ответа: 5 Автор ответа: Smith ICQ: adamis@list.ru Вопросов: 153 Ответов: 3632	Профиль \| \| #5	Добавлено: 01.03.09 22:58
	Это в принципе в самом верху вопроса написано. Ответить

Номер ответа: 6 Автор ответа: EROS Вопросов: 58 Ответов: 4255	Профиль \| \| #6	Добавлено: 01.03.09 23:14
	серьезный такой программный продукт.. Ответить

Номер ответа: 7 Автор ответа: Smith ICQ: adamis@list.ru Вопросов: 153 Ответов: 3632	Профиль \| \| #7	Добавлено: 02.03.09 00:58
	) Серьезный это мягко сказано! Просто гениальный! ЗЫ пинайте пинайте, оно для того и сделано Ответить

Номер ответа: 8 Автор ответа: EROS Вопросов: 58 Ответов: 4255	Профиль \| \| #8	Добавлено: 02.03.09 04:57
	пинайте пинайте, оно для того и сделано Ну зачем же пинать.. чтож ты о нас такого плохого мнения? Почему такое предвзятое отношение? Ты мне лучше вот что скажи.. Для чего все эти танцы с бубнами? Почему ты не включил этот модуль в основную программу а добавил в ресурсы? Затем ты ее извлекаешь из ресурсов, сохраняешь на винт, запускаешь процесс с параметрами, даешь ему максимальный приоритет и уже тот заполняет список в основной проге через сообщения. К чему все это??? Если только это не попытка эмуляции "многопоточности" чтоб основная софтина не висела во время сканирования папок.. Сдается мне, что она подвисает изрядно если ей задать корень диска в качестве рута.. и если это так, то повышенный приоритет в данном случае это не более, чем костыль.. И тормоза твои тут скорее всего не из за приоритета, а из-за FSO (имхо).. более того, ты на каждой итерации цикла получаешь размер папки со всем содержимым, что собственно тоже будет изрядно тормозить.. Вот представь, у тебя есть папка.. а ней 5 уровней вложенности.. на первом шаге ты получишь размер всех уровней, на втором размер 4 уровней и т.д.. и в результате ты 5 раз получишь размер одной и той же папки(последней).. и это при условии, что там вложено по 1 папке! А если там, скажем, по 10 папок, что тогда? То то же... смысл в том, что чем больше уровней вложенности, тем больше раз ты будешь получать размер одних и тех же папок и файлов.. а получение размера - это тоже время и,соответственно, тоже рекурсия! Вот,собственно, и все твои тормоза. Это была критика.. теперь предложение.. Сразу оговорюсь: все, что будет сказано ниже - мое имхо. Тебе следует отказаться от FSO, и реализовать все на API (Примеров перебора файлов в сети на апи - туча!) При этом не получать размер папки, а просто узнать,есть ли в ней хоть 1 файл или папка или нет.. если есть, то дальше сканить смысла нету(значит она не пустая) и переходить на следующий уровень вложенности. Разумеется, это увеличит немного размер проги, но выигрыш в скорости будет чудовищный.. и не надо будет никаких завышенных приоритетов и отдельных процессов. Ответить

Номер ответа: 9 Автор ответа: Smith ICQ: adamis@list.ru Вопросов: 153 Ответов: 3632	Профиль \| \| #9	Добавлено: 02.03.09 05:01
	Господин EROS мне правда очень любопытно Ваше авторитетное мнение, есть время? Ответить

Номер ответа: 10 Автор ответа: EROS Вопросов: 58 Ответов: 4255	Профиль \| \| #10	Добавлено: 02.03.09 05:08
	Забавно спрашивать о времени в 5 часов утра, вы не находите? ))) Ответить

Номер ответа: 11 Автор ответа: Smith ICQ: adamis@list.ru Вопросов: 153 Ответов: 3632	Профиль \| \| #11	Добавлено: 02.03.09 05:20
	Таки нет тут ничего забавного, это редкое проявление моей тактичности ) Откуда мне знать в каком вы часовом поясе ) Может Вам на работу пора или ещё чего, ну правда EROS, Ваш пост для меня цены не имеет! Все танцы это именно то, о чем вы пишете. Для меня такое решение гораздо проще и понятнее костылей многопоточности VB6 ) пусть я и неправ, но я ещё совсем молод ) Ответить

Номер ответа: 12 Автор ответа: Smith ICQ: adamis@list.ru Вопросов: 153 Ответов: 3632	Профиль \| \| #12	Добавлено: 02.03.09 05:24
	А костыль реального времени как ни странно дал хоть и не чудовищный, но весьма значительный прирос скорости. Изгаляться с апи SendMessage пришлось потому, что умные ребята распространяют массово компиляции ХР с выключеной по умолчанию службой DDE, на которую я наивно полагался по началу. Ответить

Номер ответа: 13 Автор ответа: Smith ICQ: adamis@list.ru Вопросов: 153 Ответов: 3632	Профиль \| \| #13	Добавлено: 02.03.09 05:29
	FSO хоть и сделана Микрософтом, но не такая уж дремучая модель как вы думаете, я просто не уверен, что смогу написать что-то лучше используя апи, хотя и предпочитаю апи многим современным средствам. Ответить

Номер ответа: 14 Автор ответа: EROS Вопросов: 58 Ответов: 4255	Профиль \| \| #14	Добавлено: 02.03.09 05:29
	EROS, Ваш пост для меня цены не имеет! Это в смысле безценный, или же наоборот бестолковый? ))) Для меня такое решение гораздо проще и понятнее костылей многопоточности VB6 так никто и не призывает тебя юзать многопоточность в VB6 (это реально геморрой)! Напротив, я призываю тебя изменить реализацию алгоритма, что избавит тебя от всяких костылей, в том числе и от ресурсов с SendMessage. Ответить

Номер ответа: 15 Автор ответа: Smith ICQ: adamis@list.ru Вопросов: 153 Ответов: 3632	Профиль \| \| #15	Добавлено: 02.03.09 05:38
	Не уверен, что стоит переходить от получения размера папки к определению её содержимого. FSO подсчитывая размер папки наверняка использует апи, я не смогу написать это лучше микрософтовцев. Ну даже если и есть в папке файл размером 0 байт, то наверняка ценность этого файла равна размеру ) Ответить

Страница: 1 | 2 | 3 | 4 | 5 |