旧程序，不过是第一次公布源码， xdirx = 超快感搜索令 v1.1 (对话框B版)

梦断江南

[pcode=lisp,true]
;| xdirx = 超快感搜索令 v1.1 (对话框B版)-----ok!!----by 梁雄啸
v1.0 2005.10
v1.1 2006.5
说明: 1. 因为太快了，根本不需要在状态条显示搜索过程!!故名"超快感搜索令".
      2. 参考: c:xfind = 超快感搜索令 v1.0 (函数版)
技巧: 1. 应用到 添加acad.pgp并更新re-init技术!
      2. 应用到调用系统选择目录对话框.
      3. 应用到shell参数4不闪屏。
      4. 应用到外部命令: dir /s/b >文件名 取得搜索结果.
      5. 应用到 自动生成对话框文件并加载 技术. !!!
      6. !!! 有搜索记忆功能,只要搜过一次,下次再搜,即便是不同的通配符格式,也是眨眼之间完成,可能不到1秒!!
      7. 可记忆上次搜索的路径.
测试:
;; 8G硬盘.
命令: xfindx
|;
;;命令方式:
;;; 主命令:
(defun c:xdirx (/ dcl_id dclfn dd $lst $runtime) ;*path
  ;检测或生成xfindx.dcl.
  (setq dcl_id (load_dialog (setq dclfn (xdcl-create-xfindxb)))) ;自动生成并加载xfindx.dcl
  (new_dialog "xfindx" dcl_id) ;获得对话框句柄.
  ;;预定义按钮操作.
  (if *path (set_tile "searchfolder" *path))
  (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*.*\")
     )")
  (action_tile "dironly"
    "(setq *dironly T)")
  ;; 激活对话框.
  (setq dd (start_dialog))
  (unload_dialog dcl_id)
  (if (= dd 1);由(done_dialog 1)返回的值.
    (if (setq $lst (xdirx folder fname))
      (xfinx-get $lst dclfn);选择文件.
      (alert "\n!没有找到!")
    )
  )
  ;(princ)
)
;| (xfinx-get $lst dclfn) = 从搜索结果中选择需要的文件，返回列表-----by lxx.2005.10
参数: $lst = 搜索到的所有文件列表.
      dclfn = 对话框文件.
