| View previous topic :: View next topic |
| Author |
Message |
Batya
Joined: 15 Dec 2004
Posts: 2224
Location: Москва, Россия
|
 (Separately) Posted: Thu May 18, 2006 17:53 Post subject: |
 |
|
Меня тут Zorroz попросил выложить скрипт для снятия иконки, т.е. снятия атрибута "Только чтение" у папки и удаления desktop.ini.
Мне не хотелось этого делать, т.к. считаю, что удаление desktop.ini не всегда "есть хорошо", но он меня уговорил 
| Code: | '========================================================
' Снятие иконки у папки в TC:
' снятие у папки атрибута "Только чтение"
' и удаление (по желанию) в папке файла Desktop.ini
' Параметры вызова из TC для текущей папки:
' "%P"
' или для папки под курсором:
' %P%N
' Для удаления Desktop.ini укажите любой второй параметр
' Пример: %P%N 1
'========================================================
Dim FSO, TargetDir, FileName
Set FSO = CreateObject("Scripting.FileSystemObject")
TargetDir = WScript.Arguments(0)
FileName = "Desktop.ini"
If FSO.FolderExists(TargetDir)Then
If Right(TargetDir, 1) <> "\" Then
TargetDir = TargetDir & "\"
End If
Else
MsgBox "Не задано имя папки!", vbOKOnly + vbExclamation, "Снятие иконки"
WScript.Quit
End If
' Снимем у папки атрибут "Только чтение"
Attr = 1
Set oDir = FSO.GetFolder(TargetDir)
oDir.Attributes = oDir.Attributes and not Attr
'Удалим Desktop.ini
If FSO.FileExists(TargetDir & FileName) and (WScript.Arguments.Count > 1) Then
FSO.DeleteFile(TargetDir & FileName)
End If
Set FSO = Nothing
WScript.Quit |
|
|
| Back to top |
|
 |
