Total Commander Forum Index Total Commander
Форум поддержки пользователей Total Commander
Сайты: Все о Total Commander | Totalcmd.net | Ghisler.com | RU.TCKB
 
 RulesRules   SearchSearch   FAQFAQ   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Групповое редактирование .LNK файлов
Goto page 1, 2, 3, 4  Next
 
Post new topic   Reply to topic    Total Commander Forum Index -> Автоматизация Total Commander printer-friendly view
View previous topic :: View next topic  
Author Message
Andrey_A



Joined: 10 Apr 2009
Posts: 394
Location: Сочи

Post (Separately) Posted: Sun Oct 18, 2009 18:07    Post subject: Групповое редактирование .LNK файлов Reply with quote

Помогите пожалуйста. Место расположение программ поменялось, был хорошо организован каталог ссылок на эти программы (т.е каталог LNK файлов на эти программы) - как сделать так чтобы не по одиночке, а разом изменить в них путь... , чтобы они заработали. Чтобы изменить их поодиночке, есть программа LinkEditor, а вот группой я не встречал
С уважением Андрей А А
Back to top
View user's profile Send private message
Вахмурка



Joined: 27 Dec 2004
Posts: 2449
Location: Большая деревня Москва

Post (Separately) Posted: Sun Oct 18, 2009 20:20    Post subject: Reply with quote

В свое время я написал 2 скрипта для взаимного преобразования ярлыков в кнопки ТС. Можно на их основе сваять скрипт, делающий то же самое с группой ярлыков (*.lnk -> xxx.bar). Затем открываем xxx.bar и глобально меняем пути. После чего другим скриптом преобразуем новый yyy.bar в *.lnk. Если тебе очень нужно, я попробую эти два скрипта сваять
_________________
Сайт PowerPro+Total Commander
Скрипты PowerPro для Total Commander
* * *
«Не усматривайте злого умысла в том, что вполне объяснимо глупостью» (Р. Хэнлон)
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2184
Location: Москва, Россия

Post (Separately) Posted: Sun Oct 18, 2009 21:04    Post subject: Reply with quote

Andrey_A
Могу написать для тебя vbs.
Какие параметры нужно менять и на что?
_________________
Нет, я не сплю. Я просто медленно моргаю.
Back to top
View user's profile Send private message
Andrey_A



Joined: 10 Apr 2009
Posts: 394
Location: Сочи

Post (Separately) Posted: Mon Oct 19, 2009 23:38    Post subject: Reply with quote

В свойствах LNK файлов окошки
Объект
Рабочая папка
Коментарий
все они имеют одинаковый путь, к примеру у меня:
C:\Program Files\Total Commander\Programs\Coyote\Coyote.exe
а сейчас мне надо
C:\Total Commander\Programs\Coyote\Coyote.exe
то есть скрипт, как мне кажется должен делать следующее
1. Наверное параметр %L т.к. lnk файлы выделяются
2. Вылетает окно, где говорится о том какую строку(или часть текста, пути) искать
3. Вылетает окно... на что заменить
4 Heppy End
Возможно, в конце операции хорошо бы выдавался список файлов, в которых изменения не сделаны - это надо для того, чтобы отдельно посмотреть эти файлы...
Спасибо за скорость ответа, с уважением Андрей А А
Back to top
View user's profile Send private message
Вахмурка



Joined: 27 Dec 2004
Posts: 2449
Location: Большая деревня Москва

Post (Separately) Posted: Tue Oct 20, 2009 19:12    Post subject: Reply with quote

Batya, если не ты, так я Smile
Товарищ не хочет признаваться, какой скрипт ему удобнее. У меня, например, vbs тупо не запускаются - выбора нет. Если устроит PowerPro - я готов.
_________________
Сайт PowerPro+Total Commander
Скрипты PowerPro для Total Commander
* * *
«Не усматривайте злого умысла в том, что вполне объяснимо глупостью» (Р. Хэнлон)
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2184
Location: Москва, Россия

Post (Separately) Posted: Tue Oct 20, 2009 21:53    Post subject: Reply with quote

Почти доделал vbs, только сейчас катострофически не хватает времени довести до конца Sad
Постараюсь вскоре выложить.

Вахмурка wrote:
У меня, например, vbs тупо не запускаются
Shocked Это как так? Скачать scripten.exe для своей версии ОС и переустановить Windows Script не пробовал?
_________________
Нет, я не сплю. Я просто медленно моргаю.
Back to top
View user's profile Send private message
Вахмурка



