/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Basic/VBA

Выпуск № 442
от 25.12.2006, 22:35

Вопрос № 67.767

Доброго дня. Подскажите кодом или ссылкой по VB. Тема такая. Нужно проверить диск на наличие файлов или папок (включая вложенные папки) по маске имени для дальнейшего переименования. Мне нужен код именно поиска по всему диску. Спаибо всем кто чем-нибудь поможет

Отправлен: 19.12.2006, 23:29 Вопрос задал: Igigig (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: HookEst Здравствуйте, Igigig! Предлагаю Вашему вниманию 2 функции для поиска файлов по маске, одна использует Windows API вторая нет. т.к. взяты и переделаны из MSDN, кроме списка файлов вычисляют еще и дополнителную информацию. После доработки, думаю, можно использовать. Аргументы: (IN) path As String - место поиска; (IN) SearchStr As String - маска поиска; (OUT) Files As String - список найденых файлов и папок с путями, разделенный vbCrLf; (OUT) FileCount As Integer - количество найденых файлов и папок; (OUT) DirCount As Integer - количество вложенных папок в которых производился поиск; Return: возвращают as Long - суммарный размер всех найденых файлов; будут вопросы, пишите. Приложение: 'с использованием API 'В отдельном модуле Option Explicit 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 Declare Function GetFileAttributes Lib "kernel32" Alias _ "GetFileAttributesA" (ByVal lpFileName As String) As Long Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) _ As Long Public Const MAX_PATH = 260 Public Const MAXDWORD = &HFFFF Public Const INVALID_HANDLE_VALUE = -1 Public Const FILE_ATTRIBUTE_ARCHIVE = &H20 Public Const FILE_ATTRIBUTE_DIRECTORY = &H10 Public Const FILE_ATTRIBUTE_HIDDEN = &H2 Public Const FILE_ATTRIBUTE_NORMAL = &H80 Public Const FILE_ATTRIBUTE_READONLY = &H1 Public Const FILE_ATTRIBUTE_SYSTEM = &H4 Public Const FILE_ATTRIBUTE_TEMPORARY = &H100 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 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 FindFilesAPI(path As String, SearchStr As String, _ Files As String, FileCount As Integer, DirCount As Integer) As Long Dim FileName As String ' Walking filename variable... Dim DirName As String ' SubDirectory Name Dim dirNames() As String ' Buffer for directory name entries Dim nDir As Integer ' Number of directories in this path Dim i As Integer ' For-loop counter... Dim hSearch As Long ' Search Handle Dim WFD As WIN32_FIND_DATA Dim Cont As Integer Dim FT As FILETIME Dim DateCStr As String, DateMStr As String If Right(path, 1) <> "" Then path = path & "" ' Search for subdirectories. nDir = 0 ReDim dirNames(nDir) Cont = True hSearch = FindFirstFile(path & "*", WFD) If hSearch <> INVALID_HANDLE_VALUE Then Do While Cont DirName = StripNulls(WFD.cFileName) ' Ignore the current and encompassing directories. If (DirName <> ".") And (DirName <> "..") Then ' Check for directory with bitwise comparison. If GetFileAttributes(path & DirName) And _ FILE_ATTRIBUTE_DIRECTORY Then dirNames(nDir) = DirName DirCount = DirCount + 1 nDir = nDir + 1 ReDim Preserve dirNames(nDir) 'Files = Files & path & DirName & vbCrLf End If End If Cont = FindNextFile(hSearch, WFD) ' Get next subdirectory. Loop Cont = FindClose(hSearch) End If ' Walk through this directory and sum file sizes. hSearch = FindFirstFile(path & SearchStr, WFD) Cont = True If hSearch <> INVALID_HANDLE_VALUE Then While Cont FileName = StripNulls(WFD.cFileName) If (FileName <> ".") And (FileName <> "..") Then FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * _ MAXDWORD) + WFD.nFileSizeLow FileCount = FileCount + 1 Files = Files & path & FileName & vbCrLf End If Cont = FindNextFile(hSearch, WFD) ' Get next file Wend Cont = FindClose(hSearch) End If ' If there are sub-directories... If nDir > 0 Then ' Recursively walk into them... For i = 0 To nDir - 1 FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) _ & "", SearchStr, Files, FileCount, DirCount) Next i End If End Function 'без API 'В отдельном модуле Function FindFiles(path As String, SearchStr As String, _ Files As String, FileCount As Integer, DirCount As Integer) As Long Dim FileName As String ' Walking filename variable. Dim DirName As String ' SubDirectory Name. Dim dirNames() As String ' Buffer for directory name entries. Dim nDir As Integer ' Number of directories in this path. Dim i As Integer ' For-loop counter. On Error GoTo sysFileERR If Right(path, 1) <> "" Then path = path & "" ' Search for subdirectories. nDir = 0 ReDim dirNames(nDir) DirName = Dir(path, vbDirectory Or vbHidden Or vbArchive Or vbReadOnly _ Or vbSystem) ' Even if hidden, and so on. Do While Len(DirName) > 0 ' Ignore the current and encompassing directories. If (DirName <> ".") And (DirName <> "..") Then ' Check for directory with bitwise comparison. If GetAttr(path & DirName) And vbDirectory Then dirNames(nDir) = DirName DirCount = DirCount + 1 nDir = nDir + 1 ReDim Preserve dirNames(nDir) 'Files = Files & path & DirName & vbCrLf End If sysFileERRCont: End If DirName = Dir() ' Get next subdirectory. Loop ' Search through this directory and sum file sizes. FileName = Dir(path & SearchStr, vbNormal Or vbHidden Or vbDirectory Or vbSystem _ Or vbReadOnly Or vbArchive) While Len(FileName) <> 0 FindFiles = FindFiles + FileLen(path & FileName) FileCount = FileCount + 1 Files = Files & path & FileName & vbCrLf FileName = Dir() ' Get next file. Wend ' If there are sub-directories.. If nDir > 0 Then ' Recursively walk into them For i = 0 To nDir - 1 FindFiles = FindFiles + FindFiles(path & dirNames(i) & "", _ SearchStr, Files, FileCount, DirCount) Next i End If AbortFunction: Exit Function sysFileERR: If Right(DirName, 4) = ".sys" Or path = "System Volume Information" Then Resume sysFileERRCont ' Known issue with pagefile.sys Else 'MsgBox "Error: " & Err.Number & " - " & Err.Description, , "Unexpected Error" Resume AbortFunction End If End Function 'процедура для тестирования Private Sub test() Dim SearchPath As String, FindStr As String, Files As String, Msg As String Dim FileSize As Long Dim NumFiles As Integer, NumDirs As Integer SearchPath = "c:Windows" FindStr = "sys*.dat" Files = "" NumFiles = 0 NumDirs = 0 FileSize = FindFilesAPI(SearchPath, FindStr, Files, NumFiles, NumDirs) Msg = NumFiles & " Files and Folders found with API in " & NumDirs + 1 & " Directories" & vbCrLf Msg = Msg & String(Len(Msg), "*") & vbCrLf Msg = Msg & Files & vbCrLf & vbCrLf Msg = Msg & "Size of files found under " & SearchPath & " = " & Format(FileSize, "#,###,###,##0") & " Bytes" & vbCrLf MsgBox Msg Files = "" NumFiles = 0 NumDirs = 0 FileSize = FindFiles(SearchPath, FindStr, Files, NumFiles, NumDirs) Msg = NumFiles & " Files and Folders found in " & NumDirs + 1 & " Directories" & vbCrLf Msg = Msg & String(Len(Msg), "*") & vbCrLf Msg = Msg & Files & vbCrLf & vbCrLf Msg = Msg & "Size of files found under " & SearchPath & " = " & Format(FileSize, "#,###,###,##0") & " Bytes" & vbCrLf MsgBox Msg End Sub

