Total Commander

Код: Выделить всё

'========================================================
' Снятие иконки у папки в 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

Код: Выделить всё

[.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

Код: Выделить всё

'=========================================================================
' Задание иконок у папок (создание файлов 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

Код: Выделить всё

REGEDIT4 
 
[HKEY_CLASSES_ROOT\Licenses\4D553650-6ABE-11cf-8ADB-00AA00C00905] 
@="gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj" 
 
[HKEY_CLASSES_ROOT\Licenses\78E1BDD1-9941-11cf-9756-00AA00C00908] 
@="yjrjvqkjlqqjnqkjvprqsjnjvkuknjpjtoun"

Код: Выделить всё

[.ShellClassInfo]
IconFile=%WINDIR%\Wcmicons.dll
IconIndex=1457
IconResource=%WINDIR%\Wcmicons.dll,1457