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

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

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

以下是部分的程序，请各位大侠帮帮忙！无限感激！！！

(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

(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)

cv7227 · 发表于 2003-9-16 22:05:00

已把:properties-prefix 改为"mxp-"和照您的方法mx-close wb-obj,再release...
但还是不行，从视窗任务管理(Windows Task Manager)中可看到，Excel还没释放！

meflying · 发表于 2003-9-17 09:35:00

不要释放xlobj对象，以后就使用这个对象进行操作。这样就不会不断地有excel不能释放了。
这样这样可以应付一下工作了，呵呵

cv7227 · 发表于 2003-9-17 14:31:00

缓冲的方式已经有了...
始终还是要彻底完善。因为非常受欢迎哦...大部分的同事已开始采用！
请再想想办法...

账号		自动登录	找回密码
密码			注册