Ответ отправил: HookEst (статус: Студент) Ответ отправлен: 20.12.2006, 12:24 Оценка за ответ: 5 Комментарий оценки: Спасибо, HookEst! Все GOOD.

Вопрос № 67.771

Здравствуйте! Объясните пожалуйста назначение параметров метода Application.OnTime EarliestTime, LatestTime, Schedule В данном примере процедура my_Procedure запускается через 15 секунд от текущего системного времени. Application.OnTime Now + TimeValue("00:00:15"), "my_Procedure" В связи с этим возникает вопрос: программа будет постоянно прибавлять к текущему времени 15 секунд и процедура "my_Procedure" будет выполняться всё снова и снова. Или это событие произойдёт только один раз? Если оно повторяется то как сделать так чтобы оно выполнялось только один раз по нажатию кнопки(нажал кнопку -выполнилось) и дальше переставало работать опять нажал - опять выполнилось один раз и переставало

Отправлен: 20.12.2006, 00:06 Вопрос задал: Rewer8 (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: HookEst Здравствуйте, Rewer8! первым аргументом(EarliestTime) Application.OnTime идет конкретное время когда нужно выполнить процедуру, то есть выполнятся будет 1 раз, именно в этот момент времени ; вторым аргументом(Procedure) идет имя процедуры которую нужно выполнить; третим аргументом(LatestTime) идет время после которого процедура выполнятся уже не будет, на случай если не удастся выполнить в момент EarliestTime, если не указан, Application будет ждать пока не выполнит; четвертый аргумент(Schedule) - если True(по умолчанию) то процедура исполнится в указаное время, а False используется для отмены ранее сделанного вызова OnTime, до того как наступило время, все остальные аргументы должны быть такими же, как при запуске таймера(когда Shedule было True); Application.OnTime Now + TimeValue("00:00:15"), "my_Procedure" запустит my_Procedure 1 раз в момент Now + TimeValue("00:00:15"), т.е. через 15 сек после вызова; Application.OnTime TimeValue("17:00:00"), "my_Procedure" запустит my_Procedure 1 раз именно в 17:00; Application.OnTime EarliestTime:=TimeValue("17:00:00"), _ Procedure:="my_Procedure", Schedule:=False вызванный после предыдущего предложения, но до 17:00, отменит запуск my_Procedure в 17:00; p/s если нужно чтобы повторялось, то в Procedure, нужно заново вызывать Application.OnTime

Ответ отправил: HookEst (статус: Студент) Ответ отправлен: 20.12.2006, 06:49 Оценка за ответ: 5

Вопрос № 67.793

Уважаемые эксперты, скажите пожалуйста, как именно нужно прописывать сетевой путь при открытиии файла по сети. При этом вроде как можно залезть только на открытые пути? Желательно побольше примеров. Большое спасибо.

Отправлен: 20.12.2006, 08:04 Вопрос задал: Дмитрий Т. (статус: 1-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: ADSota Здравствуйте, Дмитрий Т.! Файл по FTP или HTTPData открыть будет сложно. В своей локальной сети работать с файлом просто. Для этого было придумано UNC. В имени сначала указывается имя сервера, предваряемое двумя слэшами, а затем сетевое имя разделяемого каталога и составное имя файла. Например, приложение может открыть файл, используя имя \Server1gamesvasxx.txt,где Server1 - имя компьютера, games - сетевое имя разделяемого каталога, назначенное пользователем или системой, vasxx.txt - составное имя файла относительно каталога games. Очень грубо говоря - это то самое имя файла - которое светиться в заголовке окна, когда открываешь папку через "Сетевое окружение". В итоге на бейсике будет: Open "\Server1gamesvasxx.txt" For Output As #2 ... Если нужно, система сама запросит имя пользователя и пароль для подключения. --------- Открыть глаза навстречу солнцу

Ответ отправил: ADSota (статус: Профессионал) Россия, Зеленоград Тел.: 8-916-53-43-916 ICQ: 84611301 ---- Ответ отправлен: 20.12.2006, 13:28 Оценка за ответ: 5 Комментарий оценки: У меня немного другая проблема, это я знал, не могу понять куда совать "$". И именно нельзя ведь получить доступ к неоткрытой, как к сетевому ресурсу, папке, чтобы оттуда взять файл?

Вопрос № 67.829

Здраствуйте. Поскажите как в VisualBasic 6 из одной формы вызывать другую с передачей ей параметров(допустим x,y). Дайте ссылку где почитать про использование модулей, ну в смысле как их писать, как подключать.

Отправлен: 20.12.2006, 13:07 Вопрос задал: Alxx (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Макаренко Е.В. Здравствуйте, Alxx! Очень просто. По кнопке на исходной Form1 делаете Load.Form2 Теперь вторая форма уже загружена, но еще не отображена. И с ее полями уже можно делать что угодно. Private Sub CommandButton1_Click() Load UserForm2 UserForm2.BackColor = vbGreen UserForm2.Show End Sub Выводит новую форму с зеленым фоновым цветом. --------- осторожность, точность... и горит все синим пламенем! :))

Ответ отправил: Макаренко Е.В. (статус: Практикант) Ответ отправлен: 21.12.2006, 09:55 Оценка за ответ: 5

Отвечает: VLK Здравствуйте, Alxx! Из первой формы вызвать вторую можно либо в модальном режиме (первая будет недоступна пользователю, пока не закрыти вторая, хотя и видима), либо в немодальном. Причем здесь возможны 2 варианта. 1) Доступны одновременно обе формы: Private sub Command1_click() Form2.Show End sub 2) Доступна только вторая (первая скрывается): Private sub Command1_click() Form2.Show Form1.Hide ' только скрыть форму или unload Form1 ' выгрузить ее из памяти совсем End sub Открыть форму в модальном режиме: Private sub Command1_click() Form2.Show, vbModal или Form2.Show, 0 End sub Расположить вторую форму в левом верхнем углу экрана: Private sub Command1_click() Form2.Top = 0 Form2.Left = 0 Form2.Show End sub Модуль не имеет видимых элементов управления и свойств - это просто код, который содержит, как правило, процедуры или функции, которые должны быть доступны из любого места программы (допустим, у вас 5 форм в программе и в любой из них можно вызвать эти функции). Добавить модуль можно как через проводник объектов программы (контекстное меню пр. клавиши мыши "Добавить" -- "Модуль" в той области, где отображаются все формы, справа от рабочей области), так и через меню или панель инструментов в верхней части экрана.

Ответ отправил: VLK (статус: 9-ый класс) Ответ отправлен: 21.12.2006, 10:23 Оценка за ответ: 5

© 2001-2006, Портал RusFAQ.ru, Россия, Москва. Идея, дизайн, программирование: Калашников О.А. Email: adm@rusfaq.ru, Тел.: +7 (926) 535-23-31 Авторские права | Реклама на портале Версия системы: 4.38 от 20.12.2006