Файл только для чтения?
Понадобилось мне тут определить, является ли файл "только для чтения". Я помню про функцию vl-file-systime, но иногда ее недостаточно...
Файл для лиспа может быть "ReadOnly" в двух случаях - либо файл открыт каким-либо приложением, либо у него выставлено свойство "ReadOnly". Вариант с настройками прав доступа пока не рассматриваем. Как разрулить эту ситуацию, пока не представляю.
Если файл открыт каким-либо приложением, то вызов функции vl-file-systime вернет nil. Можете попробовать: сохранить текущий файл как c:\1.dwg, например, открыть новую сессию AutoCAD и в ней выполнить
1 | (vl-file-systime "c:\\1.dwg") |
В результате получите nil.
Если файл закрыть, то тот же код вернет список (за подробностями отправляю в справку ;))
А если файл закрыт, но ему установлен атрибут ReadOnly? Поможет наш люто любимый Scripting.FileSystemObject:
1 | (setq svr (vlax-get-or-create-object "Scripting.FileSystemObject")) |
Если его просмотреть, увидим метод GetFile с единственным параметром (именем файла):
1 | (setq obj (vlax-invoke-method svr 'getfile file-name)) |
Просматриваем через vlax-dump-object уже этот объект и обнаруживаем в нем свойство Attributes. Свойство имеет числовое значение, вычисляемое как сумма следующих битов:
| Значение | Имя |
| 0 | Normal |
| 1 | ReadOnly |
| 2 | Hidden |
| 4 | System |
| 8 | Volume (имя диска) |
| 16 | Directory (каталог) |
| 32 | Archive (установлено свойство "Архивный") |
| 64 | Alias (ярлык) |
| 2048 | Compressed |
Поскольку в данный момент нас интересует только свойство ReadOnly, проверяем атрибут на четность - и вуаля, все готово! 
Проверку на наличие файла делать не будем - лишнее.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | (defun _lispru-is-file-read-only (file-name / file_hangle res) ;| * Проверяет, является ли файл "read-only". Возвращает t, если да. Проверки * наличия файла не выполняется. * Параметры вызова: * file-name полное имя файла, с путем. (_lispru-is-file-read-only "Z:\\Test\\Молниезащита.dwg") |; (or (not (vl-file-systime file-name)) ((lambda (/ svr obj res) (setq svr (vlax-get-or-create-object "Scripting.FileSystemObject") obj (vlax-invoke-method svr 'getfile file-name) res (vlax-get-property obj 'attributes) ) ;_ end of setq (vlax-release-object obj) (vlax-release-object svr) (setq obj nil svr nil ) ;_ end of setq (/= (* 2 (/ res 2)) res) ) ;_ end of lambda ) ) ;_ end of or ) ;_ end of defun |
Исходник можно забрать тут.
