Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  | Правила  

Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Скриптовые языки администрирования Windows » VBS/WSH/JS - [решено] [VBS] Сортировка текстовых строк с учётом директорий

Ответить
Настройки темы
VBS/WSH/JS - [решено] [VBS] Сортировка текстовых строк с учётом директорий

Старожил


Сообщения: 267
Благодарности: 8

Профиль | Отправить PM | Цитировать


Изменения
Автор: shadowbat
Дата: 05-01-2020
Есть текстовые строки (именно строки, а не пути к существующим файлам)
Код: Выделить весь код
\F1\1.txt
\F111\2.txt
\f11.txt
\f33.txt
\f22.txt
\F0\3.txt
\F0\1.txt
\F0\2\2.txt
\F1\
\F0\
\F0\2\
\F111\
Если их просто отсортировать по алфавиту, то получится
Код: Выделить весь код
\F0\
\F0\1.txt
\F0\2\
\F0\2\2.txt
\F0\3.txt
\f11.txt
\F111\
\F111\2.txt
\F1\
\F1\1.txt
\f22.txt
\f33.txt
Но нужно отсортировать их с учетом директорий, (сначала файлы в корне текущего каталога, потом подкаталоги) чтобы получилось так:
Код: Выделить весь код
\f11.txt
\f22.txt
\f33.txt
\F0\
\F0\1.txt
\F0\3.txt
\F0\2\
\F0\2\2.txt
\F1\
\F1\1.txt
\F111\
\F111\2.txt
либо наоборот, подкаталоги, потом файлы.
Код: Выделить весь код
\F0\
\F0\2\
\F0\2\2.txt
\F0\1.txt
\F0\3.txt
\F1\
\F1\1.txt
\F111\
\F111\2.txt
\f11.txt
\f22.txt
\f33.txt
либо любым подобным образом, только не по алфавиту, а по директориям
Как это сделать? есть решение или алгоритм? это должна быть рекурсивная функция? через split("\") ?

Скрытый текст

набросок для переменных
Код: Выделить весь код
Dim a(1 To 12)
a(1) = "\F1\1.txt"
a(2) = "\F111\2.txt"
a(3) = "\f11.txt"
a(4) = "\f33.txt"
a(5) = "\f22.txt"
a(6) = "\F0\3.txt"
a(7) = "\F0\1.txt"
a(8) = "\F0\2\2.txt"
a(9) = "\F1\"
a(10) = "\F0\"
a(11) = "\F0\2\"
a(12) = "\F111\"

Отправлено: 14:03, 05-01-2020

 

Ветеран


Contributor


Сообщения: 2703
Благодарности: 1683

Профиль | Отправить PM | Цитировать


shadowbat, в списке только один символ (f или F) и он одинаковый во всех строках , или вместо него может быть смесь символов перед цифрами и они могут в разных строках свои?

-------
Даже самая сложная проблема обязательно имеет простое, лёгкое для понимания, неправильное решение. Каждое решение плодит новые проблемы.


Отправлено: 14:54, 05-01-2020 | #2



Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети.

Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля.


Старожил


Сообщения: 267
Благодарности: 8

Профиль | Отправить PM | Цитировать


Цитата:
вместо него может быть смесь символов перед цифрами и они могут в разных строках свои?
всё как в реальной жизни, может быть и f и F и русские и английские и юникод.
это парсинг реальных путей файлов, но в виде строк, соответственно имена могут быть такие же как у реальных директорий и файлов - самые различные
сам пока пишу на split() и ubound(split())

очень предварительный и полуправильный вариант


Код: Выделить весь код
Sub Sort()
Dim a(): ReDim a(1 To 12)
a(1) = "\F1\1.txt"
a(2) = "\F111\2.txt"
a(3) = "\f11.txt"
a(4) = "\f33.txt"
a(5) = "\f22.txt"
a(6) = "\F0\3.txt"
a(7) = "\F0\1.txt"
a(8) = "\F0\2\2.txt"
a(9) = "\F1\"
a(10) = "\F0\"
a(11) = "\F0\2\"
a(12) = "\F111\"
'сортировка
a(1) = "\F0\"
a(2) = "\F0\1.txt"
a(3) = "\F0\2\"
a(4) = "\F0\2\2.txt"
a(5) = "\F0\3.txt"
a(6) = "\f11.txt"
a(7) = "\F111\"
a(8) = "\F111\2.txt"
a(9) = "\F1\"
a(10) = "\F1\1.txt"
a(11) = "\f22.txt"
a(12) = "\f33.txt"
For Each aa In a
kol = UBound(Split(aa, "\")): If kol > max Then max = kol
Next aa
Call Sort1(a, 0, max)
Stop
End Sub
Sub Sort1(a, l, max)
For Each aa In a
kol = UBound(Split(aa, "\"))
If kol = l Then Debug.Print aa
Next aa
If l <= max Then Call Sort1(a, l + 1, max)
End Sub

Последний раз редактировалось shadowbat, 05-01-2020 в 16:16.


Отправлено: 15:08, 05-01-2020 | #3


Ветеран


Contributor


Сообщения: 2703
Благодарности: 1683

Профиль | Отправить PM | Цитировать


не по алфавиту, а по директориям
Код: Выделить весь код
FileIn = "Z:\Box_In\filein.txt"
FileOut = "Z:\Box_Out\fileout.txt"

Set FSO = CreateObject("Scripting.FileSystemObject")

On Error Resume Next

With FSO.OpenTextFile(FileIn, 1, False)
    If Err.Number <> 0 Then
        MsgBox "File   " + FileIn + vbCrLf + Err.Description + "(" + CStr(Err.Number) + ")"
        WScript.Quit 2
    End If
    On Error GoTo 0

    Alls = Split(.ReadAll, vbCrLf)
    .Close
End With

N = -1
ND = -1
NF = -1
For Each s In Alls
    N = N + 1
    s = Trim(s)
    Alls(N) = s
    If Len(s) <> 0 Then
        If Right(s, 1) = "\" Then ND = ND + 1 Else NF = NF + 1
    End If
Next

ReDim MasD(ND), MasF(NF)
jD = -1
jF = -1
For i = 0 To N
    s = Alls(i)
    If Len(s) <> 0 Then
        If Right(s, 1) = "\" Then
            jD = jD + 1
            MasD(jD) = Replace(LCase(Alls(i)), "\", Chr(0))
        Else
            jF = jF + 1
            MasF(jF) = Replace(LCase(Alls(i)), "\", Chr(0))
        End If
    End If
Next
Set Alls = Nothing

For i = 0 To ND
    For j = i To ND
        If MasD(i) < MasD(j) Then
            s = MasD(i)
            MasD(i) = MasD(j)
            MasD(j) = s
        End If
    Next
Next

For i = 0 To NF
    For j = i To NF
        If MasF(i) < MasF(j) Then
            s = MasF(i)
            MasF(i) = MasF(j)
            MasF(j) = s
        End If
    Next
Next

out = ""
For i = 0 To ND
    D = MasD(i)
    For j = 0 To NF
        If InStr(1, MasF(j), D) <> 0 Then
            out = MasF(j) + vbCrLf + out
            MasF(j) = ""
        End If
    Next
    out = D + vbCrLf + out
Next

For j = 0 To NF
    If MasF(j) <> "" Then out = MasF(j) + vbCrLf + out
Next
out = Replace(out, Chr(0), "\")
'MsgBox out  '''''''''''''''''''''''

With FSO.CreateTextFile(FileOut, True)
    .Write out
    .Close
End With
MsgBox "Done"
Пути пропишИте свои

-------
Даже самая сложная проблема обязательно имеет простое, лёгкое для понимания, неправильное решение. Каждое решение плодит новые проблемы.


Последний раз редактировалось megaloman, 05-01-2020 в 21:31.

Это сообщение посчитали полезным следующие участники:

Отправлено: 21:12, 05-01-2020 | #4


Старожил


Сообщения: 267
Благодарности: 8

Профиль | Отправить PM | Цитировать


megaloman, работает
замена "\" на Chr(0) изящная, действительно AscW("\") мешает сравнивать строки, т.к. у него номер ниже/выше чем у алфавита
а также выдаёт все строки в LCase регистре, что всё-таки является изменением, а не только сортировкой (понимаю, что без LCase сортировка в текущем виде не сработает, но факт остается фактом - после этой функции нужно производить дальнейшие действия со строками только в нижнем регистре, либо дополнительно восстанавливать изначальный регистр после функции)

Последний раз редактировалось shadowbat, 06-01-2020 в 04:07.


Отправлено: 22:31, 05-01-2020 | #5


Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


shadowbat, а можете рассказать, для чего Вам потребен список именно в таком виде?

Отправлено: 01:43, 06-01-2020 | #6


Старожил


Сообщения: 267
Благодарности: 8

Профиль | Отправить PM | Цитировать


Цитата Iska:
для чего Вам потребен список именно в таком виде? »
в сортированном? для сравнения директорий, которым частично принадлежат те или иные строки

Отправлено: 02:48, 06-01-2020 | #7


Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


shadowbat, спасибо, ясно.

Отправлено: 03:12, 06-01-2020 | #8


Старожил


Сообщения: 267
Благодарности: 8

Профиль | Отправить PM | Цитировать


Цитата megaloman:
не по алфавиту, а по директориям »
добавил восстановление регистра, только нужно закоментить 'Set Alls = Nothing
подразумевается, что изначально в строках не было разнорегистровых дублей, иначе оба дубля получат одинаковый регистр (либо нижний либо изначальный)
исправил лишнее добавление пустой строки в конце нового файла
добавить после MsgBox out: и сохранение в файл соответственно заменить на out3
Код: Выделить весь код
out2 = Split(out, vbCrLf)
For i = LBound(out2) To UBound(out2)
For j = LBound(Alls) To UBound(Alls)
If out2(i) = LCase(Alls(j)) Then out2(i) = Alls(j)
Next j
Next i
For i = LBound(out2) To UBound(out2) - 1
If out3 = "" Then out3 = out2(i) Else out3 = out3 + vbCrLf + out2(i)
Next
'MsgBox out3

Последний раз редактировалось shadowbat, 06-01-2020 в 04:04.


Отправлено: 03:52, 06-01-2020 | #9


Ветеран


Contributor


Сообщения: 2703
Благодарности: 1683

Профиль | Отправить PM | Цитировать


Цитата shadowbat:
добавил восстановление регистра ... исправил лишнее добавление пустой строки »
Вариант, где этого делать не надо. Не думал, что регистр в путях имеет какое-то значение
Код: Выделить весь код
FileIn = "Z:\Box_In\filein.txt"
FileOut = "Z:\Box_Out\fileout.txt"

Set FSO = CreateObject("Scripting.FileSystemObject")

On Error Resume Next

With FSO.OpenTextFile(FileIn, 1, False)
    If Err.Number <> 0 Then
        MsgBox "File   " + FileIn + vbCrLf + Err.Description + "(" + CStr(Err.Number) + ")"
        WScript.Quit 2
    End If
    On Error GoTo 0

    Alls = Split(.ReadAll, vbCrLf)
    .Close
End With

N = -1
ND = -1
NF = -1
For Each s In Alls
    N = N + 1
    s = Trim(s)
    Alls(N) = s
    If Len(s) <> 0 Then
        If Right(s, 1) = "\" Then ND = ND + 1 Else NF = NF + 1
    End If
Next

ReDim MasD(ND), MasF(NF)
jD = -1
jF = -1
For i = 0 To N
    s = Alls(i)
    If Len(s) <> 0 Then
        If Right(s, 1) = "\" Then
            jD = jD + 1
            MasD(jD) = Replace(Alls(i), "\", Chr(0))
        Else
            jF = jF + 1
            MasF(jF) = Replace(Alls(i), "\", Chr(0))
        End If
    End If
Next
Set Alls = Nothing

Call SortMas(MasD, ND)
Call SortMas(MasF, NF)

out = ""
For i = 0 To ND
    D = LCase(MasD(i))
    For j = 0 To NF
        If InStr(1, LCase(MasF(j)), D) <> 0 Then
            If out = "" Then out = MasF(j) Else out = MasF(j) + vbCrLf + out
            MasF(j) = ""
        End If
    Next
    If out = "" Then out = MasD(i) Else out = MasD(i) + vbCrLf + out
Next

For j = 0 To NF
    If MasF(j) <> "" Then out = MasF(j) + vbCrLf + out
Next
out = Replace(out, Chr(0), "\")
'MsgBox out  '''''''''''''''''''''''

With FSO.CreateTextFile(FileOut, True)
    .Write out
    .Close
End With
MsgBox "Done"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''End

Sub SortMas(Mas, NMas)
    For i = 0 To NMas
        s = LCase(Mas(i))
        For j = i To NMas
            ss = LCase(Mas(j))
            If s < ss Then
                s = Mas(i)
                Mas(i) = Mas(j)
                Mas(j) = s
                s = LCase(Mas(i))
            End If
        Next
    Next
End Sub

-------
Даже самая сложная проблема обязательно имеет простое, лёгкое для понимания, неправильное решение. Каждое решение плодит новые проблемы.


Последний раз редактировалось megaloman, 06-01-2020 в 15:22. Причина: Исправление недоёта при сравнении разнорегистровых строк

Это сообщение посчитали полезным следующие участники:

Отправлено: 09:45, 06-01-2020 | #10



Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Скриптовые языки администрирования Windows » VBS/WSH/JS - [решено] [VBS] Сортировка текстовых строк с учётом директорий

Участник сейчас на форуме Участник сейчас на форуме Участник вне форума Участник вне форума Автор темы Автор темы Шапка темы Сообщение прикреплено

Похожие темы
Название темы Автор Информация о форуме Ответов Последнее сообщение
Любой язык - [решено] Сравнение 2-х текстовых файлов и удаление дубликатов строк в 1-м файле. Uragan66 Скриптовые языки администрирования Windows 2 26-05-2019 16:14
Самостоятельно меняется первый символ строк в текстовых файлах (и другие проблемы) lesnoj Лечение систем от вредоносных программ 4 11-11-2015 08:42
CMD/BAT - [решено] удаление части строк из всех текстовых файлов в папке icq99999999 Скриптовые языки администрирования Windows 4 06-11-2013 07:19
Java - Сортировка строк по первому слову в алфавитном порядке pogo Программирование и базы данных 5 23-12-2011 08:05
Сортировщик строк в текстовых файлах. borison Программное обеспечение Windows 2 04-02-2007 10:22




 
Переход