| View previous topic :: View next topic |
| Author |
Message |
Batya
Joined: 15 Dec 2004
Posts: 2224
Location: Москва, Россия
|
 (Separately) Posted: Wed Dec 17, 2008 15:36 Post subject: |
 |
|
Готов новый vbs-скрипт с автоматическим определением приставки и окончания по первому элементу списка:
| Code: | '==============================================================================
' Формирование списка отсутствующих в последовательности элементов
' Вид числовой последовательности определяется по первому элементу списка
' Параметры:
' 1 - Исходный файл-список (обязат. )
' 2 - Выходный файл-список (не обязат.)
' 3 - Режим: (не обязат.)
' 0 - вывести на экран - по умолчанию,
' 1 - записать в файл,
' 2 - по недостающим элементам создать папки,
' 3 - по недостающим элементам создать пустые файлы
'==============================================================================
Option Explicit
Dim Dic, FSO, List, l, i, Prefix, Postfix, LenPrefix, LenPostfix
Dim InFile, OutFile, Mode, Str, Value, Position, Digits, Num, Mess
Set Dic = CreateObject("Scripting.Dictionary")
Set FSO = CreateObject("Scripting.FileSystemObject")
'Задаем массив сообщений
MessDefine
'Проверяем параметры
CheckParams
'Читаем исходный список
List = Split(FSO.OpenTextFile(InFile).ReadAll, vbNewLine)
'Ищем в первом элементе число
Value = Search(List(0), "\d+", Position)
Digits = Len(Value)
'Если первый элемент не содержит цифр, выходим
If Position = 0 Then Quit
'Определяем приставку и окончание
Prefix = Left(List(0), Position - 1 )
Postfix = Mid (List(0), Position + Digits)
LenPrefix = Len (Prefix )
LenPostfix = Len (Postfix)
'Перебираем список
For Each l In List
'Проверяем на совпадение приставки и окончания
If (UCase(Left (l, LenPrefix )) = UCase(Prefix )) And _
(UCase(Right(l, LenPostfix)) = UCase(Postfix)) Then
'Средняя часть (цифры)
Num = Mid(l, Position, Len(l) - LenPrefix - LenPostfix)
'Проверяем среднюю часть на минимальное количество цифр
If Len(Num) >= Digits And _
IsNumeric(Num) Then
'Добавляем в искомый массив
Dic.Add CInt(Num), l
End If
End If
Next
'Задаем числовую последовательность от минимума до максимума
For i = Min(Dic.Keys) To Max(Dic.Keys)
'Проверяем наличие элемента с текущим числом
If Not Dic.Exists(i) Then
'Формируем среднюю часть с лидирующими нулями
If Len(i) < Digits Then
Num = Right(String(Digits, "0") & i, Digits)
Else
Num = i
End If
'Заполняем строковой массив
Str = Str & vbNewLine & Prefix & Num & Postfix
End If
Next
'Убираем лидирующий перенос строки
Str = Mid(Str, Len(vbNewLine) + 1)
'Результаты в зависимости от заданного режима
Select Case Mode
Case 0 MsgBox Str, vbInformation + vbOKOnly, Mess(0)
Case 1 FSO.CreateTextFile(OutFile, True).Write Str
Case 2 CreateFolders Split(Str, vbNewLine)
Case 3 CreateFiles Split(Str, vbNewLine)
End Select
'Выход
Quit
'===== Процедуры и функции ====================================================
'Проверка входных параметров
Sub CheckParams
With WScript
If .Arguments.Count = 0 Then
MsgBox Mess(1), vbCritical + vbOKOnly, Mess(0)
Quit
End If
InFile = .Arguments(0)
If Not FSO.FileExists(InFile) Then
MsgBox Mess(2), vbCritical + vbOKOnly, Mess(0)
Quit
End If
OutFile = ""
If .Arguments.Count > 1 Then
OutFile = .Arguments(1)
End If
Mode = 0
If .Arguments.Count > 2 Then
Mode = .Arguments(2)
If IsNumeric(Mode) Then
Mode = CInt(Mode)
If (Mode < 0) Or (Mode > 3) Then Mode = 0
Else
Mode = 0
End If
End If
If (Mode <> 0) And (OutFile = "") Then
MsgBox Mess(3), vbCritical + vbOKOnly, Mess(0)
Quit
End If
End With
End Sub
'Описание сообщений
Sub MessDefine
Set Mess = CreateObject("Scripting.Dictionary")
With Mess
.Add 0, "Отсутствующие элементы списка"
.Add 1, "Не указаны параметры!"
.Add 2, "Указанный файл-список не существует!"
.Add 3, "Для данного режима должен быть указан выходной файл-список!"
End With
End Sub
'Поиск по маске первого значения в строке
'Функция возвращает значение, третий параметр - позицию
Function Search(pStr, pMask, byRef pPos)
Dim REx, lMatch, lMatches
Set REx = New RegExp
REx.Pattern = pMask
REx.IgnoreCase = True
REx.Global = True
Set lMatches = REx.Execute(pStr)
If lMatches.Count > 0 Then Set lMatch = lMatches.Item(0)
If IsObject(lMatch) Then
Search = lMatch.Value
pPos = lMatch.FirstIndex + 1
Else
Search = ""
pPos = 0
End If
End Function
'Создание папок по списку
Sub CreateFolders(pList)
Dim l
For Each l In pList
If Not(FSO.FolderExists(l) And FSO.FileExists(l)) Then
FSO.CreateFolder l
End If
Next
End Sub
'Создание пустых файлов по списку
Sub CreateFiles(pList)
Dim l
For Each l In pList
If Not(FSO.FolderExists(l) And FSO.FileExists(l)) Then
FSO.CreateTextFile l
End If
Next
End Sub
'Поиск максимального значения в массиве
Function Max(pArr)
Dim lE, lM
lM = pArr(0)
For Each lE In pArr
If lE > lM Then lM = lE
Next
Max = lM
End Function
'Поиск минимального значения в массиве
Function Min(pArr)
Dim lE, lM
lM = pArr(0)
For Each lE In pArr
If lE < lM Then lM = lE
Next
Min = lM
End Function
'Выход
Sub Quit
Set Mess = Nothing
Set Dic = Nothing
Set FSO = Nothing
WScript.Quit
End Sub |
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
 |
