通过在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)