[求助]如何释放经lisp+vba呼叫后的记忆体

cv7227 · 发表于 2003-9-14 15:37:00

本人因工作需求，开发了可让图中的资料直接传送至EXCEL以方便查询。
由于资料有重复的问题，但只要把EXCEL上的资料经SORT处理后，即可达到要求。
所以在程序上引用了VBA把以上的功能加强。一切都ok...但后来发觉机子在运用此程序后速度越来越慢最后导致当机！！！
经一番查阅后，发现竟是(defun PDS_SORT_XL) 里的MX-SORT部位发生了问题！执行后的记忆体释放不了！而且每一次就增加一个EXCEL记忆体藏在内存！
以下是部分的程序，请各位大侠帮帮忙！无限感激！！！

copy


(defun C:PDS_XL (/ XLRANGE CEOBJ SHEETOBJ WB-OBJ XLOBJ XLV)
  (vl-load-com)
  (setq XLV (PDS_GET_EXCEL_LIB))
  (PDS_CREATE_EXCEL_SHEET)
  (setq XLRANGE (cons 5 15))
  (PDS_SORT_XL XLRANGE) ；如跳过此段，记忆体释放不误！
  (PDS-EXCEL-QUIT)
) ;PDS_XL
(defun PDS_GET_EXCEL_LIB (/ SYS:DRV OFFICE:DIR OFFICE:DIR1 OFFICE:DIR2 EXLIB)
  (if (= (setq SYS:DRV (getenv "systemdrive")) NIL)
    (setq SYS:DRV "C:")
  )
  (setq OFFICE:DIR (strcat SYS:DRV "\\Program Files\\Microsoft Office"))
  (setq        OFFICE:DIR1 "office"
        OFFICE:DIR2 "office10"
  )
  (cond        ((setq EXLIB (findfile (strcat OFFICE:DIR OFFICE:DIR1 "Excel8.olb")))
         (setq XLV "EX97")
        ) ;Excel 97 & 98
        ((setq EXLIB (findfile (strcat OFFICE:DIR OFFICE:DIR1 "Excel9.olb")))
         (setq XLV "EX2k")
        ) ;Excel 2000
        ((setq EXLIB (findfile (strcat OFFICE:DIR OFFICE:DIR1 "Excel.exe")))
         (setq XLV "EXXP")
        ) ;Excel XP
        ((setq EXLIB (findfile (strcat OFFICE:DIR OFFICE:DIR2 "Excel.exe")))
         (setq XLV "EXXP")
        )
        (t (setq EXLIB NIL))
  ) ;cond
  (if (null mx-acos)
    (if        EXLIB
      (vlax-import-type-library
        :tlb-filename EXLIB
        :methods-prefix "MX-"
        :properties-prefix "MX-"
        :constants-prefix "MXC-"
       )
      (alert "Excel Typelib not exist")
    ) ;if
  ) ; if mx-acos
  XLV
) ;PDS_get_excel_Lib
(defun PDS_CREATE_EXCEL_SHEET ()
  (setq XLOBJ (vlax-create-object "Excel.Application"))
  (vla-put-visible XLOBJ 1)
  (setq WB-OBJ (vlax-invoke-method
                 (vlax-get-property XLOBJ 'WORKBOOKS)
                 'ADD
               )
  )
  (setq SHEETOBJ (mx-get-activesheet WB-OBJ))
 ) ;PDS_create_excel_sheet(defun PDS_SORT_XL (XLRANGE)
   (mx-sort  
                  (mx-get-range
             SHEETOBJ
             (strcat "B1:"
                     (chr (+ (cdr XLRANGE) 65))
                     (itoa (car XLRANGE))
             )
           )
           (mx-get-range SHEETOBJ "B1")
           MXC-xlAscending
           Nil
           Nil
           Nil
           Nil
           Nil
           MXC-xlYes
           NIL
           NIL
           MXC-xlTopToBottom
           Nil
  ) ； 问题所在！
  (mx-select
    (mx-get-range SHEETOBJ (strcat "B" (itoa (car XLRANGE))))
  )
)
(defun PDS-EXCEL-QUIT ()
  (vlax-invoke-method
    WB-OBJ "Saveas" "c:\\ex-test1.xls" NIL NIL NIL NIL NIL NIL
   )
  (vla-put-visible XLOBJ 0)
  (vlax-release-object SHEETOBJ)
  (vlax-release-object WB-OBJ)
  (vlax-invoke-method XLOBJ 'quit)
  (vlax-release-object XLOBJ)
  (mapcar '(lambda (x) (set x NIL)) '(WB-OBJ SHEETOBJ XLOBJ))
  (gc)
) ;PDS-Excel-Quit

南子 · 发表于 2003-9-16 19:19:00

1\您的‘方法‘和‘属性‘的前缀都是“mx-”
:methods-prefix "mx-"
:properties-prefix "mx-"
2\wb-obj还没有close就被释放指针(mx-close wb-obj)

(vlax-release-object wb-obj)
(vlax-invoke-method xlobj 'quit)