Joined: 27 Dec 2004
Posts: 2449
Location: Большая деревня Москва

Post (Separately) Posted: Tue Oct 20, 2009 23:24    Post subject: Reply with quote

Да зачем? PowerPro пока справляется, хотя vbs, видимо, все же помощнее будет. Привычка - вторая натура.
_________________
Сайт PowerPro+Total Commander
Скрипты PowerPro для Total Commander
* * *
«Не усматривайте злого умысла в том, что вполне объяснимо глупостью» (Р. Хэнлон)
Back to top
View user's profile Send private message
Andrey_A



Joined: 10 Apr 2009
Posts: 394
Location: Сочи

Post (Separately) Posted: Thu Oct 22, 2009 01:25    Post subject: Reply with quote

Спасибо за соучастие, мне бы желательно на vbs
C уважением ко всем, особенно к PowerPro'вцам Андрей А А
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2184
Location: Москва, Россия

Post (Separately) Posted: Thu Oct 22, 2009 11:14    Post subject: Reply with quote

Готово:
Code:
'=========================================================================
' Групповая замена свойств ярлыков.
'
' Параметры:
' {файл-список ярлыков}|{папка с ярлыками}
'
' Примеры параметров при вызове из TC:
' %L
' "%P"
'
' Автор - Batya
'=========================================================================
Option Explicit
Dim Mess, FSO, WSH, FF, IsFolder, F, FindStr, ReplStr, Res, Msg, K

On Error Resume Next
Main:CheckErr
On Error GoTo 0
If Res.Count > 0 Then
  For Each K In Res.Keys
    Msg = Msg & vbNewLine & vbNewLine & K & "  -  " & Res(K)
  Next
Else
  Msg = vbNewLine & vbNewLine & Mess(10)
End If
WSH.Popup Mess(9) & Msg, 0, Mess(0)
Quit 0

'Основная процедура
Sub Main
  SetMess
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set WSH = CreateObject("WScript.Shell")
  Set Res = CreateObject("Scripting.Dictionary")
  F = ""

  CheckParam
 
  FindStr = InputBox(Mess(3), Mess(0)):If FindStr = "" Then Quit 0
  ReplStr = InputBox(Mess(4), Mess(0)):If ReplStr = "" Then Quit 0
 
  If IsFolder Then
    FolderProc FF
  Else
    For Each F In Split(FSO.OpenTextFile(FF).ReadAll, vbNewLine)
      If F <> "" Then
        F = GetPath(F)
        If     FSO.FileExists(F)   Then
          FileProc   F
        ElseIf FSO.FolderExists(F) Then
          FolderProc F
        End If
      End If
    Next
  End If
End Sub

'Массив сообщений
Sub SetMess
  Set Mess = CreateObject("Scripting.Dictionary")
  With Mess
    .Add 0,  "Групповая замена свойств ярлыков"
    .Add 1,  "Не указаны параметры!"
    .Add 2,  "Первый параметр не является файлом-списком или папкой!"
    .Add 3,  "Введите искомый текст:"
    .Add 4,  "Введите текст на замену:"
    .Add 5,  "Выполнена замена:"
    .Add 6,  "Возникла ошибка:" & vbNewLine
    .Add 7,  "Возникла ошибка № "
    .Add 8,  "Файл\папка:"
    .Add 9,  "Результат операции:"
    .Add 10, "Замен не произошло."
  End With
End Sub

'Проверка входных параметров
Sub CheckParam
  If WScript.Arguments.Count = 0 Then Err.Raise vbObjectError + 1, "", Mess(1)
  FF = GetPath(WScript.Arguments(0))
  If Not FSO.FileExists(FF) Then
    If Not FSO.FolderExists(FF) Then
      Err.Raise vbObjectError + 2, "", Mess(2)
    Else
      IsFolder = True
    End If
  Else
    IsFolder = False
  End If
End Sub

'Обработка файла-ярлыка
Sub FileProc(pPath)
  Dim lExt, LNK
  On Error Resume Next
  lExt = FSO.GetExtensionName(pPath)
  If LCase(lExt) = "lnk" Then
    Msg = ""
    With WSH.CreateShortcut(pPath)
      .TargetPath       = ReplaceIn("TargetPath",       .TargetPath)
      .IconLocation     = ReplaceIn("IconLocation",     .IconLocation)
      .WorkingDirectory = ReplaceIn("WorkingDirectory", .WorkingDirectory)
      .Description      = ReplaceIn("Description",      .Description)
      .Save
    End With
    If Msg <> ""       Then Res.Add pPath, Mess(5) & Msg
    If Err.Number <> 0 Then Res.Add pPath, Mess(6) & "     " & Err.Description
    Msg = ""
  End If
  On Error GoTo 0
