Quick String Search

May 17

;;; QSS - Quick String Search Rlx June'26
;;; Just a basic string search engine, first meant for text based files like lsp & txt files + dwg files (dbx)
;;; Some files are read as stream so maybe it also works for other file types ... bucketlist material.
;;; App can skip (error-catch) files its unable to open because they were saved with higher version.
;;; Sometimes files can be corrupt and AutoCad crashes and you would loose all search results fo far.
;;; Thats why I created shadow mode and recovery mode.
;;; Shadow mode writes a file (QSS-Shadow-List.txt) on your desktop in 'QuickStringSearch' folder where the name of each file is saved.
;;; Each line begins with <num> | status | filename. You can save this file as csv and split on pipesymbol |.
;;; Status can be 0 - corrupt , 1 - unable to open , 2 - no hit , 3 - hit (search string was found)
;;; I created this because I was searching little over one hundred thousand drawings and just before it was finished
;;; it crashed AutoCad because of a corrupt drawing. With shadow mode you can now see how far it came.
;;; To be able to get past this , I also created recovery mode.
;;; First all filenames are saved to file (QSS-Recovery-List.txt) , then this list is compared to the shadow list.
;;; With this info , app can tell which file caused the crash , sent it to my naughty list , and resume with the rest.
;;; Normal operation , no corrupt files is simple click and go. You can allways leave on Shadow mode.
;;; When however AutoCad crashed because of corrupt file , switch on recovery mode and app will be able to
;;; skip corrupt file and resume with the rest.
;;; 
;;; Last update		: 2026-05-18 - added eror catch for read excel values
;;;			: 2026-05-30 - added Shadow Mode, save results do desktop (QSS-Shadow-Mode.txt)
;;;			: 2026-06-01 - added Recovery Mode, resume search after crash & find everything

(defun C:QSS
       ( /
        ;;; globals
        OldErr regkey regvar sysvar-names sysvar-old-values total-file-list hit-list open-at-the-end fn no-show
        
        ;;; debug / crash & recovery
        QSS-Program-Folder
        QSS-Shadow-List-fn  QSS-Shadow-List-fp  shadow-list
        QSS-Recovery-List-fn QSS-Recovery-List-fp recovery-list
        QSS-Naughty-List-fn QSS-Naughty-List-fp naughty-list
        
        ;;; object dbx / RegExp
        actApp actDoc actDocs actLay dbxObj AllOpen RegExp
        
        ;;; Excel
        xlApp xlWorkbooks xlWorkbook xlSheets
        
        ;;; registry
        QSS-Search-Folder					;;; String - Folder where lisp files are placed
        QSS-Include-Subfolders					;;; Toggle - "0" scan only search folder, "1" also scan subfolders
        QSS-Filename-Extension-Filter				;;; String - delimited by , like "lsp,txt"
        QSS-Search-String-Filter				;;; String - delimited by | like "Rlx|Dragon"
        QSS-Get-Everything					;;; Toggle - Get every string form every drawwing
        QSS-Case-Sensitive					;;; Toggle - "0" don't care, "1" case sensitive search
        QSS-Whole-Words-Only					;;; Toggle - "0" find every part, "1" only find whole words
        QSS-Shadow-Mode						;;; Toggle - save all search hits directly to desktop
        QSS-Recovery-Mode					;;; Toggle - Resume after crash and put guilty file on naughty lisy

        ;;; dialog
        QSS-Main-Dialog-fn QSS-Main-Dialog-fp QSS-Main-Dialog-id
	MainDialog-tl MainDialog-rd
	
       )
  (QSS_init)
  (QSS_exit)
  (QSS_end_it)
)

;--- Init ------------------------------------------------- Begin Init Section --------------------------------------------------- Init ---