_Johm
Joined: 14 May 2006
Posts: 119
|
| (Separately) Posted: Wed Dec 17, 2008 19:50 Post subject: |
|
|
Batya, великолепный скрипт.
если встречается вот такое:
pre_10_post.test
pre_011_post.test
pre_11_post.test
pre_12_post.test
то выдает ошибку
| Code: | Строка: 47
Символ: 7
Ошибка: Запись уже связана с элементом данного семейства
Код: 800A01C9
Источник: Ошибка выполнения Microsoft VBScript |
Хотел было уже прикрутить к Sequences, но выделение в режиме плагина не передает все элементы, передает имя группы элементов. |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2224
Location: Москва, Россия
|
| (Separately) Posted: Thu Dec 18, 2008 11:17 Post subject: |
|
|
_Johm
Хм... Продолжаем уточнять условия задачи.
 Что, в твоем понимании, должно получаться, если исходная последовательность выглядит так:
| Code: | pre_10_post.test
pre_011_post.test
pre_13_post.test
pre_015_post.test |
| _Johm wrote: | | выделение в режиме плагина не передает все элементы, передает имя группы элементов. |
Ничего не понял. О чем речь? У меня Sequences не стоит, и ставить его я не собираюсь.
Объясни подробно, как ты действуешь и что хочешь в итоге получить.
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
_Johm
Joined: 14 May 2006
Posts: 119
|
| (Separately) Posted: Tue Dec 23, 2008 11:43 Post subject: |
|
|
| Batya wrote: | _Johm
Хм... Продолжаем уточнять условия задачи.
Что, в твоем понимании, должно получаться, если исходная последовательность выглядит так:
Код:
pre_10_post.test
pre_011_post.test
pre_13_post.test
pre_015_post.test |
В данном случае все работает как надо, ошибка когда есть два файла с "одинаковым" числом (11 и 011). В данном случае может создавать второй список с названием "Возможные дубликаты"?
На счет плагина Sequences
он представляет в панеле файлы в виде
a[05-11]
a[13-14]
когда в панеле изначально
...
a09
a10
a11
-пропущенный 12-ый-
a13
a14
плагин объединяет только файлы с одинаковым по длинне именем.
| Batya wrote: | Johm писал(а):
выделение в режиме плагина не передает все элементы, передает имя группы элементов. |
Я думал, что плагин передает в выделение файлы как есть (тогда можно было бы направить это выделение в скрипт. Но
он передает выделение в сгруппированном виде.
| Batya wrote: | У меня Sequences не стоит, и ставить его я не собираюсь.
Объясни подробно, как ты действуешь и что хочешь в итоге получить. |
Так то плагин удобный. Все что хотел уже получил - задача решена.
Далее, разве что, можно добавить обход нештатной ситуации с "возможными дубликатами"
Еще раз спасибо за скрипт. |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2224
Location: Москва, Россия
|
| (Separately) Posted: Tue Dec 23, 2008 13:50 Post subject: |
|
|
_Johm
Опять я ничего не понял.
Раз ты не ответил на мой предыдущий вопрос, усложню ситуацию.
Что, в твоем понимании, должно получаться, если исходная последовательность выглядит так:
| Code: | pre_10_post.test
pre_11_post.test
pre_011_post.test
pre_13_post.test
pre_015_post.test |
Не надо описывать словами. Просто приведи перечень элементов последовательности.
| _Johm wrote: | | Так то плагин удобный. Все что хотел уже получил - задача решена. |
Очень хорошо. Тогда я и голову не буду ломать, пытаясь догадаться о твоих желаниях.
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