KoS
Joined: 13 Jun 2006
Posts: 9
Location: Киев
|
| (Separately) Posted: Wed Jun 28, 2006 03:42 Post subject: |
|
|
огромное спасибо за скрипты, Batya.
Раньше я все в ручную через дибильный експлореровский диалог устанавливал. Даже в голову не приходило написать скрипт. А теперь стало просто супер. Спасибо. |
|
| Back to top |
|
|
Hazy
Joined: 14 Mar 2005
Posts: 12
|
| (Separately) Posted: Thu Jul 13, 2006 17:02 Post subject: |
|
|
А вот подскажите, неужели нельзя было просто нажать правой кнопкой мышки на нужной папке, выбрать "Свойства", выбрать "Настройка" и нажать кнопку "Сменить значек..."?
потом выбираем значек, или библиотеку значков, и наслождаемся.
Да и смена атрибутов, если не ошибаюсь, неважна.
Единственное, что из личного опыта заметил, если иконка валяется в той же папке, которой внешний вид - меняет, то файл Desktop.ini стоит довести до такого состояния:
[.ShellClassInfo]
IconFile=TOTALCMD.ico
IconIndex=0
тогда при копировании каталога в другое место, меньше проблем будет |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2224
Location: Москва, Россия
|
| (Separately) Posted: Thu Jul 13, 2006 17:42 Post subject: |
|
|
Hazy
Здесь обсуждалась идея, чтобы нажатием одной кнопки сделать иконку у папки в TC. Чтобы TC отображал такую же иконку, как Explorer, надо у папки установить атрибут "Только чтение".
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
Hazy
Joined: 14 Mar 2005
Posts: 12
|
| (Separately) Posted: Thu Jul 13, 2006 17:59 Post subject: |
|
|
Вот только что проверил, снял атрибут, изменил иконку, в ТС все сразу обновилось...
Мож я чет непонял...  |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2224
Location: Москва, Россия
|
| (Separately) Posted: Thu Jul 13, 2006 19:17 Post subject: |
|
|
Для папки вызови команду TC "Файлы\Изменить атрибуты". В диалоговом окне сними все флажки -> ОК.
Теперь отображается иконка?
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
Hazy
Joined: 14 Mar 2005
Posts: 12
|
| (Separately) Posted: Fri Jul 14, 2006 09:33 Post subject: |
|
|
нет
оригинально....
наверное форточки принудительно сей атрибут ставят, когда меняешь значек
просто я так никогда не делал
а вот менять иконки на папках, очень люблю и поэтому у меня всегда иконки в ТС 32х32 установлены
Да, еще недавно для себя приятную утилитку нарыл, которая меняет цвет папок. Оченно в работе помогает. |
|
| Back to top |
|
|
Lamer
Joined: 20 Mar 2006
Posts: 522
|
| (Separately) Posted: Fri Jul 14, 2006 09:37 Post subject: |
|
|
| Hazy wrote: | | Да, еще недавно для себя приятную утилитку нарыл, которая меняет цвет папок. Оченно в работе помогает. |
А можно попросить чуть-чуть поподробнее? Всех папок? Или по какому принципу? Как называется утилита? Free? |
|
| Back to top |
|
|
Hazy
Joined: 14 Mar 2005
Posts: 12
|
| (Separately) Posted: Fri Jul 14, 2006 15:09 Post subject: |
|
|
Прога посностью FREE
Собственно прог даже две
Folderico 3.2.1
Живет тута и говорит на русском
вторая
iColorFolder
Живет тута
Я пользуюсь второй (первую так и не попробовал), принцип работы просто: у проги есть наборчики изображений с разними цветами папок и она прописывает ссылку на иконку в этом наборе в Desktop.ini, т.е. в памяти она не сидит, что - приятно.
Минус в том, что если папка уже имеет уникальную иконку, то она е потеряет.
С обоими вкусностями и еще всякими украшательствами познакомился тута, так что смотрите, украшайте унылые форточки.
ну вот, офффффтопик вышел
сорьки
но тема то любопытная  |
|
| Back to top |
|
|
Lamer
Joined: 20 Mar 2006
Posts: 522
|
| (Separately) Posted: Fri Jul 14, 2006 15:28 Post subject: |
|
|
| Угу. Спасибо,Hazy |
|
| Back to top |
|
|
Hazy
Joined: 14 Mar 2005
Posts: 12
|
| (Separately) Posted: Mon Jul 17, 2006 09:28 Post subject: |
|
|
| Да незачто |
|
| Back to top |
|
|
DrShark
Joined: 21 Oct 2006
Posts: 911
Location: Kyiv, Ukraine
|
| (Separately) Posted: Sun May 06, 2007 22:27 Post subject: |
|
|
У меня есть такой Desktop.ini:
| Code: | [.ShellClassInfo]
IconFile=%ProgramFiles%\Arsenal Company\Сократ Персональный 4.1\spv.exe
IconIndex=0
[.ShellClassInfo.A]
IconFile=%ProgramFiles%\Arsenal Company\Сократ Персональный 4.1\spv.exe
[.ShellClassInfo.W]
IconFile=+ACU-ProgramFiles+ACUAXA-Arsenal Company+AFwEIQQ+BDoEQAQwBEI- +BB8ENQRABEEEPgQ9BDAEOwRMBD0ESwQ5- 4.1+AFw-spv.exe |
Насколько я понимаю, так он выглядит максимально корректно. Можно ли с помощью VBScript создавать из кириллицы белиберду наподобие той, что в [.ShellClassInfo.W]? Было бы неполхо добавить это в скрипт, приведенный выше. |
|
| Back to top |
|
|
Bakli
Joined: 31 Jul 2007
Posts: 90
|
| (Separately) Posted: Wed Aug 01, 2007 23:54 Post subject: |
|
|
микроангел создает отличные файлы.. вообще или иконку в папке храните или на ехе в папке ссмылайтесь.. просто если поменять средствами винды, то на другом компе иконки не будет, а так она сохраняется.
всего нужны тока две строчки
[.ShellClassInfo]
IconFile=GTA3.exe
IconIndex=0
можно еще например
OriginalInfoTip=это всплывающая подсказка )
_________________
 |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2224
