Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - ASP и VBScript

Страница: 1 |

 

  Вопрос: как переименовать файл по определенному правилу Добавлено: 12.02.10 22:46  

Автор вопроса:  Alexander
Ситуация в следующем, есть файлы с именами

abcdef-1.txt
abcdef-3.txt
abcdef-2.txt
ghhgh-2.txt
ghhgh-3.txt
ghhgh-1.txt

1) как написать скрипт для приведения имени файла в вид abcdef.txt ( как сохранить файл с новым именем без двух последних символов, при этом исходное количество символов в имени файла может меняться )

2) Каким образом объединить содержимое текстовых файлов с выше приведенными именами в порядке присвоенного им индекса -1,-2,-3 с учетом имени перед индексом , с окончательным именем файла без приставки -*.

Ответить

  Ответы Всего ответов: 4  

Номер ответа: 1
Автор ответа:
 Just



Вопросов: 4
Ответов: 330
  Профиль | | #1 Добавлено: 13.02.10 11:10
вот пример моего скрипта. думаю подойдет...
кинуть в папку sendto и потом из контекстного меню вызывать
  1.  
  2. Option Explicit
  3. Dim objFSO, LogFile, FilesOrFold, SubFold, DelLeftLen, DelRightLen, strMaskBefore, strMaskAfter, LeftCount, RightCount, strMaskFind, strMaskReplace, strMaskExten, TextCompareReplace, strFolderPath, Sel, objArgs, I, Old_New_Name, objOldName
  4. Set objFSO = CreateObject("Scripting.FileSystemObject")
  5.  
  6. Dim FilesArray()
  7. Dim FilesArrayCount
  8. FilesArrayCount = 0
  9.  
  10. Set objArgs = WScript.Arguments
  11. For I = 0 to objArgs.Count - 1 'цикл вывода всех проиндексиванных аргументов
  12. strFolderPath = objArgs(I)
  13. Next
  14.  
  15.  
  16.  
  17.  
  18. if objFSO.FolderExists(strFolderPath) = 0 then
  19. msgbox "Ошибка получения пути к папке!", 16, "Переименование..."
  20. WscriptQuit()
  21. End If
  22.  
  23. Sel = MsgBox("Переименовать имена файлов и папок?" & Chr(13) & Chr(10) & "В папке: " & strFolderPath, 4 + 32, "Переименование...")
  24. If Sel <> 6 Then
  25. WscriptQuit()
  26. End If
  27.  
  28.  
  29.  
  30.  
  31. 'FilesOrFold = 1   '<файлы - 1, папки - 2, файлы и папки - 3>
  32. 'SubFold = 0   '<подпапки - 1, без подпапок - 0>
  33. 'DelLeftLen = 0   'удалить слева символы
  34. 'DelRightLen = 0   'удалить справа символы
  35. 'strMaskFind = ""   'строка поиска для замены
  36. 'strMaskReplace = ""   'строка замены (если строка поиска присутствует в имени файла)
  37. 'TextCompareReplace = 1   'без учета регистра
  38. 'strMaskBefore = ""   'добавить строку в начале файла
  39. 'strMaskAfter = ""   'добавить строку в конце файла
  40. 'LeftCount = ""   '<0 - добавить счетчик (начать отсчет с 0) в начало файла, "" - не добавлять счетчик в начало файла>
  41. 'RightCount = ""   '<0 - добавить счетчик (начать отсчет с 0) в конец файла, "" - не добавлять счетчик в конец файла>
  42. 'strMaskExten = ""   '<".txt" - переименовывать только один тип файлов без папок, "" - переименовывать все типы файлов и папки, если указаны>
  43. 'strFolderPath = "C:\Temp"   'папка в которой переименовывать
  44.  
  45.  
  46.  
  47.  
  48. FilesOrFold = InputBox("По умолчанию включен режим переименования только файлов!" & Chr(13) & Chr(10) & "Изменить?" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "1 - переименование только файлов" & Chr(13) & Chr(10) & "2 - переименование только папок" & Chr(13) & Chr(10) & "3 - переименование файлов и папок", "Переименование...", "1")
  49. If FilesOrFold <> 1 and FilesOrFold <> 2 and FilesOrFold <> 3 Then FilesOrFold = 1
  50.  
  51. SubFold = InputBox("По умолчанию включен режим переименования без подпапок!" & Chr(13) & Chr(10) & "Изменить?" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "1 - переименовывать в подпапках тоже" & Chr(13) & Chr(10) & "0 - не учитывать подпапки", "Переименование...", "0")
  52. If SubFold <> 0 and SubFold <> 1 Then SubFold = 0
  53.  
  54. Sel = MsgBox("Удалить по краям имен символы?", 4 + 32, "Переименование...")
  55. If Sel = 6 Then
  56.   DelLeftLen = InputBox("Укажите количество удаляемых символов слева." & Chr(13) & Chr(10) & "Если количество удаляемых символов превысит количество символов файла, то файл будет пропущен!", "Переименование...", "0")
  57.   If DelLeftLen < 0 and DelLeftLen = "" Then DelLeftLen = 0
  58.   DelRightLen = InputBox("Укажите количество удаляемых символов справа." & Chr(13) & Chr(10) & "Если количество удаляемых символов превысит количество символов файла, то файл будет пропущен!", "Переименование...", "0")
  59.   If DelRightLen < 0 and DelRightLen = "" Then DelRightLen = 0
  60. End If
  61.  
  62. Sel = MsgBox("Заменить символы в имени?", 4 + 32, "Переименование...")
  63. If Sel = 6 Then
  64.   strMaskFind = InputBox("Укажите строку поиска!", "Переименование...", "")
  65.   strMaskReplace = InputBox("Укажите строку замены!", "Переименование...", "")
  66. Sel = MsgBox("Учитывать регистр при поиске?", 4 + 32, "Переименование...")
  67. If Sel = 6 Then
  68. TextCompareReplace = 0
  69. else
  70. TextCompareReplace = 1
  71. End If
  72. End If
  73.  
  74. Sel = MsgBox("Добавить строку в имя?", 4 + 32, "Переименование...")
  75. If Sel = 6 Then
  76.   strMaskBefore = InputBox("добавить строку в начале имени!", "Переименование...", "")
  77.   strMaskAfter = InputBox("добавить строку в конце имени!", "Переименование...", "")
  78. End If
  79.  
  80. Sel = MsgBox("Добавить счетчик с увеличением в имя?", 4 + 32, "Переименование...")
  81. If Sel = 6 Then
  82. LeftCount = InputBox("Укажите начальное значение счетчика в начале имени!", "Переименование...", "")
  83.     do until IsNumeric(LeftCount)
  84. msgbox "Неправельное значение счетчика!" & Chr(13) & Chr(10) & "Счетчик указывается целыми числами!", 16, "Переименование..."
  85. LeftCount = InputBox("Укажите начальное значение счетчика в начале имени!", "Переименование...", "")
  86.     loop
  87. if LeftCount <> "" then LeftCount = CLng(LeftCount)
  88.  
  89. RightCount = InputBox("Укажите начальное значение счетчика в конце имени!", "Переименование...", "")
  90.     do until IsNumeric(RightCount)
  91. msgbox "Неправельное значение счетчика!" & Chr(13) & Chr(10) & "Счетчик указывается целыми числами!", 16, "Переименование..."
  92. RightCount = InputBox("Укажите начальное значение счетчика в конце имени!", "Переименование...", "")
  93.     loop
  94. if RightCount <> "" then RightCount = CLng(RightCount)
  95. End If
  96.  
  97. strMaskExten = InputBox("Переименовывать только один тип файлов с введеным расширением?" & Chr(13) & Chr(10) & "Если будет указан тип файлов поиска, то папки не будут учитываться при переименовании!", "Переименование...", ".txt")
  98.  
  99.  
  100.  
  101. Sel = MsgBox("Начать переименование?", 4 + 32, "Переименование...")
  102. If Sel = 6 Then
  103.  
  104. msgbox "Для корректного переименования необходимо выйти из указанной папки до окончания работы программы!", 16, "Переименование..."
  105.  
  106. RenameByMask()   'вызов функции переименовывания
  107.  
  108.   Sel = MsgBox("Отменить переименование файлов?", 4 + 32, "Переименование...")
  109.   If Sel = 6 Then
  110. If objFSO.fileexists("C:\WINDOWS\Temp\RenameByMask.log") Then
  111.   Set LogFile = objFSO.OpenTextFile ("C:\WINDOWS\Temp\RenameByMask.log", 1, True)   'открыть только для чтения, если нет файла - создать
  112.   Do While LogFile.AtEndOfStream <> True
  113. 'Msgbox LogFile.ReadLine
  114.  
  115. FilesArrayCount = FilesArrayCount + 1
  116. ReDim Preserve FilesArray(FilesArrayCount)
  117. FilesArray(FilesArrayCount) = LogFile.ReadLine
  118. 'Msgbox FilesArrayCount
  119. 'Msgbox FilesArray(FilesArrayCount)
  120.  
  121.   Loop
  122.   LogFile.Close
  123. elseIf objFSO.fileexists("C:\RenameByMask.log") Then
  124.   Set LogFile = objFSO.OpenTextFile ("C:\RenameByMask.log", 1, True)
  125. else
  126.   MsgBox "Отмена переименования не выполнена!", 64, "Переименование..."
  127. End If
  128.  
  129. Do Until FilesArrayCount < 0   'перебор значений массива в обратном порядке
  130. 'Msgbox FilesArrayCount
  131. 'Msgbox FilesArray(FilesArrayCount)

  133.     Old_New_Name = Split(FilesArray(FilesArrayCount), "  --->  ", 2)
  134.     if UBound(Old_New_Name) = 1 then
  135.     'Msgbox Old_New_Name(0)
  136.     'Msgbox Old_New_Name(1)
  137. On Error Resume Next
  138.   if objFSO.fileexists(Old_New_Name(1)) then
  139.     Set objOldName = objFSO.GetFile(Old_New_Name(1))
  140.     objOldName.Move Old_New_Name(0)
  141.   elseif objFSO.Folderexists(Old_New_Name(1)) then
  142.     Set objOldName = objFSO.GetFolder(Old_New_Name(1))
  143.     objOldName.Move Old_New_Name(0)
  144.   else
  145.     msgbox "Ошибка отмены переименования!", 16, "Переименование..."
  146.     Sel = MsgBox("Завершить работу программы?", 4 + 32, "Переименование...")
  147.     If Sel = 6 Then WscriptQuit()
  148.   end if
  149.      If Err.Number <> 0 Then
  150.   msgbox "Ошибка отмены переименования!", 16, "Переименование..."
  151.     Sel = MsgBox("Завершить работу программы?", 4 + 32, "Переименование...")
  152.     If Sel = 6 Then WscriptQuit()
  153. End If
  154. On Error goto 0
  155.     end if
  156.  
  157. FilesArrayCount = FilesArrayCount - 1
  158. Loop
  159.   End If
  160.  
  161. End If
  162.  
  163.  
  164.  
  165.  
  166.  
  167. msgbox "Выход...", 64, "Переименование..."
  168.  
  169. WscriptQuit()
  170. sub WscriptQuit()
  171. On Error Resume Next
  172. 'удаление лога...
  173. If objFSO.fileexists("C:\WINDOWS\Temp\RenameByMask.log") Then objFSO.DeleteFile "C:\WINDOWS\Temp\RenameByMask.log", 1
  174. If objFSO.fileexists("C:\RenameByMask.log") Then objFSO.DeleteFile "C:\RenameByMask.log", 1
  175. 'удаление переменных...
  176. set objArgs = nothing
  177. set I = nothing
  178. set objOldName = nothing
  179. set Old_New_Name = nothing
  180. set objFSO = nothing
  181. set LogFile = nothing
  182. set Sel = nothing
  183. set FilesOrFold = nothing
  184. set SubFold = nothing
  185. set strMaskBefore = nothing
  186. set strMaskAfter = nothing
  187. set strMaskFind = nothing
  188. set strMaskReplace = nothing
  189. set LeftCount = nothing
  190. set RightCount = nothing
  191. set strMaskExten = nothing
  192. set strFolderPath = nothing
  193. set TextCompareReplace = nothing
  194. Err.Clear
  195. Wscript.quit   'Выход
  196. End Sub
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220. Sub RenameByMask()
  221.      If objFSO.FolderExists(strFolderPath) Then
  222. If objFSO.FolderExists("C:\WINDOWS\Temp") Then
  223.    Set LogFile = objFSO.OpenTextFile ("C:\WINDOWS\Temp\RenameByMask.log", 2, True)   'открыть для записи, если нет файла - создать
  224. else
  225.    Set LogFile = objFSO.OpenTextFile ("C:\RenameByMask.log", 2, True)   'открыть для записи, если нет файла - создать
  226. end if
  227. LogFile.WriteLine Now & "======================================"
  228. FindContent objFSO.GetFolder(strFolderPath)
  229. LogFile.WriteLine "========================================================="
  230. LogFile.Close
  231.      End If
  232. End Sub
  233.  
  234. Sub FindContent(objFolder)
  235. if FilesOrFold <> 2 then
  236. Dim objFile, objSubFolder, strExten, strFileName, strFileNameExt, strFilePath, strNewFileName
  237.  
  238.      For Each objFile In objFolder.Files
  239. 'objFile.Delete True
  240. 'msgbox objFile
  241.  
  242.  
  243. strFilePath = objFile
  244. if strFilePath <> "" then
  245.     strExten = "." & objFSO.GetExtensionName(strFilePath)   'получить расширение
  246.     if len(strExten) > 3 then
  247.      if strMaskExten = "" or LCase(strExten) = LCase(strMaskExten) then   'искать все типы файлов или только один
  248.     
  249. strFileNameExt = objFSO.GetFileName(strFilePath)   'получить имя с расширением
  250. strFileName = Left(strFileNameExt, len(strFileNameExt) - len(strExten))   'получить имя
  251. strFilePath = Left(strFilePath, len(strFilePath) - len(strFileNameExt))   'получить путь со слешем
  252.  
  253. 'msgbox strExten
  254. 'msgbox strFileName
  255. 'msgbox strFileNameExt
  256. 'msgbox strFilePath
  257. 'Wscript.quit
  258.  
  259. strNewFileName = ""
  260. strNewFileName = strFileName

  262. 'удалить в начале файла
  263. if DelLeftLen > 0 then
  264.     if len(strNewFileName) > CLng(DelLeftLen) then
  265. strNewFileName = Right(strNewFileName, len(strNewFileName) - DelLeftLen)
  266.     end if
  267. end if
  268.  
  269. 'удалить в конце файла
  270. if DelRightLen > 0 then
  271.     if len(strNewFileName) > CLng(DelRightLen) then
  272. strNewFileName = Left(strNewFileName, len(strNewFileName) - DelRightLen)
  273.     end if
  274. end if
  275.  
  276. 'замеить в изначальном имени строку поиска на указанную
  277. if TextCompareReplace = 1 then
  278.     strNewFileName = Replace(strNewFileName, strMaskFind, strMaskReplace, 1, -1, 1)   'без учета регистра
  279. else
  280.     strNewFileName = Replace(strNewFileName, strMaskFind, strMaskReplace, 1, -1, 0)   'с учетом регистра
  281. end if
  282.  
  283. 'удалить пробелы в начале и конце имени
  284. strNewFileName = Trim(strNewFileName)
  285.  
  286. 'применить все изменения в окончательное имя файла
  287. strNewFileName = LeftCount & strMaskBefore & strNewFileName & strMaskAfter & RightCount

  289.  
  290.   if LCase(objFile) <> LCase(strFilePath & strNewFileName & strExten)  then
  291.  
  292. if objFSO.fileexists(strFilePath & strNewFileName & strExten) then
  293. do until objFSO.fileexists(strFilePath & strNewFileName & strExten) = 0
  294.   strNewFileName = inputbox("До: " & objFile & Chr(13) & Chr(10) & "После: " & strFilePath & strNewFileName & strExten & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Файл с таким именем уже существует!" & Chr(13) & Chr(10) & "Переименовать?", "Переименование...", strNewFileName)  
  295. loop
  296. end if  
  297.  
  298.    if strNewFileName <> "" then
  299.        LogFile.WriteLine objFile & "  --->  " & strFilePath & strNewFileName & strExten
  300.        
  301.   On Error Resume Next
  302.   objFile.name = strNewFileName & strExten
  303.        If Err.Number <> 0 Then
  304.     msgbox "Ошибка переименования файла!", 16, "Переименование..."
  305.       Sel = MsgBox("Завершить работу программы?", 4 + 32, "Переименование...")
  306.       If Sel = 6 Then WscriptQuit()
  307.   end if
  308.   On Error goto 0
  309.  
  310.        if LeftCount <> "" then LeftCount = LeftCount +1
  311.        if RightCount <> "" then RightCount = RightCount +1
  312.         else
  313.        'msgbox "Файл пропущен: " & objFile
  314.        LogFile.WriteLine "Файл пропущен: " & objFile
  315.    end if
  316.   end if
  317.  
  318.      end if
  319.     else
  320. 'msgbox "Ошибка получения имени файла, файл пропущен! " & objFile & " (возможно файл без расширения...)"
  321. LogFile.WriteLine "Ошибка получения имени файла, файл пропущен! " & objFile & " (возможно файл без расширения...)"
  322.     end if
  323.  
  324. end if
  325.      Next
  326. end if
  327.      For Each objSubFolder In objFolder.SubFolders
  328.  
  329. if SubFold = 1 then
  330.   FindContent objSubFolder
  331. end if
  332.  
  333. if FilesOrFold <> 1 then
  334. Dim LenFolderPath, strFolderPath, strFolderName, strNewFolderName
  335.           'objSubFolder.Delete True
  336.   'msgbox objSubFolder
  337.  
  338.   strFolderPath = objSubFolder
  339.   if strFolderPath <> "" then
  340.    if strMaskExten = "" then   'если не указано разрешение файлов
  341. LenFolderPath =  InStrRev(objSubFolder, "\")
  342. strFolderPath = Left(objSubFolder,LenFolderPath)
  343. strFolderName = right(objSubFolder, len(objSubFolder) - LenFolderPath)   'получить имя
  344. 'msgbox LenFolderPath
  345. 'msgbox strFolderPath
  346. 'msgbox strFolderName
  347. 'Wscript.quit
  348.  
  349. strNewFolderName = ""
  350. strNewFolderName = strFolderName


  353. 'удалить в начале папки
  354. if DelLeftLen > 0 then
  355.     if len(strNewFolderName) > CLng(DelLeftLen) then
  356. strNewFolderName = Right(strNewFolderName, len(strNewFolderName) - DelLeftLen)
  357.     end if
  358. end if
  359.  
  360. 'удалить в конце папки
  361. if DelRightLen > 0 then
  362.     if len(strNewFolderName) > CLng(DelRightLen) then
  363. strNewFolderName = Left(strNewFolderName, len(strNewFolderName) - DelRightLen)
  364.     end if
  365. end if
  366.  
  367. 'заменить в изначальном имени строку поиска на указанную
  368. if TextCompareReplace = 1 then
  369.     strNewFolderName = Replace(strNewFolderName, strMaskFind, strMaskReplace, 1, -1, 1)   'без учета регистра
  370. else
  371.     strNewFolderName = Replace(strNewFolderName, strMaskFind, strMaskReplace, 1, -1, 0)   'с учетом регистра
  372. end if
  373.  
  374. 'удалить пробелы в начале и конце имени
  375. strNewFileName = Trim(strNewFileName)
  376.  
  377. 'применить все изменения в окончательное имя папки
  378. strNewFolderName = LeftCount & strMaskBefore & strNewFolderName & strMaskAfter & RightCount

  380.  
  381.     if LCase(objSubFolder) <> LCase(strFolderPath & strNewFolderName)  then   'если изменилось имя
  382.  
  383. if objFSO.FolderExists(strFolderPath & strNewFolderName) then
  384. do until objFSO.FolderExists(strFolderPath & strNewFolderName) = 0
  385.   strNewFolderName = inputbox("До: " & objSubFolder & Chr(13) & Chr(10) & "После: " & strFolderPath & strNewFolderName & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Папка с таким именем уже существует!" & Chr(13) & Chr(10) & "Переименовать?", "Переименование...", strNewFolderName)  
  386. loop
  387. end if  
  388.  
  389.    if strNewFolderName <> "" then
  390.        LogFile.WriteLine objSubFolder & "  --->  " & strFolderPath & strNewFolderName
  391.        
  392.   On Error Resume Next
  393.   objSubFolder.name = strNewFolderName
  394.        If Err.Number <> 0 Then
  395.     msgbox "Ошибка переименования папки!", 16, "Переименование..."
  396.       Sel = MsgBox("Завершить работу программы?", 4 + 32, "Переименование...")
  397.       If Sel = 6 Then WscriptQuit()
  398.   end if
  399.   On Error goto 0
  400.  
  401.        if LeftCount <> "" then LeftCount = LeftCount +1
  402.        if RightCount <> "" then RightCount = RightCount +1
  403.         else
  404.        'msgbox "Папка пропущена: " & objSubFolder
  405.        LogFile.WriteLine "Папка пропущена: " & objSubFolder
  406.    end if
  407.  
  408.     end if
  409.  
  410.  
  411.    end if
  412.   else
  413.     'msgbox "Ошибка получения имени папки, папка пропущена! " & objSubFolder
  414.     LogFile.WriteLine "Ошибка получения имени папки, папка пропущена! " & objSubFolder
  415.   end if
  416. end if
  417.      Next
  418. End Sub

Ответить

Номер ответа: 2
Автор ответа:
 Alexander



Вопросов: 2
Ответов: 11
  Профиль | | #2 Добавлено: 02.03.10 11:16
есть файлы в папке
qwe7676-2001-1.pdf и qwe7676-2001-2.pdf 1 и 2 в конце имени указывают на часть документа
qwe787-2001-1.pdf и qwe787-2001-2.pdf

необходимо сравнивать имена файлов и при совпадении символов между qwe...-2001-*.pdf запускать скажем команду asd.exe (1-й файл) (2-й файл), затем их удалять и так далее со всеми файлами в папке.

Пытаюсь приспособить регулярные выражения пока-что не очень,
Просьба подсобите?????

Ответить

Номер ответа: 3
Автор ответа:
 Шпион



ICQ: 250543104 

Вопросов: 13
Ответов: 118
  Профиль | | #3 Добавлено: 14.07.10 23:51
если есть в имени файла определенная хрень
(instr(1,strSearchFrom,strSearchString)=1)
, т.е. строка поиска найдена в начале строки поиска, тогда слить два дока
objShell.Run strMycmd,1,True

Ответить

Номер ответа: 4
Автор ответа:
 Шпион



ICQ: 250543104 

Вопросов: 13
Ответов: 118
  Профиль | | #4 Добавлено: 14.07.10 23:57
а если надо по порядку - загоняй имена файлов в массив и сортируй пузырьком (как самое простое)
или еще хлеще - сначала пузырек, потом отбор по критерию.
зы. 10 > 1 поэтому у тебя файлы adcdef-10 abcdef-11 будут раньше чем abcdef-1, вроде

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам