Sub Del_Files(File As Variant)
' Created by Elena Nefedova, Fors - Banking Systems
On Error Goto ErrLab
Dim arFile() As String, arTreated() As String, err_text$
Redim arTreated(0)
If Not Isarray(File) Then
If Trim(File) = "" Then
Goto EndLab
Else
Redim arFile(0)
arFile(0) = File
End If
Else
Dim tmpFile As Variant, tmpI%
tmpFile = Fulltrim(Arrayunique(File))
If tmpFile(0) = "" Then
Goto EndLab
Else
Redim arFile(Ubound(tmpFile))
For tmpI = Ubound(tmpFile) To 0 Step -1
arFile(tmpI) = tmpFile(tmpI)
Next tmpI
End If
End If
'Теперь имеем массив arFile непустых строк - имен файлов или папок
Dim u%
u = Ubound(arFile)
Do While (u >= 0)
Dim attr_info%, cur_file$
cur_file = arFile(u)
u = u - 1
If u < 0 Then
Redim arFile (0)
Else
Redim Preserve arFile (u)
End If
On Error 53 Goto Err53Lab
attr_info = Getfileattr(cur_file)
On Error Goto ErrLab
If (attr_info And 16) Then 'обработка папки
Dim direlem$, bDir As Boolean
bDir = False
direlem = Dir$(cur_file + "\*", 30)
Do While direlem <> ""
If Left(direlem, 1) <> "." Then
'если каталог не пуст, то добавим его для дальнейшей обработки
If Not bDir Then 'добавку производим 1 раз, пока не выставлен флаг bDir
If Arraygetindex(arTreated, cur_file, 1) Then
err_text = "Невозможно обработать элемент " + cur_file
Print err_text
Goto EndLab
Else
u = u + 1
Redim Preserve arFile(u)
arFile(u) = cur_file
End If
bDir = True 'флаг "каталог не пуст"
End If
u = u + 1
Redim Preserve arFile(u)
arFile(u) = cur_file + "\" + direlem
End If
direlem = Dir$
Loop
If Not bDir Then 'Если каталог пуст, то удалим его
On Error Resume Next 'А из массива обработки мы его исключили еще в самом начале
Rmdir cur_file
On Error Goto ErrLab
Redim Preserve arTreated(Ubound(arTreated)+1)
arTreated(Ubound(arTreated)) = cur_file 'пополним список обработанных файлов
End If
Else 'обработка файла
Kill cur_file
Redim Preserve arTreated(Ubound(arTreated)+1)
arTreated(Ubound(arTreated)) = cur_file 'пополним список обработанных файлов
End If
Loop_u_lab:
Loop
EndLab:
'КОНЕЦ ПОДПРОГРАММЫ
Exit Sub
ErrLab:
Msgbox "File_Dir_lib : Del_Files" + Chr(13) _
+ "Sub Del_Files" + Chr(13) _
+"Line : " + Str$(Erl) + Chr(13)+ "Error " + Str$(Err) + Chr(13) + Error$
Goto EndLab
Err53Lab:
On Error Goto ErrLab
Redim Preserve arTreated(Ubound(arTreated)+1)
arTreated(Ubound(arTreated)) = cur_file 'пополним список обработанных файлов
Goto Loop_u_lab
End Sub