Location: Москва, Россия
|
| (Separately) Posted: Thu Apr 16, 2009 18:59 Post subject: |
|
|
Вариант скрипта с автоматическим\полуавтоматическим поиском файла иконок: | Code: | '=========================================================================
' Задание иконок у папок (создание файлов desktop.ini)
' Параметры:
' {папка|файл-список папок} [{файл с иконкой} [{режим поиска файла с иконкой}]]
' где режим поиска файла с иконкой может принимать значения:
' 0 - обязательно должен быть задан файл с иконкой;
' 1 - если не задан файл с иконкой, выполняется автоматический поиск;
' 2 - если автоматически файл не найден, прелагается указать его вручную;
' 3 - всегда предлагается указать файл вручную (по умолчанию).
'
' Примеры параметров вызова из TC:
' "%P" "%N"
' %P%N %T%M
' %L "" 2
'
' Автор - Batya
'=========================================================================
Option Explicit
'======== Изменяемые параметры ===========================================
Const FileName = "Desktop.ini"
Const DefaultMode = 3 'Режим поиска файла с иконкой по умолчанию
Const FoldAttr = 1 'Атрибуты папки - "Только чтение"
Const FileAttr = 38 'Атрибуты файла - "Скрытый", "Системный", "Архивный"
'=========================================================================
Dim Mess, FSO, WSH, ListFlag, FF, IconFile, F, Errors, Mode
SetMess
Set Errors = CreateObject("Scripting.Dictionary")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
CheckParam
If ListFlag Then
For Each F In Split(FSO.OpenTextFile(FF).ReadAll, vbNewLine)
If F <> "" Then Main F
Next
Else
Main FF
End If
If Errors.Count > 0 Then
MessBox JoinErr(Errors), 2
'Else
' MessBox Mess(7), 3
End If
Quit
Sub SetMess
Set Mess = CreateObject("Scripting.Dictionary")
With Mess
.Add 0, "Задание иконки для папки"
.Add 1, "Не указаны параметры!"
.Add 2, "Первый параметр не является папкой или файлом-списком!"
.Add 3, "Указанный файл с иконкой не существует!"
.Add 4, "Не является папкой!"
.Add 5, "Файл с иконкой не определен!"
.Add 6, "Файл " & FileName & " уже существует!"
.Add 7, "Операция завершена."
.Add 8, "Операция завершена с ошибками." & vbNewLine
.Add 9, "Укажите файл иконок для папки "
.Add 10, "Исполняемые файлы (*.exe)|*.exe|Файлы иконок (*.ico)|*.ico|Все файлы (*.*)|*.*"
.Add 11, "Неправильно указан режим поиска файла иконок!"
.Add 12, "В данном режиме файл с иконкой должен быть указан обязательно!"
End With
End Sub
Sub Main(pF)
Dim lF, lIF
lF = GetPath(pF)
If Not FSO.FolderExists(lF) Then
Errors.Add lF, lF & " - " & Mess(4)
Exit Sub
End If
lIF = GetIconFile(lF, IconFile)
If lIF = "" Then
Errors.Add lF, lF & " - " & Mess(5)
Exit Sub
End If
'Установим атрибуты папки
SetFoldAttr lF
'Создадим Desktop.ini
If Not FSO.FileExists(lF & "\" & FileName) Then
CreateDesktopFile lF & "\" & FileName, lIF
Else
Errors.Add lF, lF & " - " & Mess(6)
Exit Sub
End If
End Sub
Sub CheckParam
If WScript.Arguments.Count = 0 Then
MessBox Mess(1), 1
Quit
End If
FF = WScript.Arguments(0)
ListFlag = FSO.FileExists(FF)
If (Not ListFlag) And (Not FSO.FolderExists(FF)) Then
MessBox Mess(2), 1
Quit
End If
If WScript.Arguments.Count > 1 Then
IconFile = WScript.Arguments(1)
If IconFile <> "" Then IconFile = GetPath(IconFile)
Else
IconFile = ""
End If
If WScript.Arguments.Count > 2 Then
Mode = WScript.Arguments(2)
If Mode = "" Then
Mode = DefaultMode
Else
If IsNumeric(Mode) Then
Mode = CInt(Mode)
Else
MessBox Mess(11), 1
Quit
End If
If Not((Mode = 0) Or (Mode = 1) Or (Mode = 2) Or (Mode = 3)) Then
MessBox Mess(11), 1
Quit
End If
End If
Else
Mode = DefaultMode
End If
If (Mode = 0) And (IconFile = "") Then
MessBox Mess(12), 1
Quit
End If
If (IconFile <> "") And (Not FSO.FileExists(IconFile)) Then
MessBox Mess(3), 1
Quit
End If
End Sub
Sub Quit
Set Errors = Nothing
Set WSH = Nothing
Set FSO = Nothing
WScript.Quit
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
Function JoinErr(pDic)
Dim lKey
For Each lKey In pDic
JoinErr = JoinErr & vbNewLine & vbNewLine & pDic(lKey)
Next
JoinErr = Mess(8) & JoinErr
End Function
Sub CreateDesktopFile(pFile, pIconFile)
Dim oFile
Set oFile = FSO.CreateTextFile(pFile)
With oFile
.WriteLine "[.ShellClassInfo]"
.WriteLine "IconFile=" & pIconFile
.WriteLine "IconIndex=0"
.Close
End With
Set oFile = FSO.GetFile(pFile)
oFile.Attributes = oFile.Attributes or FileAttr
Set oFile = Nothing
End Sub
Sub SetFoldAttr(pFolder)
Dim oDir
Set oDir = FSO.GetFolder(pFolder)
oDir.Attributes = oDir.Attributes or FoldAttr
Set oDir = Nothing
End Sub
Function GetPath(pPath)
GetPath = FSO.GetAbsolutePathName(WSH.ExpandEnvironmentStrings(pPath))
End Function
Function GetIconFile(pFolder, pFile)
Dim lFile
If Mode = 0 Then
GetIconFile = pFile
Exit Function
End If
If Mode < 3 Then
If pFile <> "" Then
GetIconFile = pFile
Exit Function
Else
lFile = pFolder & "\" & FSO.GetBaseName(pFolder) & ".exe"
If FSO.FileExists(lFile) Then
GetIconFile = lFile
Exit Function
End If
For Each lFile In FSO.GetFolder(pFolder).Files
If UCase(FSO.GetExtensionName(lFile)) = "EXE" Then
If (UCase(Left(lFile, 5)) <> "UNINS") Or _
(UCase(FSO.GetBaseName(lFile)) <> "UNWISE") Then
GetIconFile = lFile
Exit Function
End If
End If
Next
If Mode = 2 Then
GetIconFile = OpenFile(pFolder)
Else
GetIconFile = ""
End If
End If
Else
GetIconFile = OpenFile(pFolder)
End If
End Function
Function OpenFile(pFolder)
Dim Dlg
On Error Resume Next
Set Dlg = CreateObject("MSComDlg.CommonDialog")
If Err.Number = 0 Then
On Error GoTo 0
With Dlg
.InitDir = pFolder
.Filter = Mess(10)
.Flags = &H4 + &H8 + &H400 + &H1000 + &H80000
.FilterIndex = 1
.MaxFileSize = 32000
.CancelError = True
.DialogTitle = Mess(9) & """" & pFolder & """"
On Error Resume Next
.ShowOpen
End With
If Err.Number = 0 Then
OpenFile = Dlg.FileName
Else
OpenFile = ""
End If
On Error GoTo 0
Set Dlg = Nothing
Else
On Error GoTo 0
Dlg = InputBox(Mess(9) & """" & pFolder & """", Mess(0), pFolder & "\")
If Dlg <> "" Then Dlg = GetPath(Dlg)
If Not FSO.FileExists(Dlg) Then Dlg = ""
OpenFile = Dlg
End If
End Function
|
Может работать для нескольких выделенных папок.
Если будут проблемы с лицензией на объект MSComDlg, нужно поправить реестр вот этим reg-файлом: | Code: | REGEDIT4
[HKEY_CLASSES_ROOT\Licenses\4D553650-6ABE-11cf-8ADB-00AA00C00905]
@="gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj"
[HKEY_CLASSES_ROOT\Licenses\78E1BDD1-9941-11cf-9756-00AA00C00908]
@="yjrjvqkjlqqjnqkjvprqsjnjvkuknjpjtoun" |
Если объект MSComDlg вообще не создается, нужно найти и зарегистрировать COMDLG32.OCX.
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
Andrey_A
Joined: 10 Apr 2009
Posts: 394
Location: Сочи
|
| (Separately) Posted: Sat Dec 19, 2009 12:31 Post subject: |
|
|
В продолжении темы
Появилась проблема, помогите решить
1 Есть файл-список путей папок Пути.txt
2 Есть библиотека значков %WINDIR%\Wcmicons.dll
3 Есть файл-список соответствующих к папкам номеров иконок из этой библиотеки Номера.txt
Задача Задать каждой папке иконку,т.е. создать в каждой папке файл desktop.ini для XP и Vista
Конструкция файла такая: | Code: | [.ShellClassInfo]
IconFile=%WINDIR%\Wcmicons.dll
IconIndex=1457
IconResource=%WINDIR%\Wcmicons.dll,1457 |
Я пользуюсь в основном vbs скриптами, и если скрипт будет написан в vbs, то будет отлично |
|
| 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
