Google it!

google.lsp

---

;;;=============================================================================
;;;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 'vl-filename-base 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 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 Favorites lst favoritesPath)
  ;;Get a folder and all of its subfolders(recursively)
  (defun GetSubFolder (path / l fso s)
    (defun GetSubFolder1 (folder / p files path)
      (setq files (vlax-get folder 'files))
      (setq path (vlax-get folder 'path))
      (if (/= (substr path (strlen path)) "\\")
	(setq path (strcat path "\\"))
      )
      (vlax-for	f files
	(if (= (vlax-get f 'type) "Internet 快捷方式")
	  (setq s (cons (strcat path (vlax-get f 'name)) s))
	)
      )
      (vlax-for	subfolder (vlax-get folder 'SubFolders)
	(setq p (vlax-get subfolder 'Path))
	(setq l (cons p (GetSubFolder1 subFolder)))
      )
      l
    )
    (setq fso (vlax-create-object "Scripting.FileSystemObject"))
    (setq l (list path))
    (if	(vlax-invoke fso 'folderExists path)
      (setq l (reverse (getSubFolder1 (vlax-invoke fso 'getFolder path))))
      (setq l nil)
    )
    (vlax-release-object fso)
    (reverse s)
  )
  (setq	key "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders\\")
  (setq favoritesPath (vl-registry-read key "Favorites"))
  (setq lst (GetSubFolder favoritesPath))
)

;;;=============================================================================
;;;浏览收藏夹列表的指定项                                                       
;;;=============================================================================
(defun GotoFavorite (index favorites)
  (startapp (GetDefaultBrowser) (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)
)