(defun QSS_Init ()
  ; initialize error handling
  (setq OldErr *error* *error* QSS_Err)
  ; backup & set system variables (not realy used here, just added for template purposes)
  (setq sysvar-names (list (cons 'cmdecho 0))
        sysvar-old-values (mapcar '(lambda (x)(getvar (car x))) sysvar-names))
  (mapcar '(lambda (x)(setvar (car x) (cdr x))) sysvar-names)
  ;;; init registry variables
  (InitDefaultRegistrySettings)(ReadSettingsFromRegistry)
  ;;; for direct saving results to desktop
  (QSS_Init_Shadow_and_Recovery_Mode)
  ;;; lets go girls
  (QSS_Main_Dialog_Start)
)

(defun QSS_Err ($s) (princ $s)(QSS_Exit)(setq *error* OldErr)(princ))

;;; save search results also to desktop in case computer crashes during search
(defun QSS_Init_Shadow_and_Recovery_Mode ()
  (setq QSS-Program-Folder (mk_desktop_dir "QuickStringSearch"))
  (setq QSS-Shadow-List-fn (strcat QSS-Program-Folder "\\QSS-Shadow-List.txt"))
  (setq QSS-Recovery-List-fn (strcat QSS-Program-Folder "\\QSS-Recovery-List.txt"))
  (setq QSS-Naughty-List-fn  (strcat QSS-Program-Folder "\\QSS-Naughty-List.txt"))
  ;;; if recovery mode is activated preload recovery-list
  (QSS_Check_For_Recovery_Mode)
)

(defun QSS_Exit ()
  ; cleanup dialog(s) (I use list for future use in case of more dialogs)
  (mapcar '(lambda (x) (if (not (null x)) (unload_dialog x)))
	   (list QSS-Main-Dialog-fn))
  (mapcar '(lambda (x) (if (not (null x)) (close x)))
	   (list QSS-Main-Dialog-fp QSS-Shadow-List-fp shadow-fp-2 QSS-Recovery-List-fp QSS-Naughty-List-fp))
  (mapcar '(lambda (x) (if (and (not (null x)) (findfile x)) (vl-file-delete x)))
	   (list QSS-Main-Dialog-fn))
                 
  ; reset system variables (not realy used here just for future / template purposes)
  (mapcar '(lambda (x y)(setvar (car x) y)) sysvar-names sysvar-old-values)
  (term_dialog) (gc) (princ "\nDone") (terpri) (princ)
  ; release dbxObj & RegExp
  (foreach obj (list dbxObj RegExp) (vl-catch-all-apply 'vlax-release-object (list obj)))
  ;;; release Excel
  (Exit_Excel)
)

;;; check for unfinished business...
(defun QSS_End_it ( / fn )
  ;;; in shadow mode , each search hit (filename) is saved to desktop (QSS-Shadow-List.txt)
  (if (and (null no-show) (= QSS-Shadow-Mode "1") (setq fn (findfile QSS-Shadow-List-fn))) (startapp "notepad" fn))
  ;;; user clicked on open drawing from result list, aint gonna happen until dialog was terminated first
  (if (and open-at-the-end (setq fn (findfile open-at-the-end)))(_ShellOpen fn))
)

;;; file and mode are verified in QSS_Init
(defun QSS_Check_For_Recovery_Mode ( / inp l) (if (and (= QSS-Recovery-Mode "1") (findfile QSS-Recovery-List-fn)
  (setq QSS-Recovery-List-fp (open QSS-Recovery-List-fn "r"))) (progn (while (setq inp (read-line QSS-Recovery-List-fp))
     (setq l (cons inp l)))(close QSS-Recovery-List-fp) (setq recovery-list (reverse l)))))

;;; ------------------------------------------------------ End of Init Section ------------------------------------------------------------



;;; --- Registry Settings ------------------------------- Begin Registry Settings ------------------------------- Registry Settings --- ;;;

(defun InitDefaultRegistrySettings ()
  (setq regkey "HKEY_CURRENT_USER\\SOFTWARE\\QSS\\")
  ;;; regkeys must be strings ("variable name" "default value")
  (setq regvar
     (list
       '("QSS-Search-Folder" "")				;;; String - Folder where lisp files are placed
       '("QSS-Include-Subfolders" "0")				;;; Toggle - "0" scan only search folder, "1" also scan subfolders
       '("QSS-Filename-Extension-Filter" "lsp,txt,dwg")		;;; String - delimited by , (comma) like "lsp,dwg"
       '("QSS-Search-String-Filter" "")				;;; String - delimited by | (Pipe) like "Rlx|Dragon"
       '("QSS-Get-Everything" "0")				;;; Toggle - Get every string form every drawwing
       '("QSS-Case-Sensitive" "0")				;;; Toggle - "0" don't care, "1" case sensitive search
       '("QSS-Whole-Words-Only" "0")				;;; Toggle - "0" nope , "1" jip 
       '("QSS-Shadow-Mode" "0")					;;; Toggle - if on save all results to desktop 
       '("QSS-Recovery-Mode" "0")				;;; Toggle - resume after crash (corrupt file or something)
    )
  )
  (mapcar '(lambda (x)(set (read (car x)) (cadr x))) regVar)
)

(defun ReadSettingsFromRegistry ()
  (mapcar '(lambda (x / n v)
    (if (setq v (vl-registry-read regkey (setq n (car x)))) (set (read n) v) (vl-registry-write regkey n (cadr x)))) regvar))

(defun WriteSettingsToRegistry ()
  (mapcar '(lambda (x) (vl-registry-write regkey (car x) (eval (read (car x))))) regvar))

;;; --- Registry Settings -------------------------------- End Registry Settings -------------------------------- Registry Settings --- ;;;



;;; --- dialog section ----------------------------------- begin dialog section ------------------------------------ dialog section --- ;;;

; SaveDialogData evaluates all vars from %tl and returns them as a list, reset does the opposite
(defun Save_Dialog_Data      (%tl) (mapcar '(lambda (x) (eval (car x))) %tl))
(defun Reset_Dialog_Data (%tl %rd) (mapcar '(lambda (x y) (set (car x) y)) %tl %rd))
(defun Set_Dialog_Tiles      (%tl) (mapcar '(lambda (x / v) (if (eq 'str (type (setq v (eval (car x))))) (set_tile (cadr x) v))) %tl))
(defun Main_Dialog_Cancel       () (Reset_Dialog_Data MainDialog-tl MainDialog-rd) (WriteSettingsToRegistry))

(defun QSS_Main_Dialog_Create ()
  (if (and (setq main-dialog-fn (vl-filename-mktemp "Main.dcl")) (setq main-dialog-fp (open main-dialog-fn "w")))
    (mapcar
      '(lambda (x)(write-line x main-dialog-fp))
       (list "QSS : dialog {label=\"QSS - Quick String Search (RLX June 2026)\";"
             ":boxed_column {label=\"Search Folder :\";"
             "  :row {:edit_box {key=\"eb_search_folder\";}"
             "        :button {fixed_width=true;width=12;key=\"bt_select_search_folder\";label=\"Select\";}}"
             "  :toggle {label=\"Include Subfolders\";key=\"tg_include_subfolders\";}}"

             ":boxed_column {label=\"Filename Extension Filter [ , ]\";"
             "  :row {:edit_box {key=\"eb_filename_extension_filter\";}"
             "        :button {fixed_width=true;width=12;key=\"bt_filename_extension_filter\";label=\"Select\";}}}"
	     
	     ":boxed_column {label=\"Search String Filter [ | ]\";"
             "  :concatenation {:edit_box {edit_width=80;key=\"eb_search_string_filter\";}"
             "                  :toggle {key=\"tg_everything\";label=\"Everything\";}}"
             "  :row {:toggle {label=\"Case Sensitive\";key=\"tg_case_sensitive\";}"
             "        :toggle {label=\"Whole Words Only\";key=\"tg_whole_words_only\";}"
             "        :toggle {label=\"Shadow Mode\";key=\"tg_shadow_mode\";}"
             "        :toggle {label=\"Recovery Mode\";key=\"tg_recovery_mode\";}}}"
             
             "spacer;:row {gap;:image {key=\"im_mode\";height=0.2;}gap;}spacer;"
             
             ":concatenation {gap; :image {height=1.5;width=91;key=\"the_bar\";color=dialog_background;}gap;}"
             
             ":column {:concatenation {alignment=centered;"
             "  :bt_16 {key=\"bt_clear_lists\";label=\"Clear Lists\";} spacer;spacer; ok_cancel;}}"
             "spacer;spacer;"
             
             "}"
             "gap:image {fixed_width=true;width=0.001;color=dialog_background;}"
             "bt_16 :button {width=18;fixed_width=true;}"
       )
    )
  )
  (if main-dialog-fp (close main-dialog-fp))(gc)
)

(defun QSS_Main_Dialog_Start ( / drv )
  (if (null main-dialog-fn)(QSS_Main_Dialog_Create))
  (if (and (setq main-dialog-dcl (load_dialog main-dialog-fn)) (new_dialog "QSS" main-dialog-dcl))
    (progn
      (QSS_Main_Dialog_Update)
      (QSS_Main_Dialog_Action)
      (setq drv (start_dialog))
      
      (cond
	((= drv  0)(Main_Dialog_Cancel)(setq no-show T)); no-show to prevent showing shawdow-list after cancel
        ;;; disabled accept (ok / done dialog 1) to be able to show progress bar
        ;;; ok action replaced by : ("accept" "(WriteSettingsToRegistry)(QSS_Pre_Scan)")
	((= drv  1)(WriteSettingsToRegistry))
        ((= drv  2)(WriteSettingsToRegistry)(Show_Hit_List))
      )
    )
  )
  (if main-dialog-fn (vl-file-delete main-dialog-fn))
  (setq main-dialog-fn nil)
)

(defun QSS_Main_Dialog_Update ()
  (setq MainDialog-tl
	 '((QSS-Search-Folder "eb_search_folder")
           (QSS-Include-Subfolders "tg_include_subfolders")
           (QSS-Filename-Extension-Filter "eb_filename_extension_filter")
           (QSS-Search-String-Filter "eb_search_string_filter")
           (QSS-Get-Everything  "tg_everything")
           (QSS-Case-Sensitive "tg_case_sensitive")
           (QSS-Whole-Words-Only "tg_whole_words_only")
           (QSS-Shadow-Mode "tg_shadow_mode")
           (QSS-Recovery-Mode "tg_recovery_mode")
          )
  )
  ;;; rd = reset data (val1 val2 ...) , in case of a cancel store original values before start of dialog
  (if (null MainDialog-rd) (setq MainDialog-rd (Save_Dialog_Data MainDialog-tl)))
  ;;; set edit boxes and toggle values
  (Set_Dialog_Tiles MainDialog-tl)
  ;;; show mode in color
  (show_program_mode)
)

(defun QSS_Main_Dialog_Action ()
  (mapcar '(lambda (x)(action_tile (car x) (cadr x)))
    '(("cancel" "(done_dialog 0)")
      ;;; stay in dialog for progress bar
      ;;; ("accept" "(done_dialog 1)")
      ("accept" "(WriteSettingsToRegistry)(if (eq QSS-Get-Everything \"1\")(QSS_Get_Everything)(QSS_Pre_Scan))")
      
      ("eb_search_folder" "(setq QSS-Search-Folder $value)")
      ("bt_select_search_folder" "(QSS_select_search_folder)")
      ("tg_include_subfolders" "(setq QSS-Include-Subfolders $value)")
      ("eb_filename_extension_filter" "(setq QSS-Filename-Extension-Filter $value)")
      ("bt_filename_extension_filter" "(QSS_Select_Filename_Extension_Filter)")
      ("eb_search_string_filter" "(setq QSS-Search-String-Filter $value)")
      ("tg_everything" "(setq QSS-Get-Everything $value)")
      ("tg_case_sensitive" "(setq QSS-Case-Sensitive $value)")
      ("tg_whole_words_only" "(setq QSS-Whole-Words-Only $value)")
      ("tg_shadow_mode" "(setq QSS-Shadow-Mode $value)(show_program_mode)")
      ("tg_recovery_mode" "(setq QSS-Recovery-Mode $value)(show_program_mode)")
      ("bt_clear_lists" "(QSS_Clear_Lists)")
    )
  )
)

(defun show_program_mode ( / col )
  (setq col (cond ((= QSS-Recovery-Mode "1") 1) ((= QSS-Shadow-Mode  "1") 3)(t 7)))
  (start_image "im_mode") (fill_image 0 0 (dimx_tile "im_mode") (dimy_tile "im_mode") col)(end_image)
)

(defun QSS_select_search_folder ( / f)
  (if (setq f (GetShellFolder "Select search folder"))(set_tile "eb_search_folder" (setq QSS-Search-Folder f))))

(defun QSS_Clear_Lists ( / l)
  (if (and (folder-p QSS-Program-Folder) (vl-consp (setq l (vl-directory-files QSS-Program-Folder "*.*" 1)))
    (yesno "Realy want to clear all lists in QuickStringSearch folder?"))
      (foreach f l (vl-file-delete (strcat QSS-Program-Folder "\\" f)))))

;;; QSS-Filename-Extension-Filter / eb_filename_extension_filter
(defun QSS_Select_Filename_Extension_Filter ( / tl dl rtn)
  ;;; total list with (future) supported extensions (doc & pdf untested / too slow at this moment)
  ;;; (setq tl '("doc" "docx" "dwg" "dxf" "lsp" "pdf" "txt" "xls" "xlsx"))
  (setq tl '("dwg" "dxf" "lsp" "txt" "xls" "xlsx"))
  ;;; get current list from edit box and use as default for multiple select routine
  ;;; also make sure all extentions are in lowercase
  (setq dl (SplitStr (strcase (get_tile "eb_filename_extension_filter") t) ","))
  (if (setq rtn (mfl tl dl))
    (progn
      (set_tile "eb_filename_extension_filter" (setq QSS-Filename-Extension-Filter (strcase (commatize rtn) t)))
      (WriteSettingsToRegistry)
    )
  )
)

;;; first handle the file & folder stuf side of things
(defun QSS_Pre_Scan ( / subfolder-flag case-flag filename-extension-filter-list search-string-filter-list folder-list tmp-l)
  ;;; make sure include subfolders and case-sensitive flags are either T or nil
  (if (not (eq QSS-Include-Subfolders "1")) (setq subfolder-flag nil) (setq subfolder-flag T))
  (if (not (eq QSS-Case-Sensitive "1")) (setq case-flag nil) (setq case-flag T))
  ;;; check all parameters
  (cond
    ;;; verify search folder
    ((not (folder-p QSS-Search-Folder))
     (alert (strcat "Invalid search folder : " (vl-princ-to-string QSS-Search-Folder))))
    ;;; verify filename filter (like "lsp,dwg") -> pimpext -> ("*.lsp" "*.dwg")
    ((or (void QSS-Filename-Extension-Filter)
         (not (vl-consp (setq tmp-l (SplitStr QSS-Filename-Extension-Filter ","))))
         (not (vl-every '(lambda (s) (wcmatch s "*`.*")) (setq filename-extension-filter-list (pimpex tmp-l)))))
     (alert (strcat "Bad filename filter : " (vl-princ-to-string QSS-Filename-Extension-Filter))))
    ;;; verify search string filter
    ((or (void QSS-Search-String-Filter)
         (not (vl-consp (setq search-string-filter-list (SplitStr QSS-Search-String-Filter "|")))))
     (alert (strcat "Invalid search string : " (vl-princ-to-string QSS-Search-String-Filter))))
    ;;; maybe do file list check here
    (t
     ;;; fire-up proress bar
     (clear_bar)(set_tile "the_bar" " working...")
     
     ;;; if recovery mode is active no need to scan again for subfolders and files
     (if (and (= QSS-Recovery-Mode "1") (vl-consp recovery-list))
       (setq total-file-list recovery-list)
       ;;; at this moment either recovery mode is not activated or (pre-loaded) recovery-list is empty
       ;;; so we have to perform a full (sub)folder / file scan
       (progn
         (if (eq QSS-Include-Subfolders "1")
         (setq folder-list (QSS_FindSubfolders QSS-Search-Folder)) (setq folder-list (list QSS-Search-Folder)))
         ;;; just a little delay to enjoy the view, exterminate when it gets anoying
         (wait 1.5)
         (setq total-file-list (QSS_FindFiles folder-list filename-extension-filter-list)) ;;; [QSS_FindFiles line 747]
         ;;; recovery mode may be active but recovery-list is empty
         (if (and (= QSS-Recovery-Mode "1") (not (vl-consp recovery-list)))
           (QSS_Save_Recovery_List (setq recovery-list total-file-list)))
       )
     )
    )
  );;; end cond

  ;;; determine whether to process recovery or total-file-list
  (if (and (= QSS-Recovery-Mode "1") (vl-consp recovery-list) (findfile QSS-Shadow-List-fn)) (QSS_Start_Recovery))
  ;;; ready to proceed with total-file list
  (clear_bar)
  (if (not (vl-consp total-file-list))
    (alert "No (more) files to process")
    (QSS_Process_Total_File_List)
  )
);;; end defun

     
;;; little explanation : Recovery list contains all filenames from original search operation (in my case 105.000)
;;; With shadow mode enabled every result is saved to a file (QSS-Shadow-Mode-fn)
;;; If AutoCad crashed because of a corrupt file , count the number of lines in shadow file, say 5000.
;;; This means that file 5001 in the Recovery list gets a seat on my naughty list and app should resume from 5002.
;;; In order to keep lists in sync file 5001 has to be added to shadow list and tagged as corrupt / unable to read
;;; (setq l1 '(0 1 2 3 4 5) l2 '(0 1 2)) -> 3 = err -> resume search from 4 
(defun QSS_Start_Recovery ( / fn shadow-count )
  (cond
    ((not (vl-consp recovery-list)) (alert "Recovery unavailable : recovery-list empty"))
    ((not (and (setq fn (findfile (vl-princ-to-string QSS-Shadow-List-fn)))
       (setq QSS-Shadow-List-fp (open fn "r")))) (alert "Recovery unavailable : recovery-list empty"))
    (t
     (setq shadow-count 0)
     (while (setq inp (read-line QSS-Shadow-List-fp))(setq shadow-count (1+ shadow-count)))(close QSS-Shadow-List-fp)
     ;;; (sublst (reverse '(10 9 8 7 6 5 4 3 2 1)) (1+ (length '(1 2 3))) nil) -> (4 5 6 7 8 9 10)
     (setq total-file-list (sublst (reverse recovery-list) (1+ shadow-count) nil))
     ;;; first item in total list is the naughty one so bag & tag
     (QSS_Save_To_Naughty_List (car total-file-list))
     ;;; put item also on hit-list with remark that app was unable to open it
     (QSS_Save_To_Shadow_List (strcat "0|error|" (vl-princ-to-string (car total-file-list))))
     ;;; now process rest of total-list
     (setq total-file-list (cdr total-file-list))
    )
  )
)

;;; clear previous status
(defun clear_bar () (start_image "the_bar")(fill_image 0 0 (dimx_tile "the_bar") (dimy_tile "the_bar") 141)(end_image))

(defun Show_Hit_List () (if (vl-consp hit-list)
  (dplm+ hit-list (strcat "Number of files found : " (itoa (length hit-list)))) (alert "Sorry search returned no results")))

(defun QSS_Process_Total_File_List ( / stream pattern file-count n l hit shadow-fn-1 shadow-fp-1 shadow-fn-2 shadow-fp-2)
  (set_tile "the_bar" (strcat "Number of files to search : " (setq n (itoa (length total-file-list)))))
  (setq file-count 0 pattern QSS-Search-String-Filter)
  (if (eq QSS-Case-Sensitive "1")(setq ignoreCase nil)(setq ignoreCase T))
  
  ;;; save all results to file on desktop for later valuation
  ;;; the reason I wrote this was I had to scan 104.987 files and around no. 86.000 AutoCad crashed and all results poof
  ;;; after I created Shadow Mode it happened again so now I first save every filename to a dat file and
  ;;; in the loop I do the same with prefix [Y], (string was found) or [N], (string was not found)
  ;;; Now if AutoCad crashes again at least I can see which file I have to kick of this planet
  (if (and (= QSS-Shadow-Mode "1") (not (= QSS-Recovery-Mode "1")))
    (progn
      ;;; clear old shadow file first because inside next loop this shadow file is appended (\\Desktop\\QSS-Shadow-Mode.txt)
      (if (setq shadow-fn-1 (findfile QSS-Shadow-List-fn))(vl-file-delete shadow-fn-1))
      ;;; write all filenames to dat file
      (if (and (setq shadow-fn-2 (strcat (getenv "USERPROFILE") "\\Desktop\\QSS-Shadow-Mode.dat"))
               (vl-consp total-file-list)(setq shadow-fp-2 (open shadow-fn-2 "w")))
        (progn (foreach x total-file-list (write-line x shadow-fp-2))(close shadow-fp-2)(gc)(gc)))
    )
  )
               
  ;;; now do the actual scanning
  (foreach fn total-file-list
    (setq hit nil)
    ;;; split here for different types of extensions
    ;;; lisp & text files can be read by stream , dwg by odbx
    ;;; (strcase (last (fnsplitl "c:\\temp\lisp\acad.dwg")) t) -> ".dwg"
    (if (setq ext (vl-filename-extension fn)) (setq ext (strcase ext t)) (setq ext ""))
    
    ;(setq ext (strcase (last (fnsplitl fn)) t))

    ;;; for now only *.lsp, *.txt & *.dwg,
    ;;; bucketlist xls/xlsx & pdf but they may need different approach or 3rd party software, so low priority
    (cond
      ;;; on this moment untested / too slow
      ((wcmatch ext "*`.doc,*`.docx,*`.rtf")
       (if (SearchInWord fn pattern) (setq hit fn hit-list (cons hit hit-list))))
      ;;; on this moment untested / too slow
      ((wcmatch ext "*`.pdf")
       (if (SearchInPDF fn pattern) (setq hit fn hit-list (cons hit hit-list))))
      ((wcmatch ext "*`.lsp,*`.txt")
       (if (and (setq stream (_ReadStream fn 0))
                (setq rtn (= (vlax-invoke (InitRegExp pattern ignoreCase nil) 'Test stream) -1))
                (not (member fn hit-list))) (setq hit fn hit-list (cons hit hit-list))))
      ;;; regex_string_search last parameter is for return as list
      ;;; if T -> return all strings in doc as list, if nil -> return nil or filename if pattern is found
      ((wcmatch ext "*`.dwg")
       (setq dbx-doc (vl-catch-all-apply 'odbx_open (list fn)))
       (if (or (= dbx-doc nil) (vl-catch-all-error-p dbx-doc))
         ;;; one reasonthis can happen is when trying to open drawing with higher AutoCad version
         (setq hit nil fn (strcat "1|unable to open|" fn))
         (if (setq hit (regex_string_search dbx-doc pattern nil)) (setq hit fn hit-list (cons hit hit-list))))
       ;(odbx_close dbx-doc)
      )
      
      ;;; excel : Scan_Excel returns T or nil if regex pattern is found
      ((wcmatch ext "*`.xls,*`.xlsx")
       (if (and (Scan_Excel fn) (not (member fn hit-list))) (setq hit fn hit-list (cons hit hit-list))))
    )
    ;;; Shadow Mode (save search hits directly to file on desktop
    ;(if (and hit (= QSS-Shadow-Mode "1")) (QSS-Execute-Shadow-Protocol hit))
    (if (= QSS-Shadow-Mode "1")
      (if hit
        (QSS_Save_To_Shadow_List (strcat "3|found|" hit))
        (QSS_Save_To_Shadow_List (strcat "2|none|" fn))
      )
    )
    ;;; length of hit-list
    (setq l (itoa (length hit-list)))
    ;;; clear previous status
    (clear_bar)
    ;;; update status message
    (set_tile "the_bar" (strcat "   ( " (setq *spin* (Spinbar *spin*)) " ) Scanning files [" (itoa file-count) " of " n "] - found " l))
    ;;; increase file counter
    (setq file-count (1+ file-count))
  )
  (done_dialog 2)
)


(defun QSS_Save_To_Shadow_List (s)
  (if (setq QSS-Shadow-List-fp (open QSS-Shadow-List-fn "a"))
    (progn (write-line s QSS-Shadow-List-fp)(close QSS-Shadow-List-fp)(gc))
    (princ (strcat "Unable to save to Shadow-List : " (vl-princ-to-string s)))
  )
)

(defun QSS_Save_To_Naughty_List (s)
  (if (setq QSS-Naughty-List-fp (open QSS-Naughty-List-fn "a"))
    (progn (write-line s QSS-Naughty-List-fp)(close QSS-Naughty-List-fp)(gc))
    (princ (strcat "Unable to save to Naughty-List : " (vl-princ-to-string s)))
  )
)

(defun QSS_Save_Recovery_List (lst)
  (if (setq QSS-Recovery-List-fp (open QSS-Recovery-List-fn "w"))
    (progn (foreach x lst (write-line x QSS-Recovery-List-fp)) (close QSS-Recovery-List-fp) (gc))
    (alert "Unable to save recovery list")
  )
)

;;; --- dialog section ------------------------------------ end dialog section ------------------------------------- dialog section --- ;;;



;--- + + + --------------------------------------------- Begin of tiny lisp section --------------------------------------------- + + + ---

(defun void (x) (or (not x) (= "" x) (and (eq 'STR (type x)) (not (vl-remove 32 (vl-string->list x))))))

(defun wait (sec / stop)(setq stop (+ (getvar "DATE") (/ sec 86400.0)))(while (> stop (getvar "DATE"))))

(defun string-p (s) (if (= (type s) 'str) t nil))

(defun folder-p (f) (if (and (= (type f) 'str) (vl-file-directory-p f)) t nil))

;;; (mk_desktop_dir "QuickStringSearch")
(defun mk_desktop_dir ( $d / d ) (setq $d (vl-princ-to-string $d))
  (setq d (strcat (getenv "USERPROFILE") "\\Desktop\\" $d)) (if (vl-file-directory-p d) d (progn (vl-mkdir d) d)))

; test : (commatize '("a" "b" "c"))
(defun commatize (l) (apply 'strcat (cdr (apply 'append (mapcar (function (lambda (x) (list "," x))) l)))))

; make sure itoa has fixed length , i.e. (fixitoa 1 3) -> "001"
(defun fixitoa ( #i #n / s ) (setq s (itoa #i))(while (> #n (strlen s))(setq s (strcat "0" s))) s)

;;; (sublst '(1 2 3 4 5 6 7 8 9 10) 5 2) -> (5 6) / (sublst '(1 2 3 4 5 6 7 8 9 10) 8 8) -> (8 9 10)
;;; (sublst '(1 2 3 4 5 6 7 8 9 10) 3 nil) -> (3 4 5 6 7 8 9 10)
(defun sublst (lst i l / r) (if (not (<= 1 l (- (length l) i)))
  (setq l (- (length lst) (1- i))))(repeat l (setq r (cons (nth (1- i) lst) r) i (1+ i))) (reverse r))


;;; (Dos_Path (strcat (getvar "dwgprefix") (getvar "dwgname"))) -> "C:\\USERS\\ROB\\DOCUMENTS\\ACAD\\QUICKSTRINGSEARCH.DWG\\"
(defun Dos_Path ($p)
  (if (= (type $p) 'STR) (strcase (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" $p)) "\\")) ""))

;;; (vl_path (strcat (getvar "dwgprefix") (getvar "dwgname"))) -> "c:/users/rob/documents/acad/quickstringsearch.dwg/"
(defun vl_path ($p)(if (= (type $p) 'str)
   (strcat (vl-string-right-trim "\\/" (strcase (vl-string-translate "\\" "/" $p) t)) "/") ""))

(defun IsFileReadable (fn / fp inp) (if (setq fileHandle (open fn "r")) (progn (setq inp (read-line fp))
  ;|like AC1032|; (close fp) (and inp (= (substr inp 1 2) "AC")) ;|T if valid header|; ) nil ;|corrupt or locked|; ))

; generic getfolder routine with possibility to create a new subfolder (GetShellFolder "select path")
(defun GetShellFolder ( m / f s) (if (and (setq s (vlax-create-object "Shell.Application"))
  (setq f (vlax-invoke s 'browseforfolder 0 m 0 "")))(setq f (vlax-get-property (vlax-get-property f 'self) 'path))
     (setq f nil))(vl-catch-all-apply 'vlax-release-object (list s))
  (if f (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" f)) "\\")))

; returns T if no errors occurred during program execution
(defun _ShellOpen ( $f / it sh )
  (if (and (not (void $f)) (setq $f (findfile $f)) (setq sh (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application")))
    (progn (setq it (vl-catch-all-apply 'vlax-invoke (list sh 'open $f)))(vlax-release-object sh)(not (vl-catch-all-error-p it)))
      (progn (prompt "\nShell application was unable to open file")(setq it nil))))

;;; d = directory , e = extension like "*.dwg" , f = flag include subfolders (any value or nil)
;;; test : (length (alf "d:/temp/lisp" "*.dwg" t))  (length (alf "d:/temp/lisp" "*.dwg" nil))
;;; (setq l (alf "c:/temp/lisp" "*.xlsx" t)) (setq l (alf "c:\\temp\\lisp\\" "*.txt" t))
(defun alf (d e f) (setq d (vl-string-right-trim "/" (vl-string-translate "\\" "/" d)))
  (if f (apply 'append (cons (if (vl-directory-files d e)(mapcar '(lambda (x) (strcat d "/" x)) (vl-directory-files d e)))
    (mapcar '(lambda (x) (alf (strcat d "/" x) e f))(vl-remove ".." (vl-remove "." (vl-directory-files d nil -1))))))
      (mapcar '(lambda (x) (strcat d "/" x))(vl-directory-files d e 1))))

;;; (SplitStr "a,b,c" ",") -> ("a" "b" "c")
(defun SplitStr (s d / p)
  (if (setq p (vl-string-search d s))(cons (substr s 1 p)(SplitStr (substr s (+ p 1 (strlen d))) d))(list s)))

;;; (lst->csv '("a" "b" "c") "|") -> "a|b|c"
(defun lst->csv (%l $s)
  (apply 'strcat (cdr (apply 'append (mapcar (function (lambda (x) (list $s x))) %l)))))

;;; (sandwich '("a" "b" "c") "*") -> '("*a*" "*b*" "*c*")
;;; for whole word search each string in regex string has to begin and end with \\b
(defun sandwich (%l %c) (mapcar '(lambda (s)(strcat %c s %c)) %l))

;;; make sure each extension begin with *. (pimpex (splitstr "lsp,dwg" ",")) -> ("*.lsp" "*.dwg")
(defun pimpex (%l) (mapcar '(lambda (s)(strcat "*." (vl-string-trim "*." s))) %l))

;;; (yesno "Are you a dragon?")
(defun yesno ( m / n p i r ) (and (= (type m) 'STR) (setq n (vl-filename-mktemp "yesno.dcl")) (setq p (open n "w"))
  (princ (strcat"yesno :dialog{label=\"" m "?\";ok_cancel;}") p)(progn (close p)(gc) t) (setq i (load_dialog n))
    (new_dialog "yesno" i) (progn(action_tile "accept" "(done_dialog 1)")(action_tile "cancel" "(done_dialog 0)")
           (setq r (start_dialog))(unload_dialog i)(vl-file-delete n) t)(if (= r 1) t nil)))

; choose from list (cfl '("1" "2" "3"))
(defun cfl (l / f p d r) (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w"))
 (princ "cfl:dialog{label=\"Choose\";:list_box{key=\"lb\";width=40;}ok_cancel;}" p)
  (not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)
   (progn (start_list "lb")(mapcar 'add_list l)(end_list)(action_tile "lb" "(setq r (nth (atoi $value) l))(done_dialog 1)")
    (action_tile "accept" "(setq r (get_tile \"lb\"))(done_dialog 1)")(action_tile "cancel" "(setq r nil)(done_dialog 0)")
     (start_dialog)(unload_dialog d)(vl-file-delete f))) (cond ((= r "") nil)(r r)(t nil)))

;;; multiple from list (setq inp (mfl '("bak" "dwg" "pdf" "tif") '("dwg")))
(defun mfl (%l %df / toggle set_all l f p d r)
  (setq l (mapcar '(lambda (x)(if (member x %df)(strcat "[X] " x)(strcat "[O] " x))) %l))
  (defun toggle (v / s r)(if (eq (substr (setq r (nth (atoi v) l)) 2 1) "X")(setq s "[O] ")(setq s "[X] "))
    (setq l (subst (strcat s (substr r 5)) r l))(start_list "lb")(mapcar 'add_list l)(end_list))
  (defun set_all (i)(setq l (mapcar '(lambda (x)(if (eq i "1") (strcat "[X] " x) (strcat "[O] " x))) %l))
    (start_list "lb")(mapcar 'add_list l)(end_list))
  (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w"))
       (princ (strcat "cfl:dialog{label=\"Choose\";:list_box {height=12;key=\"lb\";}"
         ":button{label=\"All\";key=\"bt_all\";}:button{label=\"None\";key=\"bt_none\";}ok_cancel;}") p)
       (not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)
       (progn (start_list "lb")(mapcar 'add_list l)(end_list) (action_tile "lb" "(toggle $value)")
         (action_tile "accept" "(setq r (get_tile \"lb\"))(done_dialog 1)")
         (action_tile "cancel" "(setq r nil)(done_dialog 0)")
         (action_tile "bt_all" "(set_all \"1\")")(action_tile "bt_none" "(set_all \"0\")")
         (start_dialog)(unload_dialog d)(vl-file-delete f)))
  (if r (mapcar '(lambda (y)(substr y 5)) (vl-remove-if '(lambda (x)(eq (substr x 2 1) "O")) l)))
)

;;; display list (plus message)
(defun dplm (l m / f p d w) (and (vl-consp l) (setq l (mapcar 'vl-princ-to-string l)) (setq w (+ 5 (apply 'max (mapcar 'strlen l))))
  (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ (strcat "cfl:dialog{label=\"" m "\";:list_box {key=\"lb\";"
   "width="(itoa w)";}ok_only;}") p)(not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)(progn (start_list "lb")
     (mapcar 'add_list l)(end_list)(action_tile "accept" "(done_dialog)")(start_dialog)(unload_dialog d)(vl-file-delete f))))

;;; possibility to load / save the list and ShellOpen selection
(defun dplm+ (l m / load_list save_list open_item f p d w pick)
  ;;; results are saved in user\desktop\quickstringsearch\QSS-Shadow-List.txt (QSS-Shadow-List-fn)
  ;;; each line begins with 0|error| , 1|unable to open| , 2|no hit| or 3|hit|
  (defun load_list ( / result-list)
    (if (and (findfile QSS-Shadow-List-fn)(setq QSS-Shadow-List-fp (open QSS-Shadow-List-fn "r")))
      (progn
        (while (setq inp (read-line QSS-Shadow-List-fp))
          (if (= (car (setq inp (SplitStr inp "|"))) "3") (setq result-list (cons (last inp) result-list))))
        (if (vl-consp result-list)(setq l (reverse result-list)) (setq l '("No results")))
        (start_list "lb")(mapcar 'add_list l)(end_list)
      )
      (alert "Unable to load list")
    )
  )
  
  ;;; very basic file save routine
  (defun save_list ( / f p)
    (if (and (vl-consp l) (setq f (vl-filename-mktemp "QuickStringSearch.txt")) (setq p (open f "w")))
      (progn (mapcar '(lambda (x)(write-line x p)) l) (close p) (gc) (startapp "notepad" f))))
  
  (defun open_item ( / i f)(if (and (vl-consp l)(not (null pick))(setq i (atoi pick))(setq f (nth i l))(setq f (findfile f)))
    (cond ((wcmatch (strcase (last (fnsplitl f)) t) "*.dwg")(setq open-at-the-end f)(done_dialog))(t (_ShellOpen f)))))

  (defun list_box_action ($r $v) (cond ((= $r 1) (setq pick $v)) ((= $r 4) ;|double click|; (setq pick $v)(open_item))))

  (if (not (vl-consp l)) (setq l (list "No results")) (setq l (mapcar 'vl-princ-to-string l)))
  ;;; make width dialog based on longest string in list
  (setq w (+ 5 (apply 'max (mapcar 'strlen l))))
  (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w"))
  (write-line (strcat "cfl:dialog{label=\"" m "\";") p)
  (write-line (strcat ":list_box {key=\"lb\";width=" (itoa w) ";height=25;}") p)
  (write-line (strcat ":column {:row {fixed_width=true;alignment=centered; :button {key=\"bt_load\";label=\"Load\";}"
                          ":button {key=\"bt_save\";label=\"Save\";} :button {key=\"bt_open\";label=\"Open\";}}}") p)
  (write-line "ok_only;}" p)
  
  (if p (close p))
  (if (and (< 0 (setq d (load_dialog f))) (new_dialog "cfl" d))
    (progn
      (start_list "lb")(mapcar 'add_list l)(end_list)
      (action_tile "accept" "(done_dialog)") (action_tile "lb" "(list_box_action $reason $value)")
      (action_tile "bt_load" "(load_list)") (action_tile "bt_save" "(save_list)")  (action_tile "bt_open" "(open_item)")
      (start_dialog) (unload_dialog d) (vl-file-delete f)
    )
  )
)



;--- + + + ---------------------------------------------- End of tiny lisp section ---------------------------------------------- + + + ---


;;; --- Odbx ---------------------------------------------- Begin Odbx Section ----------------------------------------------- Odbx --- ;;;

(defun GetAllOpenDocs ()
  (or actApp (setq actApp (vlax-get-acad-object))) (or actDoc (setq actDoc (vla-get-ActiveDocument actApp)))
    (or actDocs (setq actDocs (vla-get-documents actApp)))
  (vlax-for doc actDocs (if (= 1 (vlax-variant-value (vla-getvariable doc "DWGTITLED"))); no nameless drawings
    (setq AllOpen (cons (cons (strcase (vla-get-fullname doc)) doc) AllOpen))))
)
       
(defun _ReleaseAll ()
  (mapcar '(lambda(x) (if (and (= 'vla-object (type x)) (not (vlax-object-released-p x)))
    (vlax-release-object x))(set (quote x) nil)) (list actLay actDoc actDocs actApp dbxObj))(gc))

(defun _ReleaseAll ()
  (mapcar '(lambda(x) (if (and (= 'vla-object (type x)) (not (vlax-object-released-p x)))
    (vlax-release-object x))(set x nil)) (list 'doc 'actLay 'actDoc 'actDocs 'actApp 'dbxObj))(gc))

(defun _InitObjectDBX ()(or actApp (setq actApp (vlax-get-acad-object)))
  (or actDoc (setq actDoc (vla-get-ActiveDocument actApp)))(or AllOpen (setq AllOpen (GetAllOpenDocs)))
  (setq dbxObj (vl-catch-all-apply 'vla-getinterfaceobject (list actApp (dbx_ver))))
  (if (or (null dbxObj)(vl-catch-all-error-p dbxObj))(progn (princ "\nObjectDbx not available")(setq dbxObj nil)))
  dbxObj
)


(defun odbx_open ( $dwg / _pimp doc) (or AllOpen (GetAllOpenDocs))
  (or dbxObj (_InitObjectDBX))
  (defun _pimp (s) (strcase (vl-string-trim " ;\\" (vl-string-translate "/" "\\" s))))
  (cond ((or (void $dwg) (not (findfile $dwg)))(princ "\nInvalid drawing")(setq doc nil))
	((not (or dbxObj (_InitObjectDBX)))(princ "\nObjectDbx not available")(setq doc nil))
        ((setq doc (cdr (assoc (_pimp $dwg) AllOpen))))
	((vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list dbxObj (findfile $dwg))))
	 (princ "\nUnable to open drawing.")(setq doc nil))
	(t (setq doc dbxObj)))
  doc
)

(defun odbx_close ( %doc ) (if (and (= 'vla-object (type %doc))
  (not (vlax-object-released-p %doc)))(progn (vlax-release-object %doc))(setq %doc nil)))

(defun dbx_ver ( / v)
  (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v)))))

;;; function to find all strings (txt/att etc) in all drawings in a folder
;;; QSS-Search-Folder	QSS-Include-Subfolders	QSS-Filename-Extension-Filter	QSS-Search-String-Filter
;;; QSS-Get-Everything	QSS-Case-Sensitive	QSS-Whole-Words-Only

;;; alf : d = directory , e = extension like "*.dwg" , f = flag include subfolders (any value or nil)
;;; test : (length (alf "d:/temp/lisp" "*.dwg" t)) 
(defun QSS_Get_Everything ( / actDoc actDocs actApp dbxObj RegExp dbx-doc write_result show_result 
                              search-folder dwg-list rtn result-list search-pattern result-list-fn
                              folder-list file-count l
                           )
  
  ;;; init vl functions, odbx & regexp
  (vl-load-com) (_InitObjectDBX) (or RegExp (setq RegExp (vlax-create-object "VBScript.RegExp")))
  
  (defun write_result (lst fn / fp)
    (cond
      ((not (vl-consp lst))
       (alert "Computer says no : empty result list, nothing to write"))
      ((or (not (= (type fn) 'STR)) (not (setq fp (open fn "w"))))
       (alert (strcat "unable to write to : " (vl-princ-to-string fn))))
      ;;; format lst : ( ("dwgname1" . ("str1" "str2" ...)) ...)
      (t
       (write-line (strcat "Scanned " (itoa (length lst)) " drawings\n") fp)
       (foreach item lst
         (write-line (car item) fp)
         (foreach str (cdr item) (write-line (vl-princ-to-string str) fp))
         (write-line "\n--\n" fp)
       )
      )
    )
    (if fp (progn (close fp)(gc)(gc))) 
    (princ)
  )
  
  (defun show_result (fn)
    (if (and fn (setq fn (findfile fn)))
      (startapp "notepad" fn)
      (alert (strcat "Computer says no : unable to read from : " (vl-princ-to-string fn)))
    )
    (princ)
  )

  ;; (setq d (vl-string-right-trim "\\/" d))
  (setq search-pattern "*" result-list-fn (strcat (vl-string-right-trim "\\/" QSS-Search-Folder) "\\QuickStringSearchResult.txt"))

  ;;; fire-up process bar
  (clear_bar)(set_tile "the_bar" " working...")
  (cond
    ((not (vl-file-directory-p QSS-Search-Folder))
     (alert (strcat "Folder " QSS-Search-Folder " does not exist - change folder")))
    ;((not (vl-consp (setq dwg-list (alf QSS-Search-Folder "*.dwg" (if (eq QSS-Include-Subfolders "1") T nil)))))
    ; (alert (strcat "No dwg files in " QSS-Search-Folder)))
    (t
     ;;; if return-as-list is T regex_string_search returns all strings else T or nil if pattern is found
     (setq return-as-list T file-count 1)
     ;;; first scan for subfolder
     (if (eq QSS-Include-Subfolders "1")
         (setq folder-list (QSS_FindSubfolders QSS-Search-Folder)) (setq folder-list (list QSS-Search-Folder)))
     ;;; just a little delay to enjoy the view, exterminate when it gets anoying
     (wait 1.5)
     (setq dwg-list (QSS_FindFiles folder-list (list "*.dwg")))
     (clear_bar)
     (set_tile "the_bar" (strcat "Number of files to search : " (setq n (itoa (length dwg-list)))))
     (foreach dwg dwg-list
       (if (setq dbx-doc (odbx_open dwg))
         (progn
           (if (vl-consp (setq rtn (regex_string_search dbx-doc search-pattern return-as-list)))
             (setq result-list (cons (cons dwg rtn) result-list)))
           ;;; release doc to prevent dbx memory leak
           ;(odbx_close dbx-doc)
         )
         (princ (strcat "\nUnable to open " dwg))
       )
       ;;; clear previous status
       (clear_bar)
       ;;; update status message
       (set_tile "the_bar" (strcat "   ( " (setq *spin* (Spinbar *spin*)) " ) Scanning files [" (itoa file-count) " of " n))
       ;;; increase file counter
       (setq file-count (1+ file-count))
     )
     (_ReleaseAll)
    )
  )
  ;;; (vlax-release-object dbxObj)

  ;;; release RegExp
  (if (= 'vla-object (type RegExp))(vlax-release-object RegExp))
  
  (if (vl-consp result-list)
    (progn (write_result result-list result-list-fn) (show_result result-list-fn))
    (princ (strcat "\nNo text was found in dwg files in " (vl-princ-to-string search-folder)))
  )
  (princ)
)



;;; doc = duh , pat = duh , ral = return as list , if T return all strings , if nil test for pattern and return nil or T
(defun regex_string_search (doc pat ral / pat-p pattern ingnoreCase global
                            blocks objName textStr atts result s tableRow tableCol)
  ;;; not realy needed because als called in test function
  (or RegExp (setq RegExp (vlax-create-object "VBScript.RegExp")))

  ;;; *** still to do create regex version, not sure pat-p is working as intended
  ;;; test if pattern is found in list of strings (RegExp needs to be initialized)
  (defun pat-p (p l) (vl-some (function (lambda (s)(= (vlax-invoke-method RegExp 'Test s) :vlax-true))) l))

  ;;; *** still to do : apply ignore case / whole words only to pattern
  ;;; alternative : (lwcmatch "M-16427" '("As built K-16886.pdf" "As built M-16427.pdf" "As built N-16260.pdf"))
  (defun lwcmatch ( p l / r ) (foreach x l (if (vl-string-search p x)(setq r (cons x r)))) r)

  ;;; (re)init regex pattern (QSS-Search-String-Filter) is something like "Fikkie|Rlx"
  (setq pattern QSS-Search-String-Filter global T)
  (if (eq QSS-Case-Sensitive "1")(setq ignoreCase nil)(setq ignoreCase T))
  ;;; **** test 2026-06-01 on request Percy ****
  (if (eq QSS-Get-Everything "1") (setq pattern "*"))
  (InitRegExp pattern ignoreCase global)

  ;;; go through all document objects and retrieve textstring, return as list or test with regex (pat-p)
  (setq blocks (vla-get-blocks doc))
  (if (/= pat "")
    (progn
      (vlax-for block blocks
        (vlax-for obj block
          (setq objName (vlax-get-property obj 'ObjectName))
          (setq textStr nil)
          ;;; Filter objects & get textString
          (cond
            ;; Text en MText
            ((vl-position objName '("AcDbText" "AcDbMText"))
             (setq textStr (vlax-get-property obj 'TextString)))
            ;; Old Leaders & Dimensions
            ((vl-position objName '("AcDbLeader" "AcDbDimension" "AcDbRotatedDimension" "AcDbAlignedDimension"))
             (if (vlax-property-available-p obj 'TextOverride)
               (setq textStr (vlax-get-property obj 'TextOverride))))
            ;; Modern MultiLeaders (MLeader)
            ((= objName "AcDbMLeader")
             (if (= (vlax-get-property obj 'ContentType) 2) ; 2 = acMTextContent
               (setq textStr (vlax-get-property obj 'TextString))))
            ;; Block Reference with Attributes
            ((= objName "AcDbBlockReference")
             (if (= (vlax-get-property obj 'HasAttributes) :vlax-true)
               (progn
                 (setq atts (vlax-invoke obj 'GetAttributes))
                 (foreach attObj atts
                   (setq s (vlax-get-property attObj 'TextString))
                   (if (and s (/= s "")) ;(= (vlax-invoke-method RegExp 'Test pat) :vlax-true))
                     (progn (setq textStr (cons  (strcat "Block " (vlax-get-property obj 'Name)
                         ", Tag : " (vlax-get-property attObj 'TagString) ", Text : " s) textStr))))
                 )
               )
             )
            )
            ;; Tabellen (Scant elke cel afzonderlijk)
            ((= objName "AcDbTable")
             (setq tableRow 0)
             (while (< tableRow (vlax-get-property obj 'Rows))
               (setq tableCol 0)
               (while (< tableCol (vlax-get-property obj 'Columns))
                 (setq s (vlax-invoke obj 'GetText tableRow tableCol))
                 (if (and s (/= s "")); (= (vlax-invoke-method regex 'Test textStr) :vlax-true))
                   (setq textStr (cons  (strcat "Table [Row " (itoa tableRow) ", Col " (itoa tableCol) "]: " s) textStr)))
                 (setq tableCol (1+ tableCol))
               )
               (setq tableRow (1+ tableRow))
             )
            )
          ) ;;; end cond
          
          ;;; put result in list
          (cond
            ((null textStr))
            ((vl-consp textStr) (foreach x textStr (setq result (cons x result))))
            (t (setq result (cons textStr result)))
          )
        ) ;;; vlax-for block
      ) ;;; vlax-for blocks
    ) ;;; end progn
  ) ;;; end if (/= pat "")

  ;;; if ral = T return all strings as list else only return T if pattern is found in result list
  ;;; *** still to do replace lwcmatch with regex version (pat-p)
  ;(if ral result (lwcmatch pat result))
  (if ral result (pat-p pattern result))
)


;;; --- Odbx ---------------------------------------------- End Odbx Section ------------------------------------------------- Odbx --- ;;;




;;; --- RegExp -------------------------------------------------- RegExp --------------------------------------------------- RegExp --- ;;;


;;; Separate multiple patterns by pipe-operator |
;;; (vlax-put-property regexp "Pattern" "Rlx|CadTutor|Visual Lisp")
;;; Whole words only (not "Rlxie" when searching for "Rlx"):
;;; (vlax-put-property regexp "Pattern" "\\bRlx\\b|\\bCadTutor\\b|\\bVisual Lisp\\b")

;;; pattern	: Pattern to search.
;;; ignoreCase	: If non nil, the search is done ignoring the case.
;;; global	: If non nil, search all occurences of the pattern, if nil, only searches the first occurence.
(defun InitRegExp (pattern ignoreCase global)
  (or RegExp (setq RegExp (vlax-create-object "VBScript.RegExp")))
  (vlax-put RegExp 'Pattern pattern)
  (if ignoreCase (vlax-put RegExp 'IgnoreCase acTrue)(vlax-put RegExp 'IgnoreCase acFalse))
  (if global (vlax-put RegExp 'Global acTrue)(vlax-put RegExp 'Global acFalse))
  RegExp
)

;;; len :  Number of bytes to read. If non numeric, < 1 or greater than the number of bytes in file everything is returned.
;;; iomode : 1 = read, 2 = write, 8 = append , format : 0 = ascii, -1 = unicode, -2 = system default
(defun _ReadStream ( path len / fso file stream result )
  (vl-catch-all-apply
    '(lambda ( / iomode format size )
       (setq iomode 1 format 0 fso (vlax-create-object "Scripting.FileSystemObject") file (vlax-invoke fso 'GetFile path)
	     stream (vlax-invoke fso 'OpenTextFile path iomode format) size (vlax-get file 'Size)
	     len (if (and (numberp len) (< 0 len size)) (fix len) size) result (vlax-invoke stream 'read len))
       (vlax-invoke stream 'Close)
     )
  )
  (if stream (vlax-release-object stream))(if file (vlax-release-object file))(if fso (vlax-release-object fso))
  result
)

(defun _ReadStream-n ( path len n / fso file stream result lst)
  (vl-catch-all-apply
    '(lambda ( / iomode format size )
       (setq iomode 1 format 0 fso (vlax-create-object "Scripting.FileSystemObject") file (vlax-invoke fso 'GetFile path)
	     stream (vlax-invoke fso 'OpenTextFile path iomode format) size (vlax-get file 'Size)
	     len (if (and (numberp len) (< 0 len size)) (fix len) size))
       (repeat n
	 (setq result (vlax-invoke stream 'read len))
	 (setq lst (cons result lst))
       )
       (vlax-invoke stream 'Close)
     )
  )
  (if stream (vlax-release-object stream))(if file (vlax-release-object file))(if fso (vlax-release-object fso))
  lst
)


;;; T if pattern is found else nil
(defun c:test2 ( / fn pattern stream ignoreCase rtn)
  (setq fn "C:\\Temp\\Lisp\\RlxBatch.lsp")
  (setq ignoreCase T)
  (setq pattern "-publish")
  ;(setq pattern "dragon")
  (and
    (= (type fn) 'STR)
    (setq fn (findfile fn))
    (setq stream (_ReadStream fn 0))
    (setq rtn (= (vlax-invoke (InitRegExp pattern ignoreCase nil) 'Test stream) -1))
  )
  rtn
)

;;; --- RegExp -------------------------------------------------- RegExp --------------------------------------------------- RegExp --- ;;;



;;; --- Excel ---------------------------------------------------- Excel ---------------------------------------------------- Excel --- ;;;

(defun Init_Excel ()
  (or xlApp (setq xlApp (vlax-get-or-create-object "Excel.Application"))) (vla-put-visible xlApp :vlax-false))

(defun Exit_Excel ()
  (if xlApp (progn (vl-catch-all-apply 'vlax-invoke-method (list xlWorkbook 'Close :vlax-false))
    (vlax-release-object xlSheets) (vlax-release-object xlWorkbook) (vlax-release-object xlApp))))

;;; retrieve all values from Excel workbook
(defun Scan_Excel (fn / f xlUsedRange rows xlValue _safearray tmp-lst result excel-range excel-used-range excel-max-row excel-max-column
                        excel-max-range excel-variant excel-value excel-to-list l2 l3 pattern ignoreCase global)
  ;;; just to make sure regex is up and running
  (or RegExp (setq RegExp (vlax-create-object "VBScript.RegExp")))
  ;;; test if pattern is found in list of strings (RegExp needs to be initialized)
  (defun pat-p (p l) (vl-some (function (lambda (s)(= (vlax-invoke-method RegExp 'Test s) :vlax-true))) l))
  ;;; (re)init regex pattern (QSS-Search-String-Filter) is something like "Fikkie|Rlx"
  (setq pattern QSS-Search-String-Filter global T)
  (if (eq QSS-Case-Sensitive "1")(setq ignoreCase nil)(setq ignoreCase T))
  (InitRegExp pattern ignoreCase global)
  
  (if (and fn (string-p fn) (setq f (findfile fn)))
    (progn
      (Init_Excel)
      (setq xlWorkbooks (vlax-get-property xlApp 'Workbooks))
      (setq xlWorkbook (vlax-invoke-method xlWorkbooks 'Open f))
      (setq xlSheets (vlax-get-property xlWorkbook 'Sheets))
      (vlax-for xlSheet xlSheets
        (setq xlUsedRange (vlax-get-property xlSheet 'UsedRange))
        ;;; Set limits on number of rows, not sure what size would be to much for AutoCad to handle
        (setq rows (vlax-get-property (vlax-get-property xlUsedRange 'Rows) 'Count))
        (if (< rows 500000) 
          (progn
	    (and
              (setq excel-variant (vlax-get-property xlUsedRange 'Value))
	      (setq excel-value (vlax-variant-value excel-variant))
              (setq excel-to-list (vlax-safearray->list excel-value))
	      (setq tmp-lst (vl-remove nil (mapcar '(lambda (x) (vl-remove nil (mapcar '(lambda (y / val)
                (setq val (vl-catch-all-apply 'vlax-variant-value (list y)))
                  (if (vl-catch-all-error-p val) nil val)) x))) excel-to-list)))
              (setq result (append result tmp-lst))
            )
          )
          (princ
            (strcat
              "\nSkipped " (vl-filename-base fn) " Tab '"
                         (vlax-get-property xlSheet 'Name) "' : to many rows (" (itoa rows) ")."))
        )
        (vlax-release-object xlUsedRange)
        (vlax-release-object xlSheet)
      )
      (vlax-invoke-method xlWorkbook 'Close :vlax-false)
    )
  )
  ;;; test if pattern is found in result list , returns T or nil
  (if (vl-consp result) (pat-p pattern (mapcar 'vl-princ-to-string (apply 'append result))))
)
 
;;; --- Excel -------------------------------------------- End of Excel Section --------------------------------------------- Excel --- ;;;


;;; --- Word --------------------------------------------- Begin of Word Section --------------------------------------------- Word --- ;;;

(defun SearchInWord (filePath openText / wordApp docCollection wordDoc wordSelect found)
  (vl-load-com)
  (setq found nil)
  
  ;; 1. Start Word in de achtergrond (onzichtbaar)
  (if (setq wordApp (vlax-get-or-create-object "Word.Application"))
    (progn
      (vla-put-visible wordApp :vlax-false) ; Zorg dat Word onzichtbaar blijft
      (setq docCollection (vla-get-documents wordApp))
      
      ;; 2. Open het document (Alleen-lezen = :vlax-true, Onzichtbaar)
      (setq wordDoc (vlax-invoke-method docCollection 'Open filePath :vlax-false :vlax-true))
      
      (if wordDoc
        (progn
          ;; 3. Gebruik de Find-methode van de documentinhoud
          (setq wordSelect (vlax-get-property wordDoc 'Content))
          (setq wordFind (vlax-get-property wordSelect 'Find))
          
          ;; Voer de zoekopdracht uit (parameters: tekst, matchCase, matchWholeWord, etc.)
          (setq found (vlax-invoke-method wordFind 'Execute openText :vlax-false :vlax-false))
          
          ;; 4. Sluit het document zonder wijzigingen op te slaan
          (vlax-invoke-method wordDoc 'Close :vlax-false)
        )
      )
      ;; 5. Sluit de Word-applicatie af en reinig het geheugen
      (vlax-invoke-method wordApp 'Quit)
      (vlax-release-object wordFind)
      (vlax-release-object wordSelect)
      (vlax-release-object wordDoc)
      (vlax-release-object docCollection)
      (vlax-release-object wordApp)
    )
  )
  ;; Geeft :vlax-true terug als de tekst is gevonden, anders :vlax-false of nil
  found
)

;;; ------------------------------------------------------- End of Word Section ------------------------------------------------------- ;;;



;;; powershell

;;;powershell -Command "$w=New-Object -ComObject Word.Application; $w.Visible=$false; $d=$w.Documents.Open('C:\Pad\Naam.pdf',+
;;;                    $false, $true); if($d.Content.Find.Execute('ZOEKTERM')) { 'GEVONDEN' | Out-File 'C:\Users\Naam\Desktop\result.txt' };+
;;;                    $d.Close($false); $w.Quit()"
;;; (SearchInPDF "c:\\temp\\test.pdf" "Rlx")
(defun SearchInPDF (pdfPath openText / shApp txtResult resFile found)
  (vl-load-com)
  (setq resFile (strcat (getenv "USERPROFILE") "\\Desktop\\pdf_result.txt"))
  
  ;; 1. Verwijder een eventueel oud resultaatbestand op de desktop
  (if (findfile resFile) (vl-file-delete resFile))

  ;; 2. Bouw het PowerShell-commando op (alles op 1 regel)
  ;; Dit opent de PDF via de Word-engine op de achtergrond en zoekt naar de tekst.
  (setq psCmd (strcat
    "powershell -WindowStyle Hidden -Command "
    "\"$w=New-Object -ComObject Word.Application; $w.Visible=$false; "
    "$d=$w.Documents.Open('" pdfPath "', $false, $true); "
    "if($d.Content.Find.Execute('" openText "')) { 'JA' | Out-File '" resFile "' }; "
    "$d.Close($false); $w.Quit();\""
  ))

  ;; 3. Voer het commando onzichtbaar uit via de Windows Shell
  (setq shApp (vlax-get-or-create-object "WScript.Shell"))
  (vlax-invoke-method shApp 'Run psCmd 0 :vlax-true) ; 0 = onzichtbaar venster, :vlax-true = wacht tot klaar
  (vlax-release-object shApp)

  ;; 4. Controleer of het tekstbestand is aangemaakt (tekst is gevonden!)
  (if (findfile resFile)
    (progn
      (setq found t)
      (vl-file-delete resFile) ; Netjes opruimen
    )
    (setq found nil)
  )
  
  found ; Geeft T terug als de tekst in de PDF staat, anders nil
)

;;; powershell



;;; -------------------------------------------------- Begin of Progress Bar Section -------------------------------------------------- ;;;

; (setq lst (acad_strlsort (QSS_FindSubfolders "c:/temp/lisp")))
(defun QSS_FindSubfolders ( d / l r s msg ) (setq d (vl-string-right-trim "\\/" d))  (setq l (list d)) trim
  (while l (setq s nil)(foreach d l (setq s (append s (mapcar (function (lambda ( x ) (strcat d "/" x)))
    (vl-remove-if (function (lambda (x)(member x '("." ".."))))(vl-directory-files d nil -1))))))(setq r (append s r) l s)
      (start_image "the_bar")(fill_image 0 0 (dimx_tile "the_bar") (dimy_tile "the_bar") 131)(end_image)
      (setq msg (strcat "   ( " (setq *spin* (Spinbar *spin*))" ) Scanning for subfolders : " (itoa (length r))))
      (set_tile "the_bar" msg)
  )
  ;;; make sure sourcefolder is part of result
  (cons d r)
)

;;; called from QSS_Pre_Scan line 201
;;; (setq rtn (QSS_FindFiles '("c:/temp/lisp") '("*.lsp" "*.txt")))
(defun QSS_FindFiles (folder-list extension-list / folder result result-list status)
  ;;; folder-list is list of all (sub)folders to scan , make sure all folders end with "/"
  (setq folder-list (acad_strlsort (mapcar 'vl_path folder-list)))
  (foreach folder folder-list
    (foreach ext extension-list
      (if (vl-consp (setq result (mapcar '(lambda (x) (strcat folder x)) (vl-directory-files folder ext 1))))
        (setq result-list (append result-list result))
      )
    )
    ;;; clear previous status
    (start_image "the_bar")(fill_image 0 0 (dimx_tile "the_bar") (dimy_tile "the_bar") 141)(end_image)
    ;;; update status message
    (setq status (strcat "   ( " (setq *spin* (Spinbar *spin*)) " ) Scanning for files : " (itoa (length result-list))))
    (set_tile "the_bar" status)
  )
  result-list
)

; funny little indicator found in StripMtext.lsp
;(princ (strcat "\r (" (setq s (Spinbar s)) ") Files : " (itoa (setq i (1+ i))) "\t\t"))
(defun SpinBar (spin) (cond ((= spin "\\") "|") ((= spin "|") "/") ((= spin "/") "-") (t "\\")))

;;; ---------------------------------------------------- End of Progress Bar Section -------------------------------------------------- ;;;

(princ "\nQuick String Search - Rlx Jun'26 - Type QSS")

;(c:qss)

Most info included in lisp file. Just a quick string search for lsp, txt & dwg files.

Start with QSS , select folder , extension like lsp,dwg and search string like Rlx

Type in extensions like lsp,txt (with comma) and for text use pipe symbol like Rlx|Dragon

for now only lsp,txt and dwg are supported , haven't been able to make it work on pdf

I have added a couple of toggles , Shadow mode , Recovery & Everything.

Shadow mode writes a log file for every file that is searched. Next to it is Recovery.

When searching oh lets say 100.000+ files and one of the files is corrupt AutoCad crashes and all previous results are poof...

When this happens start AutoCad again , select Recovery , and app will continue the search by comparing the complete file-list

with the shadow list and can work out from where to continue and put corrupt drawing on the naughty list.

These files are saved on desktop in QuickSearchFolder.

If a drawing was saved with a higher version I can error-catch that but when a file is corrupt lisp can't handle that so hence the recovery option.

When multiple drawings are corrupt you have to repeat this process as many times until app reaches the finish line.

When the list pops up you only see the matches found from the last successful run, click on the load button and shadow list is read again et voila.

When 'Everything' is selected all text from all files (drawings) are saved to a text file.

Button Clear Lists in main dialog deletes all files from desktop folder so you can start as fresh as a baby's butt (after a bath of course)

Also corrected a little bug in the get-subfolders routine. Within the code I was working on doc/docx & pdf support but they are so slow I removed them from extension filter , but if you want to try uncomment line 285 and comment line 286

Edited 2 hours ago by rlx
2026-06-01 killed a bug and added some options

May 18

@RLX I use windows Findstr under CMD for search txt and lsp etc, just having a play how to call a bat file from CAD. I used ;

(startapp "D:\\acadtemp\\test.bat insert")

CMD option manually

Windows lower left CMD
Cd d:\alan\lisp
Findstr "insert" *.lsp

Bat file, I have one called fnd.bat

D:
Cd\alan\lisp
findstr %1 *.lsp
pause

Pretty sure Findstr supports search sub directories. You should also be able to redirect to a file > filename.

You are right use lisp to write the bat file, choose directory etc. It does not work with DWG files.

Edited May 18 by BIGAL

May 18

I also used to use theDOS thing , but its not nearly as sexy :

(sorry , <> has been disabled by my work , file upload as well and if I try to use a bat file admin locks me down)

Will post tonight

May 18

Have they locked Powershell also ? I use it at times.

Converting the lisp code to .net would speed up searching the txt & lsp files, in lisp directory I have 1500+ lsp files. But chances are your admin has that locked.

May 18

Nice work IT!

They got you to spend hours trying to circumvent the limitations they forced upon their employees just to make it workable.

May 18

Yeah , well , I'm afraid to tempt 'the Gods' how much worse it can get haha. Big reorganization on its way and we hope things can only get better , but that's maybe tempting fate

In the mean while got it working (I think) for excel workbooks too , but gonna have to post that later when I get home tonight.

Clippy (the AI) told me without external programs like Adobe or pdf2text , its very unlikely I'm gonna be able to directly retrieve strings from a pdf. Since I cant install any software other than provided by the company that's not gonna happen. Only way would be pdfimport and pdfshx but that would defeat the purpose of this appie.

May 18

32 minutes ago, rlx said:

Clippy (the AI) told me without external programs like Adobe or pdf2text , its very unlikely I'm gonna be able to directly retrieve strings from a pdf.

If the text is Searchable in the PDF. Windows Explorer will work. if the PDF is just an image then it wont work and have to use Adobe's OCR to convert them to be searchable.

-Edit

Tho not 100% some stuff come in weird like fractions or text between white space and pictures.

Edited May 18 by mhupp

May 18

Before I used this :

(defun GetFolder ( m / f s) (if (and (setq s (vlax-create-object "Shell.Application"))
  (setq f (vlax-invoke s 'browseforfolder 0 m 65536 "")))(setq f (vlax-get-property (vlax-get-property f 'self) 'path))
     (setq f nil))(vl-catch-all-apply 'vlax-release-object (list s)) f)

(defun wait (sec / stop)(setq stop (+ (getvar "DATE") (/ sec 86400.0)))(while (> stop (getvar "DATE"))))

(defun findstring ( / a b c d e)
  (setq a (GetFolder "Select folder for string search"))
  (setq b (getstring "\nEnter string to search for : " T))
  (setq c (getstring "\nFile extension (lsp) : ")) (if (eq c "") (setq c "lsp"))
  (setq d (strcat a "\\result.txt"))
  (setq e (strcat "findstr /i /s \"" b "\" " a "\\*." c " > " d))
  (command "shell" e)
  (gc)(gc)
  ;;; natural delay for system to clear cache and write file to disk
  (alert "search completed")
  (startapp "notepad" d)
  (princ)
)

(defun c:dfs ()(findstring))

(defun c:t1 ()(findstring)(princ))

This code only works for text based files.

Have updated code in my first post with Excel support. Valid extensions are now lsp , txt , dwg , xls and xlsx

I have a license for able2extract on my home computer and also written something that uses pdfattach and import for readable pdf's.

Though I can take that route, it's not like shoot & forget , often more than one step is needed.

But it is what it is... most pdf's I get are pretty poor quality , some by accident and some not because a 3rd party wants you as a returning client if you know what I mean.

Edited May 18 by rlx

May 18

Nice job!

May 19

I know where your coming from where I worked last some 1000 pc's, we were lucky and had a good relationship with IT and could explain why we wanted something and most times they would go away and think about it, but approve and install, they would come to me to do the CAD installs, with the IT guy with me for user permissions. Each new PC was a "Hope it works" as they came preinstalled with corporate software.

Edited May 19 by BIGAL

May 19

Tried this out some yesterday, this will be useful for sure! The things we have to do to bypass security features that don't work.

I remember in high school a few teachers would tell the kids that didn't make passing grades that the world needs ditch diggers, too. Now they probably say the world needs IT techs.

Some of the things they do defy any sort of normal thought processes.

I received a call last week, one of the main people that use my drawings called and stated they couldn't open drawings after IT installed a new computer. You guessed it, no AutoCAD.

A normal person should see what was on the old computer that was necessary and needs to move to the new computer. At least they installed the software for the waterjet, plasma cutter, etc.

May 19

Another way to get the text from a pdf is the AI option 'OCR text & table from Microsoft PC manager, normally just available in the US store.

But if you have VPN or are a really good singer (Queen : Oh...yes , I'm the great pretender lalala.. applause , oh thank you , you're so kind) you should be able to get it.

Open pdf , use button et voila... but its still manual labor

May 19

I doubt if IT would allow that either, I have it at home so might see how that would work out.

I believe Ghostscript's txtwrite is improved and should be capable as well, as noted an OCR is needed for images, Tesseract OCR — The World's Best Open Source OCR Engine.

There may still be errors in the conversions. I know Adobe Acrobat has issues at times, I haven't used it in a few months though.

2026-06-01T15:02:36Z

Updated first post , added a few new options and killed a little bug in the get-subfolders routine.

2026-06-01T16:18:32Z

@rlx Your Kung-Fu is Strong! Nice work!

Sign In

Quick String Search

Recommended Posts

rlx

BIGAL

rlx

BIGAL

dexus

rlx

mhupp

rlx

SLW210

BIGAL

SLW210

rlx

SLW210

rlx

pkenewell

Join the conversation

Tutorials

Forums

Activity