打开搜索引擎

通过在CAD中输入关键字,迅速定位搜索引擎搜索.
下面是代码.

;;;=============================================================================
;;;CAD的搜索和浏览
;;;=============================================================================
(defun C:Google (/ DCL_FILE DCL_ID FAVORITES SCOPES)
  (setq Dcl_File (Write_Dcl))                                                   ;创建临时对话框文件
  (setq dcl_id (load_dialog Dcl_File))                                          ;装入对话框文件(因为是动态,所以不必检查dcl_file)
  (vl-file-delete Dcl_File)                                                     ;删除临时对话框文件
  ;;开始对话框操作
  (new_dialog "google" dcl_id)                                                  ;因为是动态对话框,所以可以不检查dcl_id
  (setq scopes (GetSearchScopes))
  (start_list "Scopes")
  (mapcar 'add_list (mapcar 'car scopes))                                       ;初始化搜索引擎列表
  (end_list)
  (setq favorites (GetFavorites))
  (start_list "Favorites")
  (mapcar 'add_list (mapcar 'car favorites))                                    ;初始化收藏夹列表
  (end_list)
  (start_dialog)                                                                ;开始对话框
  (unload_dialog dcl_id)                                                        ;卸载对话框
  (princ)
)
;;;=============================================================================
;;;获取搜索引擎列表
;;;暂时根据IE来获得列表。以后考虑增加其他浏览器的搜索引擎
;;;=============================================================================
(defun GetSearchScopes (/ key subkey scopes default)
  (setq key "HKEY_CURRENT_USER\\Software\\Microsoft\\Internet Explorer\\SearchScopes")
  (if (setq Scopes (vl-registry-descendents key))
    (progn
      (setq default (vl-registry-read key "DefaultScope"))
      (vl-remove
        nil                                                                     ;有可能会出现虚假的项
        (mapcar
          (function
            (lambda (scope / subkey name url)
              (setq subkey (strcat key (chr 92) scope))
              (setq name (vl-registry-read subkey "DisplayName"))               ;引擎名
              (setq url (vl-registry-read subkey "URL"))                        ;引擎地址
              (if (and name url)
                (cons name url)
              )
            )
          )
          (cons default (vl-remove default scopes))                             ;确保第一个是默认搜索引擎
        )
      )
    )
    (list
      (cons "Google" "http://www.google.com.hk/search?hl=zh-CN&q={searchTerms}");对不起,谷歌跑到香港了!
      (cons "百度" "http://www.baidu.com/s?wd={searchTerms}")                   ;google经常被GFW,用百度是无奈之举
    )
  )
)
;;;=============================================================================
;;;获取默认浏览器
;;;=============================================================================
(defun GetDefaultBrowser (/ browser)
  (setq Browser (vl-registry-read "HKEY_CLASSES_ROOT\\HTTP\\shell\\open\\command"))
  (and (= (type browser) 'list) (setq browser (cdr browser)))
  (setq browser (substr (strcat (vl-filename-directory Browser) "/" (vl-filename-base Browser) ".exe") 2))
) 
;;;=============================================================================
;;;启动指定的搜索引擎,并搜索
;;;=============================================================================
(defun GoogleIt (Scopes / Index Keywords scope url browser scopeName)
  (setq Index (read (get_tile "Scopes")))
  (setq keywords (get_tile "Keywords"))
  (setq scope (nth Index scopes))
  (setq url (vl-string-subst (notrailspace (noleadspace keywords)) "{searchTerms}" (cdr scope)))
  (setq Browser (GetDefaultBrowser))
  (setq scopeName (car scope))
  (cond
    ( (= scopeName "百度")
      (startapp browser (strcat "http://www.baidu.com/s?wd=" keywords))         ;很无奈!不然的话,对中文关键字搜索会有问题哦?
    )
    (t
      (startapp browser url)
    )
  )
  ;(DONE_DIALOG)
)
;;;=============================================================================
;;;收藏夹中的地址列表
;;;=============================================================================
(defun GetFavorites (/ key path sh lst)
  (setq sh (vlax-create-object "shell.application"))
  (setq key "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders")
  (setq path (vlax-invoke sh 'Namespace (vl-registry-read key "Favorites")))
  (vlax-release-object sh)
  (setq lst nil)
  (defun processGet (path  / items i item link url name)
    (setq items (vlax-invoke path 'items))
    (setq i 0)
    (repeat (vlax-get items 'count)
      (setq item (vlax-invoke items 'item i))
      (if (zerop (vlax-get item 'islink))
	(processGet (vlax-get item 'getfolder))
	(setq link (vlax-get item 'GetLink)
	      name (vlax-get item 'name)
	      url  (vlax-get link 'target)
	      url  (vlax-get url 'name)
	      lst  (cons (cons name url) lst)
	)
      )
      (setq i (1+ i))
    )
    lst
  )
  (processget path)
)
;;;=============================================================================
;;;浏览收藏夹列表的指定项
;;;=============================================================================
(defun GotoFavorite (index favorites / wsh)
  (setq wsh (vlax-create-object "wscript.shell"))
  (if wsh
    (progn
      (vlax-invoke wsh 'run (cdr (nth (read index) favorites)))
      (vlax-release-object wsh)
    )
    (startapp "explorer" (cdr (nth (read index) favorites)))
  )
)
;;;=============================================================================
;;;临时生成Dcl文件 返回文件名
;;;=============================================================================
(defun Write_Dcl (/ Dcl_File file str)
  (setq Dcl_File (vl-filename-mktemp nil nil ".DCL"))
  (setq file (open Dcl_File "W"))
  (foreach str (DialogData)
    (write-line str file)
  )
  (close file)
  Dcl_File
)
;;;=============================================================================
;;;对话框文件
;;;=============================================================================
(defun DialogData ()
  (list "google : dialog"
        "{"
           "label = \"百谷鸟 🙂\";"
           ": column"
           "{"
              ": row"
              "{"
                 ": text"
                 "{"
                    "label = \"搜索引擎: \";"
                 "}"
                 ": popup_list"
                 "{"
                    "key = \"Scopes\";"
                    "width = 13.2;"
                    "fixed_width = true;"
                    "action = \"(setq scope (nth (read $value) Scopes))\";"
                 "}"
                 ": text"
                 "{"
                    "label = \"收藏夹: \";"
                 "}"
                 ": popup_list"
                 "{"
                    "key = \"Favorites\";"
                    "width = 40;"
                    "fixed_width = true;"
                    "action = \"(GotoFavorite $value favorites)\";"
                 "}"
              "}"
              ": spacer { width = 1; }"
              ": row"
              "{"
                 ": text"
                 "{"
                    "label = \"关键字: \";"
                 "}"
                 ": edit_box"
                 "{"
                    "key = \"Keywords\";"
                    "width = 65;"
                    "fixed_width = true;"
                 "}"
              "}"
              ": spacer { width = 1; }"
           "}"
           ": row"
           "{"
              ": button {"
                 "label = \"去搜吧!\";"
                 "fixed_width = true;"
                 "is_default = true;"
                 "key = \"google_it\";"
                 "mnemonic = \"G\";"
                 "action = \"(googleit scopes)\";"
                 "allow_accept = true;"
              "}"
              ": spacer { width = 1; }"
              ": button {"
                 "label = \"完成\";"
                 "is_cancel = true;"
                 "fixed_width = true;"
                 "width = 6;"
              "}"
           "}"
            ": text"
           "{"
               "label = \"Highflybird 版权所有,用于商业将追究!\";"
               "alignment = centered;"
           "}"
           ;"errtile;"
        "}"
  )
)
;;;remove leading spaces
(defun noleadspace (target_string / s)
  (if (setq s target_string)
    (while (= (substr s 1 1) " ")
      (setq s (substr s 2))
    ) ;_ end while
  ) ;_ end if
  s
)
;;;remove trailing spaces
(defun notrailspace (target_string / s)
  (if (setq s target_string)
    (while (and (/= s "") (= (substr s (strlen s)) " "))
      (setq s (substr s 1 (1- (strlen s))))
    ) ;_ end while
  ) ;_ end if
  s
)
;;;convert spaces in the target string to the plus symbol
(defun space_to_plus (target_string / s counter)
  (setq counter 1)
  (setq s target_string)
  (repeat (strlen s)
    (if (= (substr s counter 1) " ")
      (setq s
             (strcat (substr s 1 (1- counter))
                     "+"
                     (substr s (1+ counter))
             )
      )
    ) ;_ end if
    (setq counter (1+ counter))
  ) ;_ end repeat
  s
)
;;;=============================================================================
;;;关闭所有的浏览器进程
;;;=============================================================================
(defun C:GB()
  (defun Close_All_IExplore (EXENAME / SWbemLocator WQL Service IEProcesses isClosed)
    (setq SWbemLocator (vlax-create-object "WbemScripting.SWbemLocator"))
    (setq Service (vlax-invoke SWbemLocator 'ConnectServer))
    (setq WQL (strcat "SELECT * FROM Win32_Process WHERE Name='" ExeName ".EXE'" ))
    (setq IEProcesses (vlax-invoke Service 'ExecQuery WQL))
    (vlax-for IE IEProcesses
       (vlax-invoke IE 'Terminate)
    )
    (vlax-release-object IEProcesses)
    (vlax-release-object Service)
    (vlax-release-object SWbemLocator)
  )
  (VL-CATCH-ALL-APPLY
    'mapcar
    (list 'Close_All_IExplore
          (list "IEXPLORE" "360se" "360chrome" "chrome" "opera" "firefox")      ;还有什么浏览器自己添加吧!
    )
  )
  (princ)
)
(vl-load-com)
(princ)


发表评论

电子邮件地址不会被公开。 必填项已用*标注