最新消息:XAMPP默认安装之后是很不安全的,我们只需要点击左方菜单的 "安全"选项,按照向导操作即可完成安全设置。

[lisp源码]通用函数 文件系统操作

XAMPP新闻 admin 100浏览 0评论
 lisp源码,功能为4个与文件系统操作相关的自定义函数。
01—内容提要

本文提供4个自定义函数,功能如下:

(ZL-file-IsTrue "d:\\test.txt")    ;_判断文件是否存在

(ZL-file-GetAllInfo "d:\\test.txt" )  ;_返回文件的所有信息

(ZL-file-IsReadOnly "d:\\test.txt")  ;_检查文件是否为只读

(ZL-file-SetReadOnly "d:\\test.txt" T)    ;_设置文件为只读与否

 

02—

lisp源码

;;;=================================================================*
;;; 通用函数 文件系统FSO *
;;; *
;;;日期:zml84 于 2011-12-07 *
;;;=================================================================*
;;;加载时,即执行部分。*
;;;功能:检查、设置全局变量 *
(vl-load-com)
(or *FSO*
(setq
*FSO* (vlax-get-or-create-object “Scripting.FileSystemObject”)
)
)
;;;=================================================================*
;;;功能:判断文件是否存在 *
;;;测试: (ZL-file-IsTrue “d:\\test.txt”) *
;;;返回:若存在,返回T;否则,返回nil。*
(Defun ZL-file-ISTrue (filename)
(= (vlax-invoke *FSO* “FileExists” filename) -1)
)
;;;=================================================================*
;;;功能:返回文件的所有信息 *
;;;参数:filename ——目标文件名称,字符串格式 *
;;;返回:包含文件信息的表。

;|”DATECREATED” 创建日期
“DATELASTMODIFIED” 修改日期
“DATELASTACCESSED” 最后一次访问时间
“TYPE” 文件类型
“SIZE” 文件大小
“ATTRIBUTES” 文件属性
|;
;;;日期:zml84 于 2011-12-07 *
;;;测试:(ZL-file-GetAllInfo “d:\\test.txt” ) *
(Defun ZL-file-GetAllInfo (filename / Obj Val)
(setq Obj (vlax-invoke *FSO* “GetFile” filename))
(setq val (mapcar (function (lambda (str)
(cons str (vlax-get Obj str))
)
)
‘(“DATECREATED” “DATELASTMODIFIED”
“DATELASTACCESSED” “TYPE”
“SIZE” “ATTRIBUTES”
)
)
)
;;释放资源
(if (= (type Obj) ‘vla-object)
(vlax-release-object Obj)
)
;;返回
Val
)
;;;=================================================================*
;;; 检查文件是否为只读。*
;;;日期:zml84 于 2011-12-07 *
;;;测试: (ZL-file-IsReadOnly “d:\\test.txt”) *
;;;返回:若是,返回T;若非,返回nil。*
(defun ZL-file-IsReadOnly (FileName / int ReadOnly)
(setq int (cdr (assoc “ATTRIBUTES” (ZL-file-GetAllInfo FileName)))
ReadOnly 1 ;_只读常量
)
(= (Boole 1 int ReadOnly) ReadOnly)
)
;;;=================================================================*
;;; 设置文件为:只读,或非只读。*
;;;日期:zml84 于 2011-12-07 *
;;;测试: (ZL-file-SetReadOnly “d:\\test.txt” T) *
;;;返回:若成功,返回T;若失败,返回nil。*
(defun ZL-file-SetReadOnly (FileName TorNIL / int ReadOnly obj)
;;============
;;1、获取当前值
(setq int (cdr (assoc “ATTRIBUTES” (ZL-file-GetAllInfo FileName)))
ReadOnly 1 ;_只读常量
)
;;============
;;2、分析目标值
;;若目标为只读
(if (and TorNIL
(= (ZL-file-IsReadOnly FileName) nil)
)
(setq int_new (+ int ReadOnly))
)
;;若目标为非只读
(if (and (not TorNIL)
(ZL-file-IsReadOnly FileName)
)
(setq int_new (- int ReadOnly))
)
;;============
;;3、设置目标值
(if int_new
(progn
(setq Obj (vlax-invoke *FSO* “GetFile” filename))
(vlax-put Obj “ATTRIBUTES” int_new)
)
)
;;释放资源
(if (= (type Obj) ‘vla-object)
(vlax-release-object Obj)
)
;;============
;;4、检查,并返回
(= (ZL-file-IsReadOnly FileName) TorNIL)
)
;;;==============================================================

转载请注明:XAMPP中文组官网 » [lisp源码]通用函数 文件系统操作