Andrey_A
|
 Posted: Thu Dec 30, 2010 00:56 Post subject: |
 |
|
Идея показалась интересной, написал скрипт, возможно решит проблему
| Code: | '======================================================================
' Присвоение значков выделенным Папкам по содержимому
' Ассоциированные значкам папки и расширения считываются из файла
' Синаксис файла:
' Путь\к\значку{библиотека,номер}=;Папка1;Папка2;расширение1;расширение2;...
' d:\Картинки\Иконки\Архив.ico=;Архивы;Архив;7z;7zip;rar;
' %SystemRoot%\system32\shell32.dll,-236=;Музыка;mp3;wal;
' %COMMANDER_PATH%\Wcmicons.icl,1854=;Текст;Документы;doc;docx;txt;
' %WINDIR%\Wcmicons.dll,1457=;TC Image;Total Commander;
'======================== Параметры ===================================
' В параметрах вызова из TC должно быть прописанo 2параметра:
' {Cписок файлов} {путь\к\файлу_ассоциаций}
'======================== Примеры ===================================
' %L "%%COMMANDER_PATH%%\Scripts\AddIcons\IconsOnAssFolders.txt"
'
' Автор: Аверин Андрей (30.12.2010)
' Версия: 1.0
'======================================================================
Option Explicit
Dim FSO, WSH, List, ExtLine, Name, Ext, Files, i, k, FF, IC, NN
Set FSO = CreateObject("Scripting.FileSystemObject")
If WScript.Arguments.Count < 2 Then
MsgBox "Не хватает параметров!" & vbNewLine &_
"Должно быть минимум Два параметра!" & vbNewLine &_
"%L ""Путь\к\IconsOnAssFolers.txt""" & vbNewLine &_
"A у Вас прописан(о) " & WScript.Arguments.Count & " !!! " , vbOKOnly &_
vbCritical, "Присвоение значков Папкам по содержимому"
Wscript.Quit
End if
Set List = FSO.OpenTextFile(GetPath(WScript.Arguments(0)), 1)
ExtLine = Split(FSO.OpenTextFile(GetPath(WScript.Arguments(1)), 1).ReadAll, vbNewLine)
Do While Not List.AtEndOfStream
FF = GetPath(List.ReadLine)
if Len(FSO.GetExtensionName(FF)) = 0 Then
Name = FSO.GetBaseName(FF)
Ext = Split(";" & Name & ";" & ExtStr(FF), ";")
For i = 0 To Ubound(Ext)
For k = 0 To Ubound(ExtLine)
if InStr(1,UCase(Mid(ExtLine(k), Instr(ExtLine(k), "=") + 1, Len(ExtLine(k)))), ";" & UCase(Ext(i)) & ";") > 0 Then
If Right(FF, 1) <> "\" Then FF = FF & "\"
IC = GetPath(Mid(ExtLine(k), 1, Instr(ExtLine(k), "=") - 1))
if Instr(IC, ",") > 0 Then
IC = GetPath(Mid(ExtLine(k), 1, Instr(ExtLine(k), ",") - 1))
NN = Mid(ExtLine(k), Instr(ExtLine(k), ",") + 1, Instr(ExtLine(k), "=") - Instr(ExtLine(k), ",") - 1)
else
NN = "0"
end if
Desktop FF,IC, NN
i = Ubound(Ext)
k = Ubound(ExtLine)
end if
Next
Next
end if
Loop
List.Close
Set List = Nothing
Set FSO = Nothing
Wscript.Quit
Function GetPath(pPath)
GetPath = FSO.GetAbsolutePathName(CreateObject("WScript.Shell").ExpandEnvironmentStrings(pPath))
End Function
Function ExtStr(FFolder)
Dim Folder
Set Folder = FSO.GetFolder(FFolder)
For Each Files In Folder.Files
Ext = FSO.GetExtensionName(Files)
if Instr(UCase(ExtStr), UCase(Ext)) < 1 Then
ExtStr = ExtStr & Ext & ";"
end if
Next
End Function
Function Desktop(TargetDir,IconFile, Number)
Dim oFile, oDir, Attr, Des
Des = "Desktop.ini"
If FSO.FileExists(TargetDir & Des) Then FSO.DeleteFile (TargetDir & Des)
'Создаём Desktop.ini
If not FSO.FileExists(TargetDir & Des) Then
Set oFile = FSO.CreateTextFile(TargetDir & Des)
oFile.WriteLine "[.ShellClassInfo]"
oFile.WriteLine "IconFile=" & IconFile
oFile.WriteLine "IconIndex=" & Number
oFile.WriteLine "IconResource=" & IconFile & "," & Number
oFile.Close
' Установливаем для файла атрибутов "Скрытый", "Системный", "Архивный"
Attr = 38
Set oFile = FSO.GetFile(TargetDir & Des)
oFile.Attributes = oFile.Attributes or Attr
End If
' Установливаем для папки атрибут "Только чтение"
Attr = 1
Set oDir = FSO.GetFolder(TargetDir)
oDir.Attributes = oDir.Attributes or Attr
End Function |
Необходимо составить свой файл, где будут прописаны значки и ассоциированные им папки пример: | Code: | d:\Картинки\Иконки\Архив.ico=;Архивы;Архив;7z;7zip;rar;
%SystemRoot%\system32\shell32.dll,-236=;Музыка;mp3;wal;
%COMMANDER_PATH%\Wcmicons.icl,1854=;Текст;Документы;doc;docx;txt;
%WINDIR%\Wcmicons.dll,1457=;TC Image;Total Commander;
D:\Картинки\Иконки\Vista My\Текст 004.ico,0=;Книги;djv;djvu;fb2;pdf; |
кнопка на панели тотала: | Code: | TOTALCMD#BAR#DATA
"%COMMANDER_PATH%\Scripts\AddIcons\IconsOnAssFolders.vbs"
%L "%%COMMANDER_PATH%%\Scripts\AddIcons\IconsOnAssFolders.txt"
C:\Windows\System32\WScript.exe
IconsOnAssFolers
-1
|
т.к. тестировал скрипт недолго, возможны недочёты, кто обнаружит сообщите |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
