Выбрать все файлы по маске в поддереве каталогов

VB3, VB4 16/32, VB5
Level: Intermediate

Поскольку этот код не использует API, Вы можете легко перенести его с 16- на 32-разрядную платформу и обратно. Процедура DirWalk позводит Вам просмотреть все поддерево, начиная с заданнного места:

ReDim sArray(0) As String
Call DirWalk("OLE*.DLL", "C:\", sArray)

Эта процедура принимает * и? в первом аргументе, который задает маску поиска. Вы можете задать несколько масок, разделяя их символом «;», например, "OLE*.DLL; *.TLB". Второй аргумент - место старта, третий аргумент - массив строк.
Эта процедура рекурсивно проходит по всем каталогам и кладет все файлы, удовлетворяющие условию, в массив sArray с указанием полного пути. Этот массив меняет свои размеры в зависимости от количества файлов, удовлетворяющих условиям поиска.
Для использовния DirWalk, пихните два контрола, FileListBox и DirListBox, на форму. Эта процедура подразумевает, что она работает с контролами на текущей форме:: FileListBox по имени File1, и DirListBox по имени Dir1. Для увеличения скорости работы сделайте эти контролы невидимыми. Использование этих контролов не требует приобретения дополнительных тулзов, так как они (контролы) содержатся в базовой библиотеке контролов VB.

Sub DirWalk(ByVal sPattern As String, _
ByVal CurrDir As String, sFound() _
As String)
Dim i As Integer
Dim sCurrPath As String
Dim sFile As String
Dim ii As Integer
Dim iFiles As Integer
Dim iLen As Integer

If Right$(CurrDir, 1) <> "\" Then
Dir1.Path = CurrDir & "\"
Else
Dir1.Path = CurrDir
End If
For i = 0 To Dir1.ListCount
If Dir1.List(i) <> "" Then
DoEvents
Call DirWalk(sPattern, _
Dir1.List(i), sFound())
Else
If Right$(Dir1.Path, 1) = "\" _
Then
sCurrPath = Left(Dir1.Path, _
Len(Dir1.Path) - 1)
Else
sCurrPath = Dir1.Path
End If
File1.Path = sCurrPath
File1.Pattern = sPattern
If File1.ListCount > 0 Then
' нужные файлы найдены в каталоге
For ii = 0 To File1._
ListCount - 1
ReDim Preserve _
sFound(UBound(sFound) _
+ 1)
sFound(UBound(sFound) - _
1) = sCurrPath & _
"\" & File1.List(ii)
Next ii
End If
iLen = Len(Dir1.Path)
Do While Mid(Dir1.Path, iLen, _
1) <> "\"
iLen = iLen - 1
Loop
Dir1.Path = Mid(Dir1.Path, 1, _
iLen)
End If
Next i
End Sub

36. ИМЯ ТЕКУЩЕГО КОМПЬЮТЕРА В WINDOWS 95/NT

VB4 32, VB5
Level: Advanced

Часто Вам надо знать имя текущего компа под WINDOWS 95/NT из Вашей VB проги. Используйте эту простенькую функцию API из kernel32.dll:

Private Declare Function GetComputerNameA Lib "kernel32"_
(ByVal lpBuffer As String, nSize _
As Long) As Long

Public Function GetMachineName() As _
String
Dim sBuffer As String * 255
If GetComputerNameA(sBuffer, 255&) _
<> 0 Then
GetMachineName = Left$(sBuffer, _
InStr(sBuffer, vbNullChar) _
- 1)
Else
GetMachineName = "(Not Known)"
End If
End Function

Дата добавления: 2015-08-21