今天无聊，发一个以前的试验品 超快感搜索令 v1.0
本帖最后由 狂刀lxx 于 2011-5-10 22:14 编辑今天无聊，发一个以前的试验品 超快感搜索令 v1.0
;| xdir,(xdir path fn) = 超快感搜索令 v1.0 (函数版)-----ok!!----by lxx.2005.10
说明: 1. 因为太快了，根本不需要在状态条显示搜索过程!!故名"超快感搜索令".
2. 参考: c:xfind = 超快感搜索令 v1.0 (对话框版)
技巧: 1. 应用到 添加acad.pgp并更新re-init技术!
2. 应用到调用系统选择目录对话框.
3. 应用到shell参数4不闪屏。
4. 应用到外部命令: dir /s/b >文件名 取得搜索结果.
测试:
命令: xdir
"c:\\WINDOWS\\system32\\Comdlg32.ocx"
00时00分01.65秒
;; 8G硬盘.
命令: xdir
输入文件名(支持通配符):acad*.lsp
"C:\\Program Files\\LiZheng\\LAr2004\\SYS\\acaddoc.lsp"
"C:\\Program Files\\AutoCAD 2004\\Express\\acadinfo.lsp"
"C:\\Program Files\\AutoCAD 2004\\Support\\acadinfo.lsp"
"C:\\Program Files\\AutoCAD 2004\\Support\\acad2004.lsp"
"C:\\Program Files\\AutoCAD 2004\\Support\\acad2004doc.lsp"
"C:\\a14\\Acad.lsp"
00时00分01.98秒
|;
;;命令方式:
(defun c:xdir ()
(xdir nil nil)
(princ)
)
;| 主函数: (xdir path fn) = 超快感搜索令-------by lxx.2005.10
参数: path = 搜索路径. 当为nil.自动显示系统选择目录对话框(qf_getfolder msg).
fn = filename,支持通配符的文件名，如： acad*.lsp .当为nil,自动提示输入.
返回: 搜索结果列表. 搜索过程显示搜索内容.
|;
(defun xdir (path filename / f a lst)
;;(setq path "c:\\")
;;(setq filename "acad*.lsp")
(if (not path)
(setq path (qf_getFolder "选择搜索目录:"))
) ;(getfiled "" "" "" 4)
(if (not filename)
(setq filename (getstring "\n输入文件名(支持通配符):"))
)
(if (and path filename)
(progn
(x!-time)
(x-addpgp "XSHELL, , 4,*OS Command: ," '*xshell*);检测及初始化xshell外部命令
(command "xshell"
(strcat "dir " path filename " /s/b >c:\\xdir.tmp")
)
(setq f (open "c:\\xdir.tmp" "r"))
(while (setq a (read-line f))
(setq lst (cons a lst))
)
(close f)
(vl-file-delete "c:\\xdir.tmp")
(mapcar 'print lst)
(x!-runtime)
)
)
lst
)
;|(x-addpgp str) = 在acad.pgp中添加一行内容.
可用于初始化xshell外部命令
如果acad.pgp没有以下一行，自行加入。
"XSHELL,,4,*OS Command: ,"
定义外部命令，参数4为隐藏自行!
设置后 设全局变量*xshell*为T.第二次运行即可不用打开acad.pgp来判断.
!!!!调用方法:!!!!
(x-addpgp "XSHELL, , 4,*OS Command: ," '*xshell*)
|;
(defun x-addpgp (str key / fn f a k)
(if (not (eval key))
(progn
(setq fn (findfile "acad.pgp"))
(setq f (open fn "r"))
(while (and (setq a (read-line f))
(setq k (/= a str)))
)
(close f)
(if k
(progn
(setq f (open fn "a"))
(write-line str f)
(close f)
(setvar "re-init" 16) ; reinit acad.pgp !!!!!
)
)
(set key T)
)
)
)
;| (x!-time)...(x!-runtime) = 求测试程序运行时间.---ok!---by lxx.2005.10
说明:(x!-time)..[过程代码]...(x!-runtime) 配套使用.
|;
(defun x!-time ()
(setq *x!-time (getvar "cdate"))
)
;;
(defun x!-runtime ( / tm tm$) ;*x!-time 全局.
(print)
(if *x!-time
(progn
(setq tm(- (getvar "cdate") *x!-time)
tm$ (rtos tm 2 8))
(mapcar '(lambda(x y / a)(princ (strcat(setq a (substr tm$ x 2)) y)) a) '(3 5 7 9)'("时" "分" "." "秒"))
)
)
)
;; (qf_getFolder "")
(defun qf_getFolder (msg / WinShell shFolder path catchit)
(vl-load-com)
(setq winshell (vlax-create-object "Shell.Application")); (vlax-dump-object winshell T)
(setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
(setq
catchit (vl-catch-all-apply
'(lambda ()
(setq shFolder (vlax-get-property shFolder 'self))
(setq path (vlax-get-property shFolder 'path))
)
)
)
(if (vl-catch-all-error-p catchit)
nil
path
)
)
灰常好，我原来用程序查找ACAD.LSP ACAD.FAS。不懂要用到几分钟呢
;| xdirx = 超快感搜索令 v1.0 (对话框版)-----ok!!----by lxx.2005.10
说明: 1. 因为太快了，根本不需要在状态条显示搜索过程!!故名"超快感搜索令".
2. 参考: c:xfind = 超快感搜索令 v1.0 (函数版)
技巧: 1. 应用到 添加acad.pgp并更新re-init技术!
2. 应用到调用系统选择目录对话框.
3. 应用到shell参数4不闪屏。
4. 应用到外部命令: dir /s/b >文件名 取得搜索结果.
5. 应用到 自动生成对话框文件并加载 技术. !!!
测试:
;; 8G硬盘.
命令: xfindx
|;
;;命令方式:
;;; 主命令:
(defun c:xfindx (/ dcl_id dclfn dd $lst)
;检测或生成xfindx.dcl.
(setq dcl_id (load_dialog (setq dclfn (xdcl-create-xfindx)))) ;加载xfindx.dcl
(new_dialog "xfindx" dcl_id) ;获得对话框句柄.
;;预定义按钮操作.
(action_tile "getfolder"
"(set_tile \"searchfolder\" (qf_getFolder \"选择搜索路径:\"))")
(action_tile "accept"
"(setq folder (get_tile \"searchfolder\"))
(setq fname (get_tile \"fname\"))
(if (and folder fname)
(done_dialog 1)
(alert \"请选择目录，输入搜索文件名。\n通配符如: acad*.lsp|acad*.*\")
)")
;; 激活对话框.
(setq dd (start_dialog))
(unload_dialog dcl_id)
(if (= dd 1);由(done_dialog 1)返回的值.
(if (setq $lst (xdir folder fname))
(xfinx-get $lst dclfn);选择文件.
(alert "\n!没有找到!")
)
)
(princ)
)
;| (xfinx-get $lst dclfn) = 从搜索结果中选择需要的文件，返回列表-----by lxx.2005.10
参数: $lst = 搜索到的所有文件列表.
dclfn = 对话框文件.
返回: 选择到的文件列表.
|;
(defun xfinx-get ($lst dclfn / $runtime dcl_id dd til fns fnss)
(setq allkey nil til nil)
(setq dcl_id (load_dialog dclfn))
(new_dialog "select" dcl_id)
(start_list "selfn")
(mapcar 'add_list $lst)
(end_list)
(set_tile "runtime" $runtime)
(action_tile "selfn"
"(set_tile \"selfn\" $value)
(setq fnss (xl-subilst $lst (read(strcat \"(\"(get_tile \"selfn\") \")\"))))
(print fnss)
"
)
(action_tile "accept"
"(if fnss
(done_dialog 1)
(alert \"请选择文件名(可多选)\")
)")
(action_tile "selall" "(set_tile \"selfn\" (listall$i $lst))(setq fnss $lst)")
(action_tile "info" "(alert \"狂刀制造 2005.10\")")
;;激活
(setq dd (start_dialog))
(unload_dialog dcl_id)
(princ "\n 搜索结果:\n")
(cond
((= dd 2)(mapcar 'print fnss));返回所有文件列表.
((= dd 1)
(mapcar (function (lambda (x)
(if (member x fnss)
(setq fnss (vl-remove x fnss))
(setq fnss (cons x fnss))
)
)
)
fns
)
fnss ;返回选到的文件列表.
)
)
)
;| (listall$i lst) = 取得列表的序号字符串(空格分开).----by lxx.2005.11
(listall$i '(a b c d)) -> "0 1 2 3"
|;
(defun listall$i ($lst / i str)
(setq str "" i -1)
(mapcar '(lambda(x)(setq str (strcat str (itoa(setq i(1+ i))) " "))) $lst)
(vl-string-right-trim " " str)
)
;|
(xl-subilst lst ilst) = 从ilst序号表提取lst表格元素组新表.
测试: (xl-subilst '(a b c d e) '(0 2 3)) -> '(A C D)
|;
(defun xl-subilst (lst ilst /)
(mapcar '(lambda(x)(nth x lst)) ilst)
)
;| 主函数: (xdir path fn) = 超快感搜索令-------by lxx.2005.10
参数: path = 搜索路径. 当为nil.自动显示系统选择目录对话框(qf_getfolder msg).
fn = filename,支持通配符的文件名，如： acad*.lsp .当为nil,自动提示输入.
返回: 搜索结果列表. 搜索过程显示搜索内容.
|;
(defun xdir (path filename / f a lst)
(if (not path)
(setq path (qf_getFolder "选择搜索目录:"))
) ;(getfiled "" "" "" 4)
(if (not filename)
(setq filename (getstring "\n输入文件名(支持通配符):"))
)
(if (and path filename)
(progn
(x!-time)
(x-addpgp "XSHELL, , 4,*OS Command: ," '*xshell*);检测及初始化xshell外部命令
(command "xshell"
(strcat "dir " path filename " /s/b >c:\\xdir.tmp")
)
(setq f (open "c:\\xdir.tmp" "r"))
(while (setq a (read-line f))
(setq lst (cons a lst))
)
(close f)
(vl-file-delete "c:\\xdir.tmp")
;(mapcar 'print lst);对话框版本取消本行.
(setq $runtime (x!-runtime))
)
)
lst
)
;|(x-addpgp str) = 在acad.pgp中添加一行内容.
可用于初始化xshell外部命令
如果acad.pgp没有以下一行，自行加入。
"XSHELL,,4,*OS Command: ,"
定义外部命令，参数4为隐藏自行!
设置后 设全局变量*xshell*为T.第二次运行即可不用打开acad.pgp来判断.
!!!!调用方法:!!!!
(x-addpgp "XSHELL, , 4,*OS Command: ," '*xshell*)
|;
(defun x-addpgp (str key / fn f a k)
(if (not (eval key))
(progn
(setq fn (findfile "acad.pgp"))
(setq f (open fn "r"))
(while (and (setq a (read-line f))
(setq k (/= a str)))
)
(close f)
(if k
(progn
(setq f (open fn "a"))
(write-line str f)
(close f)
(setvar "re-init" 16) ; reinit acad.pgp !!!!!
)
)
(set key T)
)
)
)
;| (x!-time)...(x!-runtime) = 求测试程序运行时间.---ok!---by lxx.2005.10
说明:(x!-time)..[过程代码]...(x!-runtime) 配套使用.
|;
(defun x!-time ()
(setq *x!-time (getvar "cdate"))
)
;;
(defun x!-runtime ( / tm tm$) ;*x!-time 全局.
(print)
(if *x!-time
(progn
(setq tm(- (getvar "cdate") *x!-time)
tm$ (rtos tm 2 8))
(mapcar '(lambda(x y / a)(princ (strcat(setq a (substr tm$ x 2)) y)) a) '(3 5 7 9)'("时" "分" "." "秒"))
)
)
)
;; (qf_getFolder "")
(defun qf_getFolder (msg / WinShell shFolder path catchit)
(vl-load-com)
(setq winshell (vlax-create-object "Shell.Application")); (vlax-dump-object winshell T)
(setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
(setq
catchit (vl-catch-all-apply
(function(lambda ()
(setq shFolder (vlax-get-property shFolder 'self))
(setq path (vlax-get-property shFolder 'path))
))
)
)
(if (vl-catch-all-error-p catchit)
nil
path
)
)
;; 自动生成xfindx.dcl对话框文件,保存在 (getVAR "LOCALROOTPREFIX")目录下.
;; 返回:文件名: 路径+"xfindx.dcl".
;; (xdcl-create-xfindx)
(defun xdcl-create-xfindx (/ dclname dlg$lst f)
(setq dclname
(strcat (getVAR "LOCALROOTPREFIX") "xfindx.dcl")
)
(setq dlg$lst
(list
"xfindx:dialog{"
"label=\"超快感搜索令 v1.0 (对话框版) 狂刀制造------v0510-1.0\";"
":row{"
":edit_box{label=\"搜索路径:\";key=\"searchfolder\";value=\"c:\\\\\";width=40;}"
":button {label=\" 指定路径 \";key=\"getfolder\";}" "}" ":row{"
":edit_box{label=\"文 件 名:\";key=\"fname\";value=\"*.lsp\";width=42;}"
":button {label=\"狂搜\";key=\"accept\";}"
":button {label=\"退出\";is_cancel=true;key=\"cancel\";}"
"}"
"}"
"select:dialog{"
"label=\"超快感搜索令 v1.0 (对话框版) 狂刀制造------v0510-1.0\";"
":text{label=\"搜索用时:\";key=\"runtime\";}"
":list_box{label=\"选择文件:\";key=\"selfn\";multiple_select=true;height=20;}"
":boxed_row{"
"label=\"操作:\";"
":column{"
":radio_button {label=\"输出\";key=\"retkey\";value=1;}"
":radio_button {label=\"删除\";key=\"delkey\";value=0;}"
":radio_button {label=\"编辑\";key=\"editkey\";value=0;}"
"}"
":column{"
":toggle{label=\"全选所有选项\";key=\"selall\";}"
":row{"
":button {label=\"编辑程序\";key=\"getexef\";}"
":button {label=\"作者信息\";key=\"info\";}"
"}"
":row{"
":button {label=\"确定\";key=\"accept\";}"
":button {label=\"退出\";key=\"cancel\";is_cancel=true;}"
"}"
"}"
"}"
"}"
)
)
(if (not (findfile dclname))
(progn
(setq f (open dclname "W"))
(foreach x dlg$lst (write-line x f))
(close f)
)
)
dclname
)
灰常好，我原来用程序查找ACAD.LSP ACAD.FAS。不懂要用到几分钟呢 本帖最后由 highflybird 于 2011-5-10 22:34 编辑
回复 狂刀lxx 的帖子
好像找不到xshell,是要在你的库中加载么？楼主这次是要精品大奉献了。
另外，关于搜索问题，我以前用过API搜索，也可以达到极致。在我的《CAD 垃圾文件清除工具》中。
本帖最后由 qjchen 于 2011-5-10 22:46 编辑
:)，谢谢狂刀兄的好程序，真是很快
我现在一般都用Everything这个软件来搜索东西，也是快的离谱。
每次重启系统之后打开需要10来秒，之后每次搜索， 500G硬盘都是<0.1秒
它用的方法和狂刀兄的比较类似，不过它应该是读取了ntfs分区内的一个文件索引 用了(x-addpgp "XSHELL, , 4,*OS Command: ," '*xshell*);检测及初始化xshell外部命令
没有添加成功么？
其实我还是希望搜索能支持正则表达式的。那样更好。 了解，明白 回复 狂刀lxx 的帖子
while (setq a (read-line f))----在这个地方中断， f的数值为nil
Command: xdir
输入文件名(支持通配符):*.lsp
xshell Unknown command "XSHELL".Press F1 for help.
Command: dir C:\*.lsp /s/b >c:\xdir.tmp Unknown command "DIR C:\*.LSP /S/B
>C:\XDIR.TMP".Press F1 for help.
Command: ; error: bad argument type: FILE nil
; reset after error
页:
[1]
2