Снятие и установка атрибутов с файлов

Материал из TCKB 2.0

Так получается, что мне по работе часто приходится снимать признак ReadOnly с файлов. В принципе, можно для этого пользоваться и свойствами файлов, и командой изменения атрибутов в TC, но мне совсем не хотелось поднимать какие-либо диалоговые окна. Вот и написал скрипт, вызываемый по кнопке.

Код кнопки
TOTALCMD#BAR#DATA: %COMMANDER_PATH%\Utils\WHS\RemoveReadOnly.vbs %L %COMMANDER_PATH%\Icons\X-Qute.icl,28 Снятие признака Read-Only -1

Соответственно, пути к скрипту и файлу значка у вас могут свои.
Скрипт RemoveReadOnly.vbs:

'===================================================================== 
' Снятие признака Read-Only с отмеченных файлов и папок (файлов в них) 

' В параметрах вызова из TC должно быть прописано: 
' %L 
'===================================================================== 

Dim FSO, StreamFile 
Set FSO = CreateObject("Scripting.FileSystemObject") 
Set StreamFile = FSO.OpenTextFile(WScript.Arguments(0), 1) 
 
Dim Selected, CurrFile, CurrFolder 
Do While Not StreamFile.AtEndOfStream 
  Selected = StreamFile.ReadLine 
  If FSO.FileExists(Selected) Then 
    Set CurrFile = FSO.GetFile(Selected) 
    CurrFile.Attributes = CurrFile.Attributes And Not Attr 
  End If 
  If FSO.FolderExists(Selected) Then 
    Set CurrFolder = FSO.GetFolder(Selected) 
    FolderProcess(CurrFolder) 
  End If 
Loop 
'MsgBox("Выполнено!") 
Wscript.Quit() 
 
Function FolderProcess(CurrFolder) 
  Dim sf, f 
  For Each sf in CurrFolder.SubFolders 
    FolderProcess(sf) 
  Next 
  For Each f in CurrFolder.Files 
    f.Attributes = f.Attributes And Not 1 
  Next 
End Function

Выше я описал, как принудительно снять атрибут у файлов.
Теперь есть задача:
Нужно файлам присваивать атрибут – скрытый, без лишних вопросов.
Во-первых, возможные атрибуты (можно изменить описанный ниже скрипт):

Normal      0    Normal file. No attributes are set.
ReadOnly    1    Read-only file. Attribute is read/write.
Hidden      2    Hidden file. Attribute is read/write.
System      4    System file. Attribute is read/write.
Volume      8    Disk drive volume label. Attribute is read-only.
Directory   16   Folder or directory. Attribute is read-only.
Archive     32   File has changed since last backup. Attribute is read/write.
Alias       64   Link or shortcut. Attribute is read-only.
Compressed  128  Compressed file. Attribute is read-only.

Теперь кнопка:

Код кнопки
TOTALCMD#BAR#DATA: %COMMANDER_PATH%\Utils\WHS\SetHidden.vbs %L %COMMANDER_PATH%\Icons\X-Qute.icl,28 Снятие признака Read-Only -1

Скрипт SetHidden.vbs:

'===================================================================== 
' Установка признака Hidden у отмеченных файлов и папок (файлов в них) 

' В параметрах вызова из TC должно быть прописано: 
' %L 
'===================================================================== 

Dim FSO, StreamFile 
Set FSO = CreateObject("Scripting.FileSystemObject") 
Set StreamFile = FSO.OpenTextFile(WScript.Arguments(0), 1) 
 
Dim Selected, CurrFile, CurrFolder, Attr 
Attr = 2 ' Атрибут "Hidden" 
Do While Not StreamFile.AtEndOfStream 
  Selected = StreamFile.ReadLine 
  If FSO.FileExists(Selected) Then 
    Set CurrFile = FSO.GetFile(Selected) 
    CurrFile.Attributes = CurrFile.Attributes Or Attr 
  End If 
  If FSO.FolderExists(Selected) Then 
    Set CurrFolder = FSO.GetFolder(Selected) 
    FolderProcess(CurrFolder) 
  End If 
Loop 
'MsgBox("Выполнено!") 
Wscript.Quit() 
 
Function FolderProcess(CurrFolder) 
  Dim sf, f 
  For Each sf in CurrFolder.SubFolders 
    FolderProcess(sf) 
  Next 
  For Each f in CurrFolder.Files 
    f.Attributes = f.Attributes Or Attr 
  Next 
End Function

Тоже самое для папок:

Кнопка:

