Определение соответствия имени файла маске

'Данный пример позволяет определить, соответствует ли имя файла какой-либо
'маске - знак вопроса (?) или звездочку (*).

Private Function IsMask(ByVal FileName As String, ByVal Mask As String) As Boolean
'объявляем переменные
Dim i As Integer
Dim pos As Integer
Dim posit As Integer
Dim curs As String
Dim tmp As Integer
Dim temp As String
Dim j As Integer

'Заменяем идущие подряд несколько звёздочек на одну
pos = 1
posit = InStr(pos, Mask, "**")
Do While posit <> 0
temp = Left$(Mask, posit - 1)
temp = temp & Mid$(Mask, posit, 1)
temp = temp & Right$(Mask, Len(Mask) - (posit + 1))
Mask = temp
posit = InStr(pos, Mask, "**")
Loop
'Заменяем *? на *
pos = 1
posit = InStr(pos, Mask, "*?")
Do While posit <> 0
temp = Left$(Mask, posit - 1)
temp = temp & Mid$(Mask, posit, 1)
temp = temp & Right$(Mask, Len(Mask) - (posit + 1))
Mask = temp
posit = InStr(pos, Mask, "*?")
Loop
'Перебираем все символы в Mask
For pos = 1 To Len(Mask)
curs = Mid$(Mask, pos, 1)
Select Case curs
'если символ "?", то это любой знак
Case "?"
j = j + 1
i = i + 1
'если символ "*", то
Case "*"
If pos = Len(Mask) Then
'Если это последний символ, отпускаем с богом
i = i + (Len(FileName) - j)
'А если нет, то ищем символв FileName,
'стоящий в Mask за звездой
Else
tmp = InStr(pos, FileName, Mid$(Mask, pos + 1, 1))
'Если символ не найден, то
If tmp = 0 Then
'Значение функции = False
IsMask = False
'Выходим из функции
Exit Function
End If
'i = i + кол-во непроверенных символов
i = i + (tmp - (j + 1))
'то же самое с j
j = j + (tmp - (j + 1))
End If
'если символ не "*" и не "?", то
Case Else
j = j + 1
'если символ в FileName совпадает с символом
'в Mask, то
If Mid$(FileName, j, 1) = Mid$(Mask, pos, 1) Then
'Увеличиваем счётчик попаданий
i = i + 1
End If
End Select
'завершаем цикл
Next
'Если i соответствует длине FileName, то
'значение функции True, иначе False
If i = Len(FileName) Then IsMask = True Else IsMask = False
End Function

Private Sub Form_Load()
MsgBox IsMask("ritual.txt", "*.*"), , "ritual.txt" & " *.*"
MsgBox IsMask("ritual.txt", "r*.*"), , "ritual.txt" & " r*.*"
MsgBox IsMask("ritual.txt", "m*.*"), , "ritual.txt" & " m*.*"
MsgBox IsMask("ritual.txt", "?i????.*"), , "ritual.txt" & " ?i????.*"
MsgBox IsMask("ritual.txt", "*u??.*"), , "ritual.txt" & " *u??.*"
MsgBox IsMask("ritual.txt", "*.htm"), , "ritual.txt" & " *.htm"
MsgBox IsMask("ritual.txt", "*.txt"), , "ritual.txt" & " *.txt"
End
End Sub

Обсудить статью на форуме

Если Вас заинтересовала или понравилась информация программирование на Visual Basic - "Определение соответствия имени файла маске", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:

Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи, в сообщение обязательно указывайте название или ссылку на статью!