End Sub

'Замена в строке
Function ReplaceIn(pType, pStr)
  If InStr(1, pStr, FindStr, 1) > 0 Then
    Msg = Msg & vbNewLine & "    " & pType & ": " & pStr & "  ->  "
    ReplaceIn = Replace(pStr, FindStr, ReplStr, 1, 1, 1)
    Msg = Msg & ReplaceIn
  Else
    ReplaceIn = pStr
  End If
End Function

'Обработка папки
Sub FolderProc(pPath)
  Dim loF
  Set loF = FSO.GetFolder(pPath)
  For Each F In loF.SubFolders
    F = F.Path
    FolderProc F
  Next
  For Each F In loF.Files
    F = F.Path
    FileProc F
  Next
  Set loF = Nothing
End Sub

'Разложить путь при наличии переменных окружения
Function GetPath(pPath)
  GetPath = FSO.GetAbsolutePathName(WSH.ExpandEnvironmentStrings(pPath))
End Function

'Проверка, нет ли ошибок
Sub CheckErr
  Dim lMess
  lMess = Mess(7) & Err.Number & ":" & vbNewLine & Err.Description
  If F <> "" Then lMess = lMess & vbNewLine & vbNewLine & Mess(8) & vbNewLine & F
  If Err.Number <> 0 Then
    MessBox lMess, 1
    Quit Err.Number
  End If
End Sub

'Сообщение
Function MessBox(pMess, pMode)
  Dim lIcon
  Select Case pMode
    Case 1 lIcon = vbCritical    + vbOKOnly
    Case 2 lIcon = vbExclamation + vbOKOnly
    Case 3 lIcon = vbInformation + vbOKOnly
  End Select
  MessBox = MsgBox(pMess, lIcon, Mess(0))
End Function

'Выход
Sub Quit(pExitCode)
  Set Mess = Nothing
  Set Res  = Nothing
  Set WSH  = Nothing
  Set FSO  = Nothing
  WScript.Quit pExitCode
End Sub


Примечание! Странно, у некоторых файлов в процессе редактирования ярлыка уже при изменении в поле "Объект" сразу меняется "Рабочая папка".
_________________
Нет, я не сплю. Я просто медленно моргаю.
Back to top
View user's profile Send private message
Andrey_A



Joined: 10 Apr 2009
Posts: 394
Location: Сочи

Post (Separately) Posted: Thu Oct 22, 2009 23:35    Post subject: Reply with quote

ОООгрооомноееее спасибо! Одним кликом 1000 lnk файлов изменены и... заработали! Вручную я пытался - мышку сломал, клавиатуру погнул, а тут Ну, ты , Батя!
С благодарностью Андрей А А
Back to top
View user's profile Send private message
StarKite



Joined: 13 Apr 2010
Posts: 1

Post (Separately) Posted: Tue Apr 13, 2010 10:35    Post subject: Reply with quote

Batya wrote:
Готово:


Очень ценный скрипт! Спасибо огромное.
Back to top
View user's profile Send private message
pgrm



Joined: 06 Nov 2012
Posts: 1

Post (Separately) Posted: Tue Nov 06, 2012 16:55    Post subject: Reply with quote

Отличный скрипт, жаль нет отображения процесса работы.
Back to top
View user's profile Send private message
Alekzandr



Joined: 14 Oct 2015
Posts: 1

Post (Separately) Posted: Wed Oct 14, 2015 07:56    Post subject: Большое спасибо за скрипт! Reply with quote

Очень помог! Благодарю!
Быстро восстановил ярлыки профилей хрома после вирусной активности!
Back to top
View user's profile Send private message
vadimn



Joined: 17 Apr 2016
Posts: 2

Post (Separately) Posted: Sun Apr 17, 2016 22:48    Post subject: Reply with quote

Не подскажете, как этим пользоваться?
Back to top
View user's profile Send private message
Avada



Joined: 01 Aug 2008
Posts: 8505
Location: Россия, Саратов

Post (Separately) Posted: Sun Apr 17, 2016 22:58    Post subject: Reply with quote

vadimn
Сюда заглядывать не пробовали?
_________________
Даже самая богатая фантазия
Не представит себе наши безобразия.
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    Total Commander Forum Index -> Автоматизация Total Commander All times are GMT + 4 Hours
Goto page 1, 2, 3, 4  Next
Page 1 of 4

 
Jump to:  
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