返回: 选择到的文件列表.
|;
(defun xfinx-get ($lst dclfn / dcl_id dd til fns fnss dokey ) ;$runtime
  (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)
  (if (and $runtime (= 'STR (type $runtime))) (set_tile "runtime" $runtime))
  (action_tile "selfn"
    "(set_tile \"selfn\" $value)
     (setq fns (xl-subilst $lst (read(strcat \"(\"(get_tile \"selfn\") \")\"))))
     ;(print fns)
    "
  )
  (action_tile "accept"
    "(setq dokey (list (get_tile \"retkey\")(get_tile \"delkey\")(get_tile \"editkey\")(get_tile \"loadkey\")))
     (if (or fnss fns)
         (if (= \"1\" (get_tile \"selall\"))
             (done_dialog 2)
             (done_dialog 1))
         (alert \"请选择文件名(可多选)\")
     )")
  (action_tile "selall"
               "(if (= \"1\" (get_tile \"selall\"))
                    (progn(set_tile \"selfn\" (listall$i $lst))(setq fnss $lst))
                    (progn(set_tile \"selfn\" (listall$i nil))(setq fnss nil))
                 ) "
               ) ;; ok!!!!
  (action_tile "info" "(alert \"作者: 梁雄啸,别名狂刀、陌生人、无痕. \n电子邮件:dreasmsky_lxx@hotmail.com\")")
  ;|(action_tile "delkey" "(setq delk T)")
  (action_tile "loadkey" "(setq loadk T)")
  (action_tile "editkey" "(setq editk T)")|;
  ;;激活
  (setq dd (start_dialog))
  (unload_dialog dcl_id)
  ;(princ "\n 搜索结果:\n")
  (cond
    ((= dd 2);(mapcar 'print fnss));返回所有文件列表.
     ;(print dokey)
     (setq xend fnss));(mapcar 'print fnss))
    ((= dd 1)
     ;(print dokey)
     (setq xend fns)
      ;| (print "dd=1")
      (mapcar '(lambda (x)
                 (if (member x fnss)
                   (setq fnss (vl-remove x fnss))
                   (setq fnss (cons x fnss))
                 )
               )
              fns
      )
      fnss                                ;返回选到的文件列表.
    )|;
     )
  )
  (setq i 0)
  (while (and dokey(/= "1" (car dokey)))
    (setq i (1+ i))
    (setq dokey (cdr dokey))
  )
  ;(mapcar 'princ (list i xend))
  (cond
    ((= i 0)xend);输出
    ((= i 1)(alert "哈,还是不要删除好了..."));删除
    ((= i 2)(mapcar 'startapp xend));编辑
    ((= i 3)
     (mapcar '(lambda (x)
                (cond
                  ((wcmatch x "*.LSP")(load (vl-string-right-trim ".LSP" x)))
                  ((wcmatch x "*.FAS")(load x)) ;; ok
                  ((wcmatch x "*.VLX")(load x)) ;; ok
                  ((wcmatch x "*.ARX")(arxload (vl-string-right-trim ".ARX" x)))
                  ((wcmatch x "*.DVB")(vl-vbaload x))
                  (T (alert (strcat "无法加载" x)))
                )
              )
             (mapcar 'strcase  xend)
     )
     xend
     );加载
  )
  ;(AUTOLOAD (CAR xend))
  ;(princ)
)

;| (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)
)
;| 主函数: (xdirx path fn) = 超快感搜索令-------by lxx.2005.10
参数: path = 搜索路径. 当为nil.自动显示系统选择目录对话框(qf_getfolder msg).
      fn   = filename,支持通配符的文件名，如： acad*.lsp .当为nil,自动提示输入.
返回: 搜索结果列表. 搜索过程显示搜索内容.
|;
;;;(setq path "D:\\ lxx.lsp编译\\"  filename "xdir")
(defun xdirx (path filename / f a lst);$runtime
  (if (not path)
    (setq path (qf_getFolder "选择搜索目录:"))
  )                                        ;(getfiled "" "" "" 4)
  (if (not filename)
    (setq filename (getstring "\n输入文件名(支持通配符):"))
  )
  (if (and path filename)
    (progn
      (x!-time)
      (setq path (strcat (vl-string-right-trim "\\" path) "\\"))
      (setq *path path)
      (x-addpgp "XSHELL, , 4,*OS Command: ," '*xshell*);检测及初始化xshell外部命令
      (princ "\n 正在搜索...")
      (command "xshell"
               (strcat "dir "  "\"" path filename "\"" (if *dironly " /ad" "") " /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 (apply 'strcat (x!-runtime)))
    )
  )
  lst
)
;|(x-addpgp str) = 在acad.pgp中添加一行内容.
可用于初始化xshell外部命令
如果acad.pgp没有以下一行，自行加入。
"XSHELL,,4,*OS Command: ,"
定义外部命令，参数4为隐藏自行!
设置后 设全局变量*xshell*为T.第二次运行即可不用打开acad.pgp来判断.
!!!!调用方法:!!!!
(x-addpgp (setq str "XSHELL, , 4,*OS Command: ,") (setq key '*xshell*))
(setq *xshell* nil)
|;

(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 "" f)
          (write-line "; lxxtools:" f)
          (write-line str f)
          (close f)
          (setvar "re-init" 16) ; reinit acad.pgp !!!!!
        )
      )
      (set key T)
    )
  )fn
)
;| (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)(strcat  (setq a (substr tm$ x 2)) y)) '(3 5 7 9)  '("时" "分" "." "秒"))
    )
  )
)

;; (qf_getFolder "")
(defun qf_getFolder (msg / WinShell shFolder path catchit PATH SHFOLDER)
  (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-xfindxb)
(defun xdcl-create-xfindxb (/ dclname dlg$lst f)
  (setq        dclname
         (strcat (getVAR "LOCALROOTPREFIX") "xfindxb.dcl")
  )
  (setq        dlg$lst
         (list
           "xfindx:dialog{"
             "label=\"超快感搜索令 v1.1 (对话框B版) 狂刀制造-v0605\";"
             ":row{"
             ":edit_box{label=\"搜索路径:\";key=\"searchfolder\";value=\"c:\\\\\";width=40;}"
             ":button {label=\"指定路径\";key=\"getfolder\";width=6;}"
             ":button {label=\"退出\";is_cancel=true;key=\"cancel\";width=6;}"
             "}"
             ":row{"
             ":edit_box{label=\"文 件 名:  \";key=\"fname\";value=\"*.lsp\";width=40;}"
             ":radio_button {label=\" 仅搜目录 \";key=\"dironly\";width=6;}"
             ":button {label=\"狂搜\";key=\"accept\";width=6;}"
             "}"
           "}"
             "select:dialog{"
             "label=\"超快感搜索令 v1.1 (对话框B版) 狂刀制造-v0605\";"
             ":text{label=\"搜索用时:\";key=\"runtime\";}"
             ":list_box{label=\"选择文件(可用ctrl,shift组合选择):\";key=\"selfn\";multiple_select=true;height=20;width=60;}"
               ":row{"
                  ":toggle{label=\"全选\";key=\"selall\";}"
                 ":boxed_column{"
                  "label=\"操作:\";"
           ":row{"
                  ":radio_button {label=\"输出\";key=\"retkey\";value=1;}"
                  ":radio_button {label=\"删除\";key=\"delkey\";value=0;}"
                  ":radio_button {label=\"编辑\";key=\"editkey\";value=0;}"
                  ":radio_button {label=\"加载\";key=\"loadkey\";value=0;}"
           "}"
                 "}"
               "}"
               ":row{"
                  ":button {label=\"作者\";key=\"info\";}"
                  ":button {label=\"确定\";key=\"accept\";}"
                  ":button {label=\"退出\";key=\"cancel\";is_cancel=true;}"
                "}"
          "}"
           )
  )
  (if T ;(not (findfile dclname))
    (progn
      (setq f (open dclname "W"))
      (foreach x dlg$lst (write-line x f))
      (close f)
    )
  )
  dclname
)

;;============================================================================;;
(princ "\n xdirx = 超快感搜索令 v1.1 (对话框B版)-----ok!!----by 梁雄啸.2006.5")(princ)

[/pcode]

snsj

介绍一下功能啊

zyhandw

在师之作！感谢分享

cuyongping

不知道用途!

szsg5394

楼主 为什么我加载后却找不到 找不到啊

yjht

这个程序，非常不错哈

sicky111

我来试试。

GFspringwillow

试了一下，是用于搜文件的。

dnbcgrass

看样子，非常不错！下来学习学习！

wkq004

顶顶，顶出更多源码

/db_自贡黄明儒_

楼主这么多马甲梁雄啸,别名狂刀、陌生人、无痕 lxx 都让我糊涂了。{:soso_e113:}

记得LZ在明经上发这个帖子的时候，程序还没有这么完善，而且还在喝着咖啡。

laiz3000

:)这个得支持一下呀

MUYIY

牛人啊，谢谢