Код кнопки
TOTALCMD#BAR#DATA: %COMMANDER_PATH%\Utils\WHS\SetAttr.vbs %L 2 %COMMANDER_PATH%\Icons\X-Qute.icl,28 Установка атрибута "Скрытый" -1

Скрипт (немного поправленный и обобщенный) SetAttr.vbs:

'===================================================================== 
' Установка атрибута у отмеченных файлов и папок (файлов в них) 

' В параметрах вызова из TC должно быть прописано: 
' %L {битовый флаг атрибута} 
' например, для атрибута "Hidden" ("Скрытый"): 
' %L 2 
'===================================================================== 

Dim FSO, StreamFile 
Set FSO = CreateObject("Scripting.FileSystemObject") 
Set StreamFile = FSO.OpenTextFile(WScript.Arguments(0), 1) 
 
Dim Selected, CurrFile, CurrFolder, Attr 
Attr = WScript.Arguments(1) 
Do While Not StreamFile.AtEndOfStream 
  Selected = StreamFile.ReadLine 
  If FSO.FileExists(Selected) Then 
    Set CurrFile = FSO.GetFile(Selected) 
    CurrFile.Attributes = CurrFile.Attributes Or Attr 
  End If 
  If FSO.FolderExists(Selected) Then 
    Set CurrFolder = FSO.GetFolder(Selected) 
    CurrFolder.Attributes = CurrFolder.Attributes Or Attr 
    FolderProcess(CurrFolder) 
  End If 
Loop 
'MsgBox("Выполнено!") 
Set FSO        = Nothing 
Set StreamFile = Nothing 
Set CurrFile   = Nothing 
Set CurrFolder = Nothing 
Wscript.Quit() 
 
Function FolderProcess(CurrFolder) 
  Dim sf, f 
  For Each sf in CurrFolder.SubFolders 
    sf.Attributes = sf.Attributes Or Attr 
    FolderProcess(sf) 
  Next 
  For Each f in CurrFolder.Files 
    f.Attributes = f.Attributes Or Attr 
  Next 
End Function

Кнопка для снятия атрибута:

Код кнопки
TOTALCMD#BAR#DATA: %COMMANDER_PATH%\Utils\WHS\RemoveAttr.vbs %L 2 %COMMANDER_PATH%\Icons\X-Qute.icl,28 Снятие атрибута "Скрытый" -1

Скрипт RemoveAttr.vbs:

'===================================================================== 
' Снятие атрибута с отмеченных файлов и папок (файлов в них) 

' В параметрах вызова из TC должно быть прописано: 
' %L {битовый флаг атрибута} 
' например, для атрибута "Hidden" ("Скрытый"): 
' %L 2 
'===================================================================== 

Dim FSO, StreamFile 
Set FSO = CreateObject("Scripting.FileSystemObject") 
Set StreamFile = FSO.OpenTextFile(WScript.Arguments(0), 1) 
 
Dim Selected, CurrFile, CurrFolder, Attr 
Attr = WScript.Arguments(1) 
Do While Not StreamFile.AtEndOfStream 
  Selected = StreamFile.ReadLine 
  If FSO.FileExists(Selected) Then 
    Set CurrFile = FSO.GetFile(Selected) 
    CurrFile.Attributes = CurrFile.Attributes And Not Attr 
  End If 
  If FSO.FolderExists(Selected) Then 
    Set CurrFolder = FSO.GetFolder(Selected) 
    CurrFolder.Attributes = CurrFolder.Attributes And Not Attr 
    FolderProcess(CurrFolder) 
  End If 
Loop 
'MsgBox("Выполнено!") 
Set FSO        = Nothing 
Set StreamFile = Nothing 
Set CurrFile   = Nothing 
Set CurrFolder = Nothing 
Wscript.Quit() 
 
Function FolderProcess(CurrFolder) 
  Dim sf, f 
  For Each sf in CurrFolder.SubFolders 
    sf.Attributes = sf.Attributes And Not Attr 
    FolderProcess(sf) 
  Next 
  For Each f in CurrFolder.Files 
    f.Attributes = f.Attributes And Not Attr 
  Next 
End Function

Меня тут Zorroz попросил выложить скрипт для снятия иконки, т.е. снятия атрибута "Только чтение" у папки и удаления desktop.ini. Мне не хотелось этого делать, т.к. считаю, что удаление desktop.ini не всегда "есть хорошо", но он меня уговорил :):

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

Batya

Снятие и установка атрибутов с файлов

Материал из TCKB 2.0

Просмотры

Личные инструменты

Навигация

Поиск

Инструменты

Разное

Реклама