[Кулик Алексей aka kpblc]

Доброго всем.
Мне необходимо в лиспе получить доступ к составу архива. Архив - zip-образный, гарантированно открывается Проводником Windows (как пример можно взять любой файл docx, xlsx, cuix и т.п.). Использование сторонних архиваторов (WinZIP / WinRAR / 7z и т.п.) по условиям задачи недопустимо. Поиск по сети привел только к кодам на .NET - или я плохо искал.
Подскажите, пожалуйста, решение - ну или хотя бы пните в нужном направлении.

[gomer]

Код:

[Выделить все]

 ;;;   ZipUtils.lsp
;;;   Copyright ©2009 by K.E. Blackie
;;;
;;;   http://www.resourcecad.com
;;;   kblackie@resourcecad.com
;;;
;;;   AutoCAD 2000+  VisualLISP
;;;
;;;   Permission to use, copy, modify, and distribute this software
;;;   for any purpose and without fee is hereby granted, provided
;;;   that the above copyright notice appears in all copies and that
;;;   both that copyright notice and this permission notice appear in
;;;   all supporting documentation.
;;;
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;;
;;;
;;;
;;;
;;;----------------------------------------------------------------------------
;;;   DESCRIPTION
;;;----------------------------------------------------------------------------
;;;
;;;   This program uses VisualLISP and scripting objects to create, zip and
;;;   unzip files directly within AutoCAD. Error hecking is limited and it is
;;;   presumed the user will ensure the proper parameters are passed to each
;;;   function to obtain the desired results.
;;;
;;;----------------------------------------------------------------------------
;;;   USAGE
;;;----------------------------------------------------------------------------
;;;
;;;   (MakeZip "source filename with path" "destination file.zip* with path") *must not exist
;;;   (MakeEmptyZip "destination file.zip* with path") *must not exist
;;;   (Add2Zip "source filename with path" "destination file.zip* with path") *must exist
;;;   (AddFolder2Zip "source path" "destination file.zip* with path") *must not exist
;;;   (ExtractFilesFromZip "source file.zip with path" "source file in file.zip" "destination path")
;;;   (ExtractAllFilesFromZip "source file.zip with path" "destination path")
;;;   (GetAllFilesInZip "source file.zip with path") returns a list of all files in the zip file
;;;
;;;----------------------------------------------------------------------------

(vl-load-com)

(defun MakeZip (srcFile destFile)
  (MakeEmptyZip destFile)
  (Add2Zip srcFile destFile)
)
(defun MakeEmptyZip (destFile / fso fo)
  (setq fso (vlax-create-object "Scripting.FileSystemObject"))
  (setq fo (vlax-invoke fso 'OpenTextFile destFile '2 'true))
  (vlax-invoke fo 'Write (strcat (chr 80)(chr 75)(chr 5)(chr 6)))
  (repeat 18 (vlax-invoke fo 'Write (chr 256)))
  (vlax-invoke fo 'Close)
  (vlax-release-object fo)
  (vlax-release-object fso)
)  
(defun Add2Zip (srcFile destFile / app folder)
  (setq app (vlax-create-object "Shell.Application"))
  (setq folder (vlax-invoke app 'NameSpace destFile))
  (vlax-invoke folder 'CopyHere srcFile)
  (vlax-release-object folder)
  (vlax-release-object app)
)
(defun AddFolder2Zip (srcFolder destFile)
  (MakeEmptyZip destFile)
  (setq app (vlax-create-object "Shell.Application"))
  (setq folder (vlax-invoke app 'NameSpace srcFolder))
  (setq destZip (vlax-invoke app 'NameSpace destFile))
  (setq files (vlax-invoke folder 'Items))
  (setq count (vlax-get-property files 'Count))
  (setq ndx 0)
  (repeat count
    (setq file (vlax-invoke files 'Item ndx))
    (vlax-invoke destZip 'CopyHere file)
    (setq ndx (1+ ndx))
  )
)
(defun ExtractFileFromZip (zipFile srcName strDest / folder fso)
  (if (member srcName (GetAllFilesInZip zipfile))
    (progn
      (setq fso (vlax-create-object "Shell.Application"))
      (setq folder (vlax-invoke fso 'NameSpace strDest))
      (vlax-invoke folder 'CopyHere (strcat zipFile "\\" srcName))
      (vlax-release-object folder)
      (vlax-release-object fso)
    )
  )
)
(defun ExtractAllFilesFromZip (zipFile strDest / folder fso)
  (setq filelist (GetAllFilesInZip zipfile))
  (setq fso (vlax-create-object "Shell.Application"))
  (setq folder (vlax-invoke fso 'NameSpace strDest))
  (setq ndx 0)
  (repeat (length filelist)
    (vlax-invoke folder 'CopyHere (strcat zipFile "\\" (nth ndx filelist)))
    (setq ndx (1+ ndx))
  )
  (vlax-release-object folder)
  (vlax-release-object fso)
)
(defun GetAllFilesInZip (zipFile / count file filelist files folder fso ndx path)
  (setq path (car (fnsplitl zipFile)))
  (setq fso (vlax-create-object "Shell.Application"))
  (setq folder (vlax-invoke fso 'NameSpace zipFile))
  (setq files (vlax-invoke folder 'Items))
  (setq count (vlax-get-property files 'Count))
  (setq ndx 0)
  (repeat count
    (setq file (vlax-invoke files 'Item ndx))
    (setq filelist (append filelist (list (vlax-get-property file 'Name ))))
    (setq ndx (1+ ndx))
  )
  filelist
)

[Кулик Алексей aka kpblc]

gomer, спасибо, сейчас попробую
Как ты ухитрился это найти?

[gomer]

Сообщение от Кулик Алексей aka kpblc Как ты ухитрился это найти?

В тихом омуте черти водятся

[Кулик Алексей aka kpblc]

gomer, убил, добил и закопал ) Еще раз спасибо